6 ! Run-time test for Fortran 2003 NAMELISTS
7 ! Version for non-strings
12 character(len
=1000) :: str
14 character(len
=5), allocatable
:: a(:)
15 character(len
=5), allocatable
:: b
16 character(len
=5), pointer :: ap(:)
17 character(len
=5), pointer :: bp
19 character(len
=5) :: d(3)
22 character(len
=5) :: c1
23 character(len
=5) :: c2(3)
26 type(t
),allocatable
:: g
,h(:)
27 type(t
),pointer :: i
,j(:)
29 namelist /nml
/ a
, b
, c
, d
, ap
, bp
,e
,f
,g
,h
,i
,j
37 d
= ['-1', '-2', '-3']
40 e
%c2
= ['-702','-703','-704']
43 f(1)%c2
= ['44001','44002','44003']
44 f(2)%c2
= ['44011','44012','44013']
46 allocate(g
,h(2),i
,j(2))
49 g
%c2
= ['-602','6703','-604']
52 h(1)%c2
= ['45001','45002','45003']
53 h(2)%c2
= ['45011','45012','45013']
56 i
%c2
= ['-502','-503','-504']
59 j(1)%c2
= ['46001','46002','46003']
60 j(2)%c2
= ['46011','46012','46013']
63 str
= repeat('X', len(str
))
67 a
= repeat('X', len(a
))
68 ap
= repeat('X', len(ap
))
69 b
= repeat('X', len(b
))
70 bp
= repeat('X', len(bp
))
71 c
= repeat('X', len(c
))
72 d
= repeat('X', len(d
))
74 e
%c1
= repeat('X', len(e
%c1
))
75 e
%c2
= repeat('X', len(e
%c2
))
76 f(1)%c1
= repeat('X', len(f(1)%c1
))
77 f(2)%c1
= repeat('X', len(f(2)%c1
))
78 f(1)%c2
= repeat('X', len(f(1)%c2
))
79 f(2)%c2
= repeat('X', len(f(2)%c2
))
81 g
%c1
= repeat('X', len(g
%c1
))
82 g
%c2
= repeat('X', len(g
%c1
))
83 h(1)%c1
= repeat('X', len(h(1)%c1
))
84 h(2)%c1
= repeat('X', len(h(1)%c1
))
85 h(1)%c2
= repeat('X', len(h(1)%c1
))
86 h(2)%c2
= repeat('X', len(h(1)%c1
))
88 i
%c1
= repeat('X', len(i
%c1
))
89 i
%c2
= repeat('X', len(i
%c1
))
90 j(1)%c1
= repeat('X', len(j(1)%c1
))
91 j(2)%c1
= repeat('X', len(j(2)%c1
))
92 j(1)%c2
= repeat('X', len(j(1)%c2
))
93 j(2)%c2
= repeat('X', len(j(2)%c2
))
99 if (any (a
/= ['aa01','aa02'])) STOP 1
100 if (any (ap
/= ['98', '99'])) STOP 2
102 if (bp
/= '101') STOP 4
104 if (any (d
/= ['-1', '-2', '-3'])) STOP 6
106 if (e
%c1
/= '-701') STOP 7
107 if (any (e
%c2
/= ['-702','-703','-704'])) STOP 8
108 if (f(1)%c1
/= '33001') STOP 9
109 if (f(2)%c1
/= '33002') STOP 10
110 if (any (f(1)%c2
/= ['44001','44002','44003'])) STOP 11
111 if (any (f(2)%c2
/= ['44011','44012','44013'])) STOP 12
113 if (g
%c1
/= '-601') STOP 13
114 if (any(g
%c2
/= ['-602','6703','-604'])) STOP 14
115 if (h(1)%c1
/= '35001') STOP 15
116 if (h(2)%c1
/= '35002') STOP 16
117 if (any (h(1)%c2
/= ['45001','45002','45003'])) STOP 17
118 if (any (h(2)%c2
/= ['45011','45012','45013'])) STOP 18
120 if (i
%c1
/= '-501') STOP 19
121 if (any (i
%c2
/= ['-502','-503','-504'])) STOP 20
122 if (j(1)%c1
/= '36001') STOP 21
123 if (j(2)%c1
/= '36002') STOP 22
124 if (any (j(1)%c2
/= ['46001','46002','46003'])) STOP 23
125 if (any (j(2)%c2
/= ['46011','46012','46013'])) STOP 24
127 ! Check argument passing (dummy processing)
128 call test2(a
,b
,c
,d
,ap
,bp
,e
,f
,g
,h
,i
,j
,2)
129 call test3(a
,b
,c
,d
,ap
,bp
,e
,f
,g
,h
,i
,j
,2,len(a
))
130 call test4(a
,b
,c
,d
,ap
,bp
,e
,f
,g
,h
,i
,j
,2)
133 subroutine test2(x1
,x2
,x3
,x4
,x1p
,x2p
,x6
,x7
,x8
,x9
,x10
,x11
,n
)
134 character(len
=5), allocatable
:: x1(:)
135 character(len
=5), allocatable
:: x2
136 character(len
=5), pointer :: x1p(:)
137 character(len
=5), pointer :: x2p
138 character(len
=5) :: x3
139 character(len
=5) :: x4(3)
141 character(len
=5) :: x5(n
)
143 type(t
),allocatable
:: x8
,x9(:)
144 type(t
),pointer :: x10
,x11(:)
147 namelist /nml2
/ x1
, x2
, x3
, x4
,x5
,x1p
,x2p
,x6
,x7
,x8
,x9
,x10
,x11
,x12
149 x5
= [ 'x5-42', 'x5-53' ]
153 x12(1)%c2
= ['47001','47002','47003']
154 x12(2)%c2
= ['47011','47012','47013']
157 str
= repeat('X', len(str
))
161 x1
= repeat('X', len(x1
))
162 x1p
= repeat('X', len(x1p
))
163 x2
= repeat('X', len(x2
))
164 x2p
= repeat('X', len(x2p
))
165 x3
= repeat('X', len(x3
))
166 x4
= repeat('X', len(x4
))
168 x6
%c1
= repeat('X', len(x6
%c1
))
169 x6
%c2
= repeat('X', len(x6
%c2
))
170 x7(1)%c1
= repeat('X', len(x7(1)%c1
))
171 x7(2)%c1
= repeat('X', len(x7(2)%c1
))
172 x7(1)%c2
= repeat('X', len(x7(1)%c2
))
173 x7(2)%c2
= repeat('X', len(x7(2)%c2
))
175 x8
%c1
= repeat('X', len(x8
%c1
))
176 x8
%c2
= repeat('X', len(x8
%c1
))
177 x9(1)%c1
= repeat('X', len(x9(1)%c1
))
178 x9(2)%c1
= repeat('X', len(x9(1)%c1
))
179 x9(1)%c2
= repeat('X', len(x9(1)%c1
))
180 x9(2)%c2
= repeat('X', len(x9(1)%c1
))
182 x10
%c1
= repeat('X', len(x10
%c1
))
183 x10
%c2
= repeat('X', len(x10
%c1
))
184 x11(1)%c1
= repeat('X', len(x11(1)%c1
))
185 x11(2)%c1
= repeat('X', len(x11(2)%c1
))
186 x11(1)%c2
= repeat('X', len(x11(1)%c2
))
187 x11(2)%c2
= repeat('X', len(x11(2)%c2
))
189 x5
= repeat('X', len(x5
))
191 x12(1)%c1
= repeat('X', len(x12(2)%c2
))
192 x12(2)%c1
= repeat('X', len(x12(2)%c2
))
193 x12(1)%c2
= repeat('X', len(x12(2)%c2
))
194 x12(2)%c2
= repeat('X', len(x12(2)%c2
))
200 if (any (x1
/= ['aa01','aa02'])) STOP 25
201 if (any (x1p
/= ['98', '99'])) STOP 26
202 if (x2
/= '7') STOP 27
203 if (x2p
/= '101') STOP 28
204 if (x3
/= '8') STOP 29
205 if (any (x4
/= ['-1', '-2', '-3'])) STOP 30
207 if (x6
%c1
/= '-701') STOP 31
208 if (any (x6
%c2
/= ['-702','-703','-704'])) STOP 32
209 if (x7(1)%c1
/= '33001') STOP 33
210 if (x7(2)%c1
/= '33002') STOP 34
211 if (any (x7(1)%c2
/= ['44001','44002','44003'])) STOP 35
212 if (any (x7(2)%c2
/= ['44011','44012','44013'])) STOP 36
214 if (x8
%c1
/= '-601') STOP 37
215 if (any(x8
%c2
/= ['-602','6703','-604'])) STOP 38
216 if (x9(1)%c1
/= '35001') STOP 39
217 if (x9(2)%c1
/= '35002') STOP 40
218 if (any (x9(1)%c2
/= ['45001','45002','45003'])) STOP 41
219 if (any (x9(2)%c2
/= ['45011','45012','45013'])) STOP 42
221 if (x10
%c1
/= '-501') STOP 43
222 if (any (x10
%c2
/= ['-502','-503','-504'])) STOP 44
223 if (x11(1)%c1
/= '36001') STOP 45
224 if (x11(2)%c1
/= '36002') STOP 46
225 if (any (x11(1)%c2
/= ['46001','46002','46003'])) STOP 47
226 if (any (x11(2)%c2
/= ['46011','46012','46013'])) STOP 48
228 if (any (x5
/= [ 'x5-42', 'x5-53' ])) STOP 49
230 if (x12(1)%c1
/= '37001') STOP 50
231 if (x12(2)%c1
/= '37002') STOP 51
232 if (any (x12(1)%c2
/= ['47001','47002','47003'])) STOP 52
233 if (any (x12(2)%c2
/= ['47011','47012','47013'])) STOP 53
236 subroutine test3(x1
,x2
,x3
,x4
,x1p
,x2p
,x6
,x7
,x8
,x9
,x10
,x11
,n
,ll
)
238 character(len
=ll
), allocatable
:: x1(:)
239 character(len
=ll
), allocatable
:: x2
240 character(len
=ll
), pointer :: x1p(:)
241 character(len
=ll
), pointer :: x2p
242 character(len
=ll
) :: x3
243 character(len
=ll
) :: x4(3)
244 character(len
=ll
) :: x5(n
)
246 type(t
),allocatable
:: x8
,x9(:)
247 type(t
),pointer :: x10
,x11(:)
250 namelist /nml2
/ x1
, x2
, x3
, x4
,x5
,x1p
,x2p
,x6
,x7
,x8
,x9
,x10
,x11
,x12
252 x5
= [ 'x5-42', 'x5-53' ]
256 x12(1)%c2
= ['47001','47002','47003']
257 x12(2)%c2
= ['47011','47012','47013']
260 str
= repeat('X', len(str
))
264 x1
= repeat('X', len(x1
))
265 x1p
= repeat('X', len(x1p
))
267 x2
= repeat('X', len(x2
))
268 x2p
= repeat('X', len(x2p
))
269 x3
= repeat('X', len(x3
))
270 x4
= repeat('X', len(x4
))
272 x6
%c1
= repeat('X', len(x6
%c1
))
273 x6
%c2
= repeat('X', len(x6
%c2
))
274 x7(1)%c1
= repeat('X', len(x7(1)%c1
))
275 x7(2)%c1
= repeat('X', len(x7(2)%c1
))
276 x7(1)%c2
= repeat('X', len(x7(1)%c2
))
277 x7(2)%c2
= repeat('X', len(x7(2)%c2
))
279 x8
%c1
= repeat('X', len(x8
%c1
))
280 x8
%c2
= repeat('X', len(x8
%c1
))
281 x9(1)%c1
= repeat('X', len(x9(1)%c1
))
282 x9(2)%c1
= repeat('X', len(x9(1)%c1
))
283 x9(1)%c2
= repeat('X', len(x9(1)%c1
))
284 x9(2)%c2
= repeat('X', len(x9(1)%c1
))
286 x10
%c1
= repeat('X', len(x10
%c1
))
287 x10
%c2
= repeat('X', len(x10
%c1
))
288 x11(1)%c1
= repeat('X', len(x11(1)%c1
))
289 x11(2)%c1
= repeat('X', len(x11(2)%c1
))
290 x11(1)%c2
= repeat('X', len(x11(1)%c2
))
291 x11(2)%c2
= repeat('X', len(x11(2)%c2
))
293 x5
= repeat('X', len(x5
))
295 x12(1)%c1
= repeat('X', len(x12(2)%c2
))
296 x12(2)%c1
= repeat('X', len(x12(2)%c2
))
297 x12(1)%c2
= repeat('X', len(x12(2)%c2
))
298 x12(2)%c2
= repeat('X', len(x12(2)%c2
))
304 if (any (x1
/= ['aa01','aa02'])) STOP 54
305 if (any (x1p
/= ['98', '99'])) STOP 55
306 if (x2
/= '7') STOP 56
307 if (x2p
/= '101') STOP 57
308 if (x3
/= '8') STOP 58
309 if (any (x4
/= ['-1', '-2', '-3'])) STOP 59
311 if (x6
%c1
/= '-701') STOP 60
312 if (any (x6
%c2
/= ['-702','-703','-704'])) STOP 61
313 if (x7(1)%c1
/= '33001') STOP 62
314 if (x7(2)%c1
/= '33002') STOP 63
315 if (any (x7(1)%c2
/= ['44001','44002','44003'])) STOP 64
316 if (any (x7(2)%c2
/= ['44011','44012','44013'])) STOP 65
318 if (x8
%c1
/= '-601') STOP 66
319 if (any(x8
%c2
/= ['-602','6703','-604'])) STOP 67
320 if (x9(1)%c1
/= '35001') STOP 68
321 if (x9(2)%c1
/= '35002') STOP 69
322 if (any (x9(1)%c2
/= ['45001','45002','45003'])) STOP 70
323 if (any (x9(2)%c2
/= ['45011','45012','45013'])) STOP 71
325 if (x10
%c1
/= '-501') STOP 72
326 if (any (x10
%c2
/= ['-502','-503','-504'])) STOP 73
327 if (x11(1)%c1
/= '36001') STOP 74
328 if (x11(2)%c1
/= '36002') STOP 75
329 if (any (x11(1)%c2
/= ['46001','46002','46003'])) STOP 76
330 if (any (x11(2)%c2
/= ['46011','46012','46013'])) STOP 77
332 if (any (x5
/= [ 'x5-42', 'x5-53' ])) STOP 78
334 if (x12(1)%c1
/= '37001') STOP 79
335 if (x12(2)%c1
/= '37002') STOP 80
336 if (any (x12(1)%c2
/= ['47001','47002','47003'])) STOP 81
337 if (any (x12(2)%c2
/= ['47011','47012','47013'])) STOP 82
340 subroutine test4(x1
,x2
,x3
,x4
,x1p
,x2p
,x6
,x7
,x8
,x9
,x10
,x11
,n
)
341 character(len
=*), allocatable
:: x1(:)
342 character(len
=*), allocatable
:: x2
343 character(len
=*), pointer :: x1p(:)
344 character(len
=*), pointer :: x2p
345 character(len
=*) :: x3
346 character(len
=*) :: x4(3)
348 character(len
=5) :: x5(n
)
350 type(t
),allocatable
:: x8
,x9(:)
351 type(t
),pointer :: x10
,x11(:)
354 namelist /nml2
/ x1
, x2
, x3
, x4
,x5
,x1p
,x2p
,x6
,x7
,x8
,x9
,x10
,x11
,x12
356 x5
= [ 'x5-42', 'x5-53' ]
360 x12(1)%c2
= ['47001','47002','47003']
361 x12(2)%c2
= ['47011','47012','47013']
364 str
= repeat('X', len(str
))
368 x1
= repeat('X', len(x1
))
369 x1p
= repeat('X', len(x1p
))
370 x2
= repeat('X', len(x2
))
371 x2p
= repeat('X', len(x2p
))
372 x3
= repeat('X', len(x3
))
373 x4
= repeat('X', len(x4
))
375 x6
%c1
= repeat('X', len(x6
%c1
))
376 x6
%c2
= repeat('X', len(x6
%c2
))
377 x7(1)%c1
= repeat('X', len(x7(1)%c1
))
378 x7(2)%c1
= repeat('X', len(x7(2)%c1
))
379 x7(1)%c2
= repeat('X', len(x7(1)%c2
))
380 x7(2)%c2
= repeat('X', len(x7(2)%c2
))
382 x8
%c1
= repeat('X', len(x8
%c1
))
383 x8
%c2
= repeat('X', len(x8
%c1
))
384 x9(1)%c1
= repeat('X', len(x9(1)%c1
))
385 x9(2)%c1
= repeat('X', len(x9(1)%c1
))
386 x9(1)%c2
= repeat('X', len(x9(1)%c1
))
387 x9(2)%c2
= repeat('X', len(x9(1)%c1
))
389 x10
%c1
= repeat('X', len(x10
%c1
))
390 x10
%c2
= repeat('X', len(x10
%c1
))
391 x11(1)%c1
= repeat('X', len(x11(1)%c1
))
392 x11(2)%c1
= repeat('X', len(x11(2)%c1
))
393 x11(1)%c2
= repeat('X', len(x11(1)%c2
))
394 x11(2)%c2
= repeat('X', len(x11(2)%c2
))
396 x5
= repeat('X', len(x5
))
398 x12(1)%c1
= repeat('X', len(x12(2)%c2
))
399 x12(2)%c1
= repeat('X', len(x12(2)%c2
))
400 x12(1)%c2
= repeat('X', len(x12(2)%c2
))
401 x12(2)%c2
= repeat('X', len(x12(2)%c2
))
407 if (any (x1
/= ['aa01','aa02'])) STOP 83
408 if (any (x1p
/= ['98', '99'])) STOP 84
409 if (x2
/= '7') STOP 85
410 if (x2p
/= '101') STOP 86
411 if (x3
/= '8') STOP 87
412 if (any (x4
/= ['-1', '-2', '-3'])) STOP 88
414 if (x6
%c1
/= '-701') STOP 89
415 if (any (x6
%c2
/= ['-702','-703','-704'])) STOP 90
416 if (x7(1)%c1
/= '33001') STOP 91
417 if (x7(2)%c1
/= '33002') STOP 92
418 if (any (x7(1)%c2
/= ['44001','44002','44003'])) STOP 93
419 if (any (x7(2)%c2
/= ['44011','44012','44013'])) STOP 94
421 if (x8
%c1
/= '-601') STOP 95
422 if (any(x8
%c2
/= ['-602','6703','-604'])) STOP 96
423 if (x9(1)%c1
/= '35001') STOP 97
424 if (x9(2)%c1
/= '35002') STOP 98
425 if (any (x9(1)%c2
/= ['45001','45002','45003'])) STOP 99
426 if (any (x9(2)%c2
/= ['45011','45012','45013'])) STOP 100
428 if (x10
%c1
/= '-501') STOP 101
429 if (any (x10
%c2
/= ['-502','-503','-504'])) STOP 102
430 if (x11(1)%c1
/= '36001') STOP 103
431 if (x11(2)%c1
/= '36002') STOP 104
432 if (any (x11(1)%c2
/= ['46001','46002','46003'])) STOP 105
433 if (any (x11(2)%c2
/= ['46011','46012','46013'])) STOP 106
435 if (any (x5
/= [ 'x5-42', 'x5-53' ])) STOP 107
437 if (x12(1)%c1
/= '37001') STOP 108
438 if (x12(2)%c1
/= '37002') STOP 109
439 if (any (x12(1)%c2
/= ['47001','47002','47003'])) STOP 110
440 if (any (x12(2)%c2
/= ['47011','47012','47013'])) STOP 111