gcc/testsuite/gfortran.dg/namelist_70.f90

   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 !
   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