OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [namelist_70.f90] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { 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
!
9
program 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
 
132
contains
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
442
end program nml_test

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.