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