1! { dg-do run }
2!
3! PR fortran/47339
4! PR fortran/43062
5!
6! Run-time test for Fortran 2003 NAMELISTS
7! Version for non-strings
8!
9program nml_test
10  implicit none
11
12  character(len=1000) :: str
13
14  character(len=5), allocatable :: a(:)
15  character(len=5), allocatable :: b
16  character(len=5), pointer :: ap(:)
17  character(len=5), pointer :: bp
18  character(len=5) :: c
19  character(len=5) :: d(3)
20
21  type t
22    character(len=5) :: c1
23    character(len=5) :: c2(3)
24  end type t
25  type(t) :: e,f(2)
26  type(t),allocatable :: g,h(:)
27  type(t),pointer :: i,j(:)
28
29  namelist /nml/ a, b, c, d, ap, bp,e,f,g,h,i,j
30
31  a = ["aa01", "aa02"]
32  allocate(b,ap(2),bp)
33  ap = ['98', '99']
34  b = '7'
35  bp = '101'
36  c = '8'
37  d = ['-1', '-2', '-3']
38
39  e%c1 = '-701'
40  e%c2 = ['-702','-703','-704']
41  f(1)%c1 = '33001'
42  f(2)%c1 = '33002'
43  f(1)%c2 = ['44001','44002','44003']
44  f(2)%c2 = ['44011','44012','44013']
45
46  allocate(g,h(2),i,j(2))
47
48  g%c1 = '-601'
49  g%c2 = ['-602','6703','-604']
50  h(1)%c1 = '35001'
51  h(2)%c1 = '35002'
52  h(1)%c2 = ['45001','45002','45003']
53  h(2)%c2 = ['45011','45012','45013']
54
55  i%c1 = '-501'
56  i%c2 = ['-502','-503','-504']
57  j(1)%c1 = '36001'
58  j(2)%c1 = '36002'
59  j(1)%c2 = ['46001','46002','46003']
60  j(2)%c2 = ['46011','46012','46013']
61
62  ! SAVE NAMELIST
63  str = repeat('X', len(str))
64  write(str,nml=nml)
65
66  ! RESET NAMELIST
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))
73
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))
80
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))
87
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))
94
95  ! Read back
96  read(str,nml=nml)
97
98  ! Check result
99  if (any (a /= ['aa01','aa02'])) call abort()
100  if (any (ap /= ['98', '99'])) call abort()
101  if (b /= '7') call abort()
102  if (bp /= '101') call abort()
103  if (c /= '8') call abort()
104  if (any (d /= ['-1', '-2', '-3'])) call abort()
105
106  if (e%c1 /= '-701') call abort()
107  if (any (e%c2 /= ['-702','-703','-704'])) call abort()
108  if (f(1)%c1 /= '33001') call abort()
109  if (f(2)%c1 /= '33002') call abort()
110  if (any (f(1)%c2 /= ['44001','44002','44003'])) call abort()
111  if (any (f(2)%c2 /= ['44011','44012','44013'])) call abort()
112
113  if (g%c1 /= '-601') call abort()
114  if (any(g%c2 /= ['-602','6703','-604'])) call abort()
115  if (h(1)%c1 /= '35001') call abort()
116  if (h(2)%c1 /= '35002') call abort()
117  if (any (h(1)%c2 /= ['45001','45002','45003'])) call abort()
118  if (any (h(2)%c2 /= ['45011','45012','45013'])) call abort()
119
120  if (i%c1 /= '-501') call abort()
121  if (any (i%c2 /= ['-502','-503','-504'])) call abort()
122  if (j(1)%c1 /= '36001') call abort()
123  if (j(2)%c1 /= '36002') call abort()
124  if (any (j(1)%c2 /= ['46001','46002','46003'])) call abort()
125  if (any (j(2)%c2 /= ['46011','46012','46013'])) call abort()
126
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)
131
132contains
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)
140    integer :: n
141    character(len=5) :: x5(n)
142    type(t) :: x6,x7(2)
143    type(t),allocatable :: x8,x9(:)
144    type(t),pointer :: x10,x11(:)
145    type(t) :: x12(n)
146
147    namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
148
149    x5 = [ 'x5-42', 'x5-53' ]
150
151    x12(1)%c1 = '37001'
152    x12(2)%c1 = '37002'
153    x12(1)%c2 = ['47001','47002','47003']
154    x12(2)%c2 = ['47011','47012','47013']
155
156    ! SAVE NAMELIST
157    str = repeat('X', len(str))
158    write(str,nml=nml2)
159
160    ! RESET NAMELIST
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))
167
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))
174
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))
181
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))
188
189    x5 = repeat('X', len(x5))
190
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))
195
196    ! Read back
197    read(str,nml=nml2)
198
199    ! Check result
200    if (any (x1 /= ['aa01','aa02'])) call abort()
201    if (any (x1p /= ['98', '99'])) call abort()
202    if (x2 /= '7') call abort()
203    if (x2p /= '101') call abort()
204    if (x3 /= '8') call abort()
205    if (any (x4 /= ['-1', '-2', '-3'])) call abort()
206
207    if (x6%c1 /= '-701') call abort()
208    if (any (x6%c2 /= ['-702','-703','-704'])) call abort()
209    if (x7(1)%c1 /= '33001') call abort()
210    if (x7(2)%c1 /= '33002') call abort()
211    if (any (x7(1)%c2 /= ['44001','44002','44003'])) call abort()
212    if (any (x7(2)%c2 /= ['44011','44012','44013'])) call abort()
213
214    if (x8%c1 /= '-601') call abort()
215    if (any(x8%c2 /= ['-602','6703','-604'])) call abort()
216    if (x9(1)%c1 /= '35001') call abort()
217    if (x9(2)%c1 /= '35002') call abort()
218    if (any (x9(1)%c2 /= ['45001','45002','45003'])) call abort()
219    if (any (x9(2)%c2 /= ['45011','45012','45013'])) call abort()
220
221    if (x10%c1 /= '-501') call abort()
222    if (any (x10%c2 /= ['-502','-503','-504'])) call abort()
223    if (x11(1)%c1 /= '36001') call abort()
224    if (x11(2)%c1 /= '36002') call abort()
225    if (any (x11(1)%c2 /= ['46001','46002','46003'])) call abort()
226    if (any (x11(2)%c2 /= ['46011','46012','46013'])) call abort()
227
228    if (any (x5 /= [ 'x5-42', 'x5-53' ])) call abort()
229
230    if (x12(1)%c1 /= '37001') call abort()
231    if (x12(2)%c1 /= '37002') call abort()
232    if (any (x12(1)%c2 /= ['47001','47002','47003'])) call abort()
233    if (any (x12(2)%c2 /= ['47011','47012','47013'])) call abort()
234  end subroutine test2
235
236  subroutine test3(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n,ll)
237    integer :: 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)
245    type(t) :: x6,x7(2)
246    type(t),allocatable :: x8,x9(:)
247    type(t),pointer :: x10,x11(:)
248    type(t) :: x12(n)
249
250   namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
251
252    x5 = [ 'x5-42', 'x5-53' ]
253
254    x12(1)%c1 = '37001'
255    x12(2)%c1 = '37002'
256    x12(1)%c2 = ['47001','47002','47003']
257    x12(2)%c2 = ['47011','47012','47013']
258
259    ! SAVE NAMELIST
260    str = repeat('X', len(str))
261    write(str,nml=nml2)
262
263    ! RESET NAMELIST
264    x1 = repeat('X', len(x1))
265    x1p = repeat('X', len(x1p))
266
267    x2 = repeat('X', len(x2))
268    x2p = repeat('X', len(x2p))
269    x3 = repeat('X', len(x3))
270    x4 = repeat('X', len(x4))
271
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))
278
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))
285
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))
292
293    x5 = repeat('X', len(x5))
294
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))
299
300    ! Read back
301    read(str,nml=nml2)
302
303    ! Check result
304    if (any (x1 /= ['aa01','aa02'])) call abort()
305    if (any (x1p /= ['98', '99'])) call abort()
306    if (x2 /= '7') call abort()
307    if (x2p /= '101') call abort()
308    if (x3 /= '8') call abort()
309    if (any (x4 /= ['-1', '-2', '-3'])) call abort()
310
311    if (x6%c1 /= '-701') call abort()
312    if (any (x6%c2 /= ['-702','-703','-704'])) call abort()
313    if (x7(1)%c1 /= '33001') call abort()
314    if (x7(2)%c1 /= '33002') call abort()
315    if (any (x7(1)%c2 /= ['44001','44002','44003'])) call abort()
316    if (any (x7(2)%c2 /= ['44011','44012','44013'])) call abort()
317
318    if (x8%c1 /= '-601') call abort()
319    if (any(x8%c2 /= ['-602','6703','-604'])) call abort()
320    if (x9(1)%c1 /= '35001') call abort()
321    if (x9(2)%c1 /= '35002') call abort()
322    if (any (x9(1)%c2 /= ['45001','45002','45003'])) call abort()
323    if (any (x9(2)%c2 /= ['45011','45012','45013'])) call abort()
324
325    if (x10%c1 /= '-501') call abort()
326    if (any (x10%c2 /= ['-502','-503','-504'])) call abort()
327    if (x11(1)%c1 /= '36001') call abort()
328    if (x11(2)%c1 /= '36002') call abort()
329    if (any (x11(1)%c2 /= ['46001','46002','46003'])) call abort()
330    if (any (x11(2)%c2 /= ['46011','46012','46013'])) call abort()
331
332    if (any (x5 /= [ 'x5-42', 'x5-53' ])) call abort()
333
334    if (x12(1)%c1 /= '37001') call abort()
335    if (x12(2)%c1 /= '37002') call abort()
336    if (any (x12(1)%c2 /= ['47001','47002','47003'])) call abort()
337    if (any (x12(2)%c2 /= ['47011','47012','47013'])) call abort()
338  end subroutine test3
339
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)
347    integer :: n
348    character(len=5) :: x5(n)
349    type(t) :: x6,x7(2)
350    type(t),allocatable :: x8,x9(:)
351    type(t),pointer :: x10,x11(:)
352    type(t) :: x12(n)
353
354    namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
355
356    x5 = [ 'x5-42', 'x5-53' ]
357
358    x12(1)%c1 = '37001'
359    x12(2)%c1 = '37002'
360    x12(1)%c2 = ['47001','47002','47003']
361    x12(2)%c2 = ['47011','47012','47013']
362
363    ! SAVE NAMELIST
364    str = repeat('X', len(str))
365    write(str,nml=nml2)
366
367    ! RESET NAMELIST
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))
374
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))
381
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))
388
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))
395
396    x5 = repeat('X', len(x5))
397
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))
402
403    ! Read back
404    read(str,nml=nml2)
405
406    ! Check result
407    if (any (x1 /= ['aa01','aa02'])) call abort()
408    if (any (x1p /= ['98', '99'])) call abort()
409    if (x2 /= '7') call abort()
410    if (x2p /= '101') call abort()
411    if (x3 /= '8') call abort()
412    if (any (x4 /= ['-1', '-2', '-3'])) call abort()
413
414    if (x6%c1 /= '-701') call abort()
415    if (any (x6%c2 /= ['-702','-703','-704'])) call abort()
416    if (x7(1)%c1 /= '33001') call abort()
417    if (x7(2)%c1 /= '33002') call abort()
418    if (any (x7(1)%c2 /= ['44001','44002','44003'])) call abort()
419    if (any (x7(2)%c2 /= ['44011','44012','44013'])) call abort()
420
421    if (x8%c1 /= '-601') call abort()
422    if (any(x8%c2 /= ['-602','6703','-604'])) call abort()
423    if (x9(1)%c1 /= '35001') call abort()
424    if (x9(2)%c1 /= '35002') call abort()
425    if (any (x9(1)%c2 /= ['45001','45002','45003'])) call abort()
426    if (any (x9(2)%c2 /= ['45011','45012','45013'])) call abort()
427
428    if (x10%c1 /= '-501') call abort()
429    if (any (x10%c2 /= ['-502','-503','-504'])) call abort()
430    if (x11(1)%c1 /= '36001') call abort()
431    if (x11(2)%c1 /= '36002') call abort()
432    if (any (x11(1)%c2 /= ['46001','46002','46003'])) call abort()
433    if (any (x11(2)%c2 /= ['46011','46012','46013'])) call abort()
434
435    if (any (x5 /= [ 'x5-42', 'x5-53' ])) call abort()
436
437    if (x12(1)%c1 /= '37001') call abort()
438    if (x12(2)%c1 /= '37002') call abort()
439    if (any (x12(1)%c2 /= ['47001','47002','47003'])) call abort()
440    if (any (x12(2)%c2 /= ['47011','47012','47013'])) call abort()
441  end subroutine test4
442end program nml_test
443