OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [extends_3.f03] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! A test of f2k style constructors with derived type extension.
3
!
4
! Contributed by Paul Thomas  
5
!
6
module persons
7
  type :: person
8
    character(24) :: name = ""
9
    integer :: ss = 1
10
  end type person
11
end module persons
12
 
13
module person_education
14
  use persons
15
  type, extends(person) :: education
16
    integer ::  attainment = 0
17
    character(24) :: institution = ""
18
  end type education
19
end module person_education
20
 
21
  use person_education
22
  type, extends(education) :: service
23
    integer :: personnel_number = 0
24
    character(24) :: department = ""
25
  end type service
26
 
27
  type, extends(service) :: person_record
28
    type (person_record), pointer :: supervisor => NULL ()
29
  end type person_record
30
 
31
  type(person_record), pointer :: recruit, supervisor
32
 
33
! Check that F2K constructor with missing entries works
34
  allocate (supervisor)
35
  supervisor%service = service (NAME = "Joe Honcho", SS= 123455)
36
 
37
  recruit => entry ("John Smith", 123456, 1, "Bog Hill High School", &
38
                    99, "Records", supervisor)
39
 
40
  if (supervisor%ss /= 123455) call abort
41
  if (trim (supervisor%name) /= "Joe Honcho") call abort
42
  if (trim (supervisor%institution) /= "") call abort
43
  if (supervisor%attainment /= 0) call abort
44
 
45
  if (trim (recruit%name) /= "John Smith") call abort
46
  if (recruit%name /= recruit%service%name) call abort
47
  if (recruit%supervisor%ss /= 123455) call abort
48
  if (recruit%supervisor%ss /= supervisor%person%ss) call abort
49
 
50
  deallocate (supervisor)
51
  deallocate (recruit)
52
contains
53
  function entry (name, ss, attainment, institution, &
54
                  personnel_number, department, supervisor) result (new_person)
55
    integer :: ss, attainment, personnel_number
56
    character (*) :: name, institution, department
57
    type (person_record), pointer :: supervisor, new_person
58
 
59
    allocate (new_person)
60
 
61
! Check F2K constructor with order shuffled a bit
62
    new_person = person_record (NAME = name, SS =ss, &
63
                                DEPARTMENT = department, &
64
                                INSTITUTION = institution, &
65
                                PERSONNEL_NUMBER = personnel_number, &
66
                                ATTAINMENT = attainment, &
67
                                SUPERVISOR = supervisor)
68
  end function
69
end
70
 
71
! { dg-final { cleanup-modules "persons person_education" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.