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
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
|
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! Test 15.5.2.4 constraints and restrictions for non-POINTER non-ALLOCATABLE
! dummy arguments.
module m01
type :: t
end type
type :: pdt(n)
integer, len :: n
end type
type :: pdtWithDefault(n)
integer, len :: n = 3
end type
type :: tbp
contains
procedure :: binding => subr01
end type
type :: final
contains
final :: subr02
end type
type :: alloc
real, allocatable :: a(:)
end type
type :: ultimateCoarray
real, allocatable :: a[:]
end type
contains
subroutine subr01(this)
class(tbp), intent(in) :: this
end subroutine
subroutine subr02(this)
type(final), intent(inout) :: this
end subroutine
subroutine poly(x)
class(t), intent(in) :: x
end subroutine
subroutine polyassumedsize(x)
class(t), intent(in) :: x(*)
end subroutine
subroutine assumedsize(x)
real :: x(*)
end subroutine
subroutine assumedrank(x)
real :: x(..)
end subroutine
subroutine assumedtypeandsize(x)
type(*) :: x(*)
end subroutine
subroutine assumedshape(x)
real :: x(:)
end subroutine
subroutine contiguous(x)
real, contiguous :: x(:)
end subroutine
subroutine intentout(x)
real, intent(out) :: x
end subroutine
subroutine intentout_arr(x)
real, intent(out) :: x(:)
end subroutine
subroutine intentinout(x)
real, intent(in out) :: x
end subroutine
subroutine intentinout_arr(x)
real, intent(in out) :: x(:)
end subroutine
subroutine asynchronous(x)
real, asynchronous :: x
end subroutine
subroutine asynchronous_arr(x)
real, asynchronous :: x(:)
end subroutine
subroutine asynchronousValue(x)
real, asynchronous, value :: x
end subroutine
subroutine volatile(x)
real, volatile :: x
end subroutine
subroutine volatile_arr(x)
real, volatile :: x(:)
end subroutine
subroutine pointer(x)
real, pointer :: x(:)
end subroutine
subroutine valueassumedsize(x)
real, intent(in) :: x(*)
end subroutine
subroutine volatileassumedsize(x)
real, volatile :: x(*)
end subroutine
subroutine volatilecontiguous(x)
real, volatile :: x(*)
end subroutine
subroutine test01(x) ! 15.5.2.4(2)
class(t), intent(in) :: x[*]
!ERROR: Coindexed polymorphic object may not be associated with a polymorphic dummy argument 'x='
call poly(x[1])
end subroutine
subroutine mono(x)
type(t), intent(in) :: x(*)
end subroutine
subroutine test02(x) ! 15.5.2.4(2)
class(t), intent(in) :: x(*)
!ERROR: Assumed-size polymorphic array may not be associated with a monomorphic dummy argument 'x='
call mono(x)
end subroutine
subroutine typestar(x)
type(*), intent(in) :: x
end subroutine
subroutine test03 ! 15.5.2.4(2)
type(pdt(0)) :: x
!ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have a parameterized derived type
call typestar(x)
end subroutine
subroutine test04 ! 15.5.2.4(2)
type(tbp) :: x
!ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedure 'binding'
call typestar(x)
end subroutine
subroutine test05 ! 15.5.2.4(2)
type(final) :: x
!ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have derived type 'final' with FINAL subroutine 'subr02'
call typestar(x)
end subroutine
subroutine ch2(x)
character(2), intent(in) :: x
end subroutine
subroutine pdtdefault (derivedArg)
!ERROR: Type parameter 'n' lacks a value and has no default
type(pdt) :: derivedArg
end subroutine pdtdefault
subroutine pdt3 (derivedArg)
type(pdt(4)) :: derivedArg
end subroutine pdt3
subroutine pdt4 (derivedArg)
type(pdt(*)) :: derivedArg
end subroutine pdt4
subroutine pdtWithDefaultDefault (derivedArg)
type(pdtWithDefault) :: derivedArg
end subroutine pdtWithDefaultdefault
subroutine pdtWithDefault3 (derivedArg)
type(pdtWithDefault(4)) :: derivedArg
end subroutine pdtWithDefault3
subroutine pdtWithDefault4 (derivedArg)
type(pdtWithDefault(*)) :: derivedArg
end subroutine pdtWithDefault4
subroutine test06 ! 15.5.2.4(4)
!ERROR: Type parameter 'n' lacks a value and has no default
type(pdt) :: vardefault
type(pdt(3)) :: var3
type(pdt(4)) :: var4
type(pdtWithDefault) :: defaultVardefault
type(pdtWithDefault(3)) :: defaultVar3
type(pdtWithDefault(4)) :: defaultVar4
character :: ch1
!ERROR: Actual argument variable length '1' is less than expected length '2'
call ch2(ch1)
!WARNING: Actual argument expression length '0' is less than expected length '2'
call ch2("")
call pdtdefault(vardefault)
!ERROR: Actual argument type 'pdt(n=3_4)' is not compatible with dummy argument type 'pdt'
call pdtdefault(var3)
!ERROR: Actual argument type 'pdt(n=4_4)' is not compatible with dummy argument type 'pdt'
call pdtdefault(var4) ! error
!ERROR: Actual argument type 'pdt' is not compatible with dummy argument type 'pdt(n=4_4)'
call pdt3(vardefault)
!ERROR: Actual argument type 'pdt(n=3_4)' is not compatible with dummy argument type 'pdt(n=4_4)'
call pdt3(var3)
call pdt3(var4)
!ERROR: Actual argument type 'pdt' is not compatible with dummy argument type 'pdt(n=*)'
call pdt4(vardefault)
call pdt4(var3)
call pdt4(var4)
call pdtWithDefaultdefault(defaultVardefault)
call pdtWithDefaultdefault(defaultVar3)
!ERROR: Actual argument type 'pdtwithdefault(n=4_4)' is not compatible with dummy argument type 'pdtwithdefault(n=3_4)'
call pdtWithDefaultdefault(defaultVar4) ! error
!ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)'
call pdtWithDefault3(defaultVardefault) ! error
!ERROR: Actual argument type 'pdtwithdefault(n=3_4)' is not compatible with dummy argument type 'pdtwithdefault(n=4_4)'
call pdtWithDefault3(defaultVar3) ! error
call pdtWithDefault3(defaultVar4)
call pdtWithDefault4(defaultVardefault)
call pdtWithDefault4(defaultVar3)
call pdtWithDefault4(defaultVar4)
end subroutine
subroutine out01(x)
type(alloc) :: x
end subroutine
subroutine test07(x) ! 15.5.2.4(6)
type(alloc) :: x[*]
!ERROR: Coindexed actual argument with ALLOCATABLE ultimate component '%a' must be associated with a dummy argument 'x=' with VALUE or INTENT(IN) attributes
call out01(x[1])
end subroutine
subroutine test08(x) ! 15.5.2.4(13)
real :: x(1)[*]
!ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument 'x='
call assumedsize(x(1)[1])
end subroutine
subroutine charray(x)
character :: x(10)
end subroutine
subroutine test09(ashape, polyarray, c, assumed_shape_char) ! 15.5.2.4(14), 15.5.2.11
real :: x, arr(10)
real, pointer :: p(:)
real, pointer :: p_scalar
character(10), pointer :: char_pointer(:)
character(*) :: assumed_shape_char(:)
real :: ashape(:)
class(t) :: polyarray(*)
character(10) :: c(:)
!ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
call assumedsize(x)
!ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array
call assumedsize(p_scalar)
!ERROR: Element of pointer array may not be associated with a dummy argument 'x=' array
call assumedsize(p(1))
!ERROR: Element of assumed-shape array may not be associated with a dummy argument 'x=' array
call assumedsize(ashape(1))
!ERROR: Polymorphic scalar may not be associated with a dummy argument 'x=' array
call polyassumedsize(polyarray(1))
call charray(c(1:1)) ! not an error if character
call charray(char_pointer(1)) ! not an error if character
call charray(assumed_shape_char(1)) ! not an error if character
call assumedsize(arr(1)) ! not an error if element in sequence
call assumedrank(x) ! not an error
call assumedtypeandsize(x) ! not an error
end subroutine
subroutine test10(a) ! 15.5.2.4(16)
real :: scalar, matrix(2,3)
real :: a(*)
!ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'x='
call assumedshape(scalar)
call assumedshape(reshape(matrix,shape=[size(matrix)])) ! ok
!ERROR: Rank of dummy argument is 1, but actual argument has rank 2
call assumedshape(matrix)
!ERROR: Assumed-size array may not be associated with assumed-shape dummy argument 'x='
call assumedshape(a)
end subroutine
subroutine test11(in) ! C15.5.2.4(20)
real, intent(in) :: in
real :: x
x = 0.
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
!BECAUSE: 'in' is an INTENT(IN) dummy argument
call intentout(in)
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
!BECAUSE: '3.141590118408203125_4' is not a variable or pointer
call intentout(3.14159)
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
!BECAUSE: 'in+1._4' is not a variable or pointer
call intentout(in + 1.)
call intentout(x) ! ok
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
!BECAUSE: '(x)' is not a variable or pointer
call intentout((x))
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' is not definable
!BECAUSE: '2_4' is not a variable or pointer
call system_clock(count=2)
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
!BECAUSE: 'in' is an INTENT(IN) dummy argument
call intentinout(in)
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
!BECAUSE: '3.141590118408203125_4' is not a variable or pointer
call intentinout(3.14159)
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
!BECAUSE: 'in+1._4' is not a variable or pointer
call intentinout(in + 1.)
call intentinout(x) ! ok
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
!BECAUSE: '(x)' is not a variable or pointer
call intentinout((x))
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'exitstat=' is not definable
!BECAUSE: '0_4' is not a variable or pointer
call execute_command_line(command="echo hello", exitstat=0)
end subroutine
subroutine test12 ! 15.5.2.4(21)
real :: a(1)
integer :: j(1)
j(1) = 1
!ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
!BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript
call intentout_arr(a(j))
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
!BECAUSE: Variable 'a(int(j,kind=8))' has a vector subscript
call intentinout_arr(a(j))
call asynchronous_arr(a(j)) ! ok
call volatile_arr(a(j)) ! ok
end subroutine
subroutine coarr(x)
type(ultimateCoarray):: x
end subroutine
subroutine volcoarr(x)
type(ultimateCoarray), volatile :: x
end subroutine
subroutine test13(a, b) ! 15.5.2.4(22)
type(ultimateCoarray) :: a
type(ultimateCoarray), volatile :: b
call coarr(a) ! ok
call volcoarr(b) ! ok
!ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a'
call coarr(b)
!ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component '%a'
call volcoarr(a)
end subroutine
subroutine test14(a,b,c,d) ! C1538
real :: a[*]
real, asynchronous :: b[*]
real, volatile :: c[*]
real, asynchronous, volatile :: d[*]
call asynchronous(a[1]) ! ok
call volatile(a[1]) ! ok
call asynchronousValue(b[1]) ! ok
call asynchronousValue(c[1]) ! ok
call asynchronousValue(d[1]) ! ok
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
call asynchronous(b[1])
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
call volatile(b[1])
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
call asynchronous(c[1])
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
call volatile(c[1])
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
call asynchronous(d[1])
!ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE
call volatile(d[1])
end subroutine
subroutine test15() ! C1539
real, pointer :: a(:)
real, asynchronous :: b(10)
real, volatile :: c(10)
real, asynchronous, volatile :: d(10)
call assumedsize(a(::2)) ! ok
call contiguous(a(::2)) ! ok
call valueassumedsize(a(::2)) ! ok
call valueassumedsize(b(::2)) ! ok
call valueassumedsize(c(::2)) ! ok
call valueassumedsize(d(::2)) ! ok
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatileassumedsize(b(::2))
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatilecontiguous(b(::2))
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatileassumedsize(c(::2))
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatilecontiguous(c(::2))
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatileassumedsize(d(::2))
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatilecontiguous(d(::2))
end subroutine
subroutine test16() ! C1540
real, pointer :: a(:)
real, asynchronous, pointer :: b(:)
real, volatile, pointer :: c(:)
real, asynchronous, volatile, pointer :: d(:)
call assumedsize(a) ! ok
call contiguous(a) ! ok
call pointer(a) ! ok
call pointer(b) ! ok
call pointer(c) ! ok
call pointer(d) ! ok
call valueassumedsize(a) ! ok
call valueassumedsize(b) ! ok
call valueassumedsize(c) ! ok
call valueassumedsize(d) ! ok
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatileassumedsize(b)
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatilecontiguous(b)
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatileassumedsize(c)
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatilecontiguous(c)
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatileassumedsize(d)
!ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x='
call volatilecontiguous(d)
end subroutine
end module
|
