[flang] Accept polymorphic component element in storage_size
[llvm-project.git] / flang / test / Semantics / allocate13.f90
blob27097ba85e67bbdab9b16bea9fbcc52846fb9ba2
1 ! RUN: %python %S/test_errors.py %s %flang_fc1
2 ! Check for semantic errors in ALLOCATE statements
4 module not_iso_fortran_env
5 type event_type
6 end type
7 type lock_type
8 end type
9 end module
11 subroutine 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
17 type oktype1
18 type(event_type), pointer :: event
19 type(lock_type), pointer :: lock
20 end type
22 type oktype2
23 class(oktype1), allocatable :: t1a
24 type(oktype1) :: t1b
25 end type
27 type, extends(oktype1) :: oktype3
28 real, allocatable :: x(:)
29 end type
31 type noktype1
32 type(event_type), allocatable :: event
33 end type
35 type noktype2
36 type(event_type) :: event
37 end type
39 type noktype3
40 type(lock_type), allocatable :: lock
41 end type
43 type noktype4
44 type(lock_type) :: lock
45 end type
47 type, extends(noktype4) :: noktype5
48 real, allocatable :: x(:)
49 end type
51 type, extends(event_type) :: noktype6
52 real, allocatable :: x(:)
53 end type
55 type recursiveType
56 real x(10)
57 type(recursiveType), allocatable :: next
58 end type
60 type recursiveTypeNok
61 real x(10)
62 type(recursiveType), allocatable :: next
63 type(noktype5), allocatable :: trouble
64 end type
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[:]
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[:]
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)
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[*])
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)
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)
145 end subroutine
148 subroutine C948_b()
149 use not_iso_fortran_env !type restriction do not apply
151 type oktype1
152 type(event_type), allocatable :: event
153 end type
155 type oktype2
156 type(lock_type) :: lock
157 end type
159 type(oktype1), allocatable :: okt1[:]
160 class(oktype2), allocatable :: okt2[:]
161 type(event_type), allocatable :: team[:]
162 class(lock_type), allocatable :: lock[:]
164 type(oktype1), allocatable :: okt1src[:]
165 class(oktype2), allocatable :: okt2src[:]
166 class(event_type), allocatable :: teamsrc[:]
167 type(lock_type), allocatable :: locksrc[:]
169 allocate(okt1[*], SOURCE=okt1src)
170 allocate(okt2[*], SOURCE=okt2src)
171 allocate(team[*], SOURCE=teamsrc)
172 allocate(lock[*], SOURCE=locksrc)
173 end subroutine
175 module prot
176 real, pointer, protected :: pp
177 real, allocatable, protected :: pa
178 end module
179 subroutine prottest
180 use prot
181 !ERROR: Name in ALLOCATE statement is not definable
182 !BECAUSE: 'pp' is protected in this scope
183 allocate(pp)
184 !ERROR: Name in ALLOCATE statement is not definable
185 !BECAUSE: 'pa' is protected in this scope
186 allocate(pa)
187 !ERROR: Name in DEALLOCATE statement is not definable
188 !BECAUSE: 'pp' is protected in this scope
189 deallocate(pp)
190 !ERROR: Name in DEALLOCATE statement is not definable
191 !BECAUSE: 'pa' is protected in this scope
192 deallocate(pa)
193 end subroutine