gcc/testsuite/gfortran.dg/namelist_69.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   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
 130 contains
 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
 233 end program nml_test