1! RUN: %S/test_errors.sh %s %t %f18
2! Check for semantic errors in ALLOCATE statements
3
4module not_iso_fortran_env
5  type event_type
6  end type
7  type lock_type
8  end type
9end module
10
11subroutine C948_a()
12! If SOURCE= appears, the declared type of source-expr shall not be EVENT_TYPE
13! or LOCK_-TYPE from the intrinsic module ISO_FORTRAN_ENV, or have a potential subobject
14! component of type EVENT_TYPE or LOCK_TYPE.
15  use iso_fortran_env
16
17  type oktype1
18    type(event_type), pointer :: event
19    type(lock_type), pointer :: lock
20  end type
21
22  type oktype2
23    class(oktype1), allocatable :: t1a
24    type(oktype1) :: t1b
25  end type
26
27  type, extends(oktype1) :: oktype3
28    real, allocatable :: x(:)
29  end type
30
31  type noktype1
32    type(event_type), allocatable :: event
33  end type
34
35  type noktype2
36    type(event_type) :: event
37  end type
38
39  type noktype3
40    type(lock_type), allocatable :: lock
41  end type
42
43  type noktype4
44    type(lock_type) :: lock
45  end type
46
47  type, extends(noktype4) :: noktype5
48    real, allocatable :: x(:)
49  end type
50
51  type, extends(event_type) :: noktype6
52    real, allocatable :: x(:)
53  end type
54
55  type recursiveType
56    real x(10)
57    type(recursiveType), allocatable :: next
58  end type
59
60  type recursiveTypeNok
61    real x(10)
62    type(recursiveType), allocatable :: next
63    type(noktype5), allocatable :: trouble
64  end type
65
66  ! variable with event_type or lock_type have to be coarrays
67  ! see C1604 and 1608.
68  type(oktype1), allocatable :: okt1[:]
69  class(oktype2), allocatable :: okt2(:)[:]
70  type(oktype3), allocatable :: okt3[:]
71  type(noktype1), allocatable :: nokt1[:]
72  type(noktype2), allocatable :: nokt2[:]
73  class(noktype3), allocatable :: nokt3[:]
74  type(noktype4), allocatable :: nokt4[:]
75  type(noktype5), allocatable :: nokt5[:]
76  class(noktype6), allocatable :: nokt6(:)[:]
77  type(event_type), allocatable :: event[:]
78  type(lock_type), allocatable :: lock(:)[:]
79  class(recursiveType), allocatable :: recok
80  type(recursiveTypeNok), allocatable :: recnok[:]
81  class(*), allocatable :: whatever[:]
82
83  type(oktype1), allocatable :: okt1src[:]
84  class(oktype2), allocatable :: okt2src(:)[:]
85  type(oktype3), allocatable :: okt3src[:]
86  class(noktype1), allocatable :: nokt1src[:]
87  type(noktype2), allocatable :: nokt2src[:]
88  type(noktype3), allocatable :: nokt3src[:]
89  class(noktype4), allocatable :: nokt4src[:]
90  type(noktype5), allocatable :: nokt5src[:]
91  class(noktype6), allocatable :: nokt6src(:)[:]
92  type(event_type), allocatable :: eventsrc[:]
93  type(lock_type), allocatable :: locksrc(:)[:]
94  type(recursiveType), allocatable :: recoksrc
95  class(recursiveTypeNok), allocatable :: recnoksrc[:]
96
97  ! Valid constructs
98  allocate(okt1[*], SOURCE=okt1src)
99  allocate(okt2[*], SOURCE=okt2src)
100  allocate(okt3[*], SOURCE=okt3src)
101  allocate(whatever[*], SOURCE=okt3src)
102  allocate(recok, SOURCE=recoksrc)
103
104  allocate(nokt1[*])
105  allocate(nokt2[*])
106  allocate(nokt3[*])
107  allocate(nokt4[*])
108  allocate(nokt5[*])
109  allocate(nokt6(10)[*])
110  allocate(lock(10)[*])
111  allocate(event[*])
112  allocate(recnok[*])
113
114  allocate(nokt1[*], MOLD=nokt1src)
115  allocate(nokt2[*], MOLD=nokt2src)
116  allocate(nokt3[*], MOLD=nokt3src)
117  allocate(nokt4[*], MOLD=nokt4src)
118  allocate(nokt5[*], MOLD=nokt5src)
119  allocate(nokt6[*], MOLD=nokt6src)
120  allocate(lock[*],  MOLD=locksrc)
121  allocate(event[*], MOLD=eventsrc)
122  allocate(recnok[*],MOLD=recnoksrc)
123  allocate(whatever[*],MOLD=nokt6src)
124
125  !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
126  allocate(nokt1[*], SOURCE=nokt1src)
127  !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
128  allocate(nokt2[*], SOURCE=nokt2src)
129  !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
130  allocate(nokt3[*], SOURCE=nokt3src)
131  !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
132  allocate(nokt4[*], SOURCE=nokt4src)
133  !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
134  allocate(nokt5[*], SOURCE=nokt5src)
135  !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
136  allocate(nokt6[*], SOURCE=nokt6src)
137  !ERROR: SOURCE expression type must not be EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
138  allocate(lock[*],  SOURCE=locksrc)
139  !ERROR: SOURCE expression type must not be EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
140  allocate(event[*], SOURCE=eventsrc)
141  !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
142  allocate(recnok[*],SOURCE=recnoksrc)
143  !ERROR: SOURCE expression type must not have potential subobject component of type EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV
144  allocate(whatever[*],SOURCE=nokt5src)
145end subroutine
146
147
148subroutine C948_b()
149  use not_iso_fortran_env !type restriction do not apply
150
151  type oktype1
152    type(event_type), allocatable :: event
153  end type
154
155  type oktype2
156    type(lock_type) :: lock
157  end type
158
159  type(oktype1), allocatable :: okt1[:]
160  class(oktype2), allocatable :: okt2[:]
161  type(event_type), allocatable :: team[:]
162  class(lock_type), allocatable :: lock[:]
163
164  type(oktype1), allocatable :: okt1src[:]
165  class(oktype2), allocatable :: okt2src[:]
166  class(event_type), allocatable :: teamsrc[:]
167  type(lock_type), allocatable :: locksrc[:]
168
169  allocate(okt1[*], SOURCE=okt1src)
170  allocate(okt2[*], SOURCE=okt2src)
171  allocate(team[*], SOURCE=teamsrc)
172  allocate(lock[*], SOURCE=locksrc)
173end subroutine
174