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