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  integer, allocatable :: a(:)
15  integer, allocatable :: b
16  integer, pointer :: ap(:)
17  integer, pointer :: bp
18  integer :: c
19  integer :: d(3)
20
21  type t
22    integer :: c1
23    integer :: 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 = [1,2]
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 = [-1,-1]
68  ap = [-1, -1]
69  b = -1
70  bp = -1
71  c = -1
72  d = [-1, -1, -1]
73
74  e%c1 = -1
75  e%c2 = [-1,-1,-1]
76  f(1)%c1 = -1
77  f(2)%c1 = -1
78  f(1)%c2 = [-1,-1,-1]
79  f(2)%c2 = [-1,-1,-1]
80
81  g%c1 = -1
82  g%c2 = [-1,-1,-1]
83  h(1)%c1 = -1
84  h(2)%c1 = -1
85  h(1)%c2 = [-1,-1,-1]
86  h(2)%c2 = [-1,-1,-1]
87
88  i%c1 = -1
89  i%c2 = [-1,-1,-1]
90  j(1)%c1 = -1
91  j(2)%c1 = -1
92  j(1)%c2 = [-1,-1,-1]
93  j(2)%c2 = [-1,-1,-1]
94
95  ! Read back
96  read(str,nml=nml)
97
98  ! Check result
99  if (any (a /= [1,2])) 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
130contains
131  subroutine test2(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n)
132    integer, allocatable :: x1(:)
133    integer, allocatable :: x2
134    integer, pointer :: x1p(:)
135    integer, pointer :: x2p
136    integer :: x3
137    integer :: x4(3)
138    integer :: n
139    integer :: x5(n)
140    type(t) :: x6,x7(2)
141    type(t),allocatable :: x8,x9(:)
142    type(t),pointer :: x10,x11(:)
143    type(t) :: x12(n)
144
145    namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
146
147    x5 = [ 42, 53 ]
148
149    x12(1)%c1 = 37001
150    x12(2)%c1 = 37002
151    x12(1)%c2 = [47001,47002,47003]
152    x12(2)%c2 = [47011,47012,47013]
153
154    ! SAVE NAMELIST
155    str = repeat('X', len(str))
156    write(str,nml=nml2)
157
158    ! RESET NAMELIST
159    x1 = [-1,-1]
160    x1p = [-1, -1]
161    x2 = -1
162    x2p = -1
163    x3 = -1
164    x4 = [-1, -1, -1]
165
166    x6%c1 = -1
167    x6%c2 = [-1,-1,-1]
168    x7(1)%c1 = -1
169    x7(2)%c1 = -1
170    x7(1)%c2 = [-1,-1,-1]
171    x7(2)%c2 = [-1,-1,-1]
172
173    x8%c1 = -1
174    x8%c2 = [-1,-1,-1]
175    x9(1)%c1 = -1
176    x9(2)%c1 = -1
177    x9(1)%c2 = [-1,-1,-1]
178    x9(2)%c2 = [-1,-1,-1]
179
180    x10%c1 = -1
181    x10%c2 = [-1,-1,-1]
182    x11(1)%c1 = -1
183    x11(2)%c1 = -1
184    x11(1)%c2 = [-1,-1,-1]
185    x11(2)%c2 = [-1,-1,-1]
186
187    x5 = [ -1, -1 ]
188
189    x12(1)%c1 = -1
190    x12(2)%c1 = -1
191    x12(1)%c2 = [-1,-1,-1]
192    x12(2)%c2 = [-1,-1,-1]
193
194    ! Read back
195    read(str,nml=nml2)
196
197    ! Check result
198    if (any (x1 /= [1,2])) call abort()
199    if (any (x1p /= [98, 99])) call abort()
200    if (x2 /= 7) call abort()
201    if (x2p /= 101) call abort()
202    if (x3 /= 8) call abort()
203    if (any (x4 /= [-1, -2, -3])) call abort()
204
205    if (x6%c1 /= -701) call abort()
206    if (any (x6%c2 /= [-702,-703,-704])) call abort()
207    if (x7(1)%c1 /= 33001) call abort()
208    if (x7(2)%c1 /= 33002) call abort()
209    if (any (x7(1)%c2 /= [44001,44002,44003])) call abort()
210    if (any (x7(2)%c2 /= [44011,44012,44013])) call abort()
211
212    if (x8%c1 /= -601) call abort()
213    if (any(x8%c2 /= [-602,6703,-604])) call abort()
214    if (x9(1)%c1 /= 35001) call abort()
215    if (x9(2)%c1 /= 35002) call abort()
216    if (any (x9(1)%c2 /= [45001,45002,45003])) call abort()
217    if (any (x9(2)%c2 /= [45011,45012,45013])) call abort()
218
219    if (x10%c1 /= -501) call abort()
220    if (any (x10%c2 /= [-502,-503,-504])) call abort()
221    if (x11(1)%c1 /= 36001) call abort()
222    if (x11(2)%c1 /= 36002) call abort()
223    if (any (x11(1)%c2 /= [46001,46002,46003])) call abort()
224    if (any (x11(2)%c2 /= [46011,46012,46013])) call abort()
225
226    if (any (x5 /= [ 42, 53 ])) call abort()
227
228    if (x12(1)%c1 /= 37001) call abort()
229    if (x12(2)%c1 /= 37002) call abort()
230    if (any (x12(1)%c2 /= [47001,47002,47003])) call abort()
231    if (any (x12(2)%c2 /= [47011,47012,47013])) call abort()
232  end subroutine test2
233end program nml_test
234