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 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 132contains 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 442end program nml_test 443