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'])) STOP 1 100 if (any (ap /= ['98', '99'])) STOP 2 101 if (b /= '7') STOP 3 102 if (bp /= '101') STOP 4 103 if (c /= '8') STOP 5 104 if (any (d /= ['-1', '-2', '-3'])) STOP 6 105 106 if (e%c1 /= '-701') STOP 7 107 if (any (e%c2 /= ['-702','-703','-704'])) STOP 8 108 if (f(1)%c1 /= '33001') STOP 9 109 if (f(2)%c1 /= '33002') STOP 10 110 if (any (f(1)%c2 /= ['44001','44002','44003'])) STOP 11 111 if (any (f(2)%c2 /= ['44011','44012','44013'])) STOP 12 112 113 if (g%c1 /= '-601') STOP 13 114 if (any(g%c2 /= ['-602','6703','-604'])) STOP 14 115 if (h(1)%c1 /= '35001') STOP 15 116 if (h(2)%c1 /= '35002') STOP 16 117 if (any (h(1)%c2 /= ['45001','45002','45003'])) STOP 17 118 if (any (h(2)%c2 /= ['45011','45012','45013'])) STOP 18 119 120 if (i%c1 /= '-501') STOP 19 121 if (any (i%c2 /= ['-502','-503','-504'])) STOP 20 122 if (j(1)%c1 /= '36001') STOP 21 123 if (j(2)%c1 /= '36002') STOP 22 124 if (any (j(1)%c2 /= ['46001','46002','46003'])) STOP 23 125 if (any (j(2)%c2 /= ['46011','46012','46013'])) STOP 24 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'])) STOP 25 201 if (any (x1p /= ['98', '99'])) STOP 26 202 if (x2 /= '7') STOP 27 203 if (x2p /= '101') STOP 28 204 if (x3 /= '8') STOP 29 205 if (any (x4 /= ['-1', '-2', '-3'])) STOP 30 206 207 if (x6%c1 /= '-701') STOP 31 208 if (any (x6%c2 /= ['-702','-703','-704'])) STOP 32 209 if (x7(1)%c1 /= '33001') STOP 33 210 if (x7(2)%c1 /= '33002') STOP 34 211 if (any (x7(1)%c2 /= ['44001','44002','44003'])) STOP 35 212 if (any (x7(2)%c2 /= ['44011','44012','44013'])) STOP 36 213 214 if (x8%c1 /= '-601') STOP 37 215 if (any(x8%c2 /= ['-602','6703','-604'])) STOP 38 216 if (x9(1)%c1 /= '35001') STOP 39 217 if (x9(2)%c1 /= '35002') STOP 40 218 if (any (x9(1)%c2 /= ['45001','45002','45003'])) STOP 41 219 if (any (x9(2)%c2 /= ['45011','45012','45013'])) STOP 42 220 221 if (x10%c1 /= '-501') STOP 43 222 if (any (x10%c2 /= ['-502','-503','-504'])) STOP 44 223 if (x11(1)%c1 /= '36001') STOP 45 224 if (x11(2)%c1 /= '36002') STOP 46 225 if (any (x11(1)%c2 /= ['46001','46002','46003'])) STOP 47 226 if (any (x11(2)%c2 /= ['46011','46012','46013'])) STOP 48 227 228 if (any (x5 /= [ 'x5-42', 'x5-53' ])) STOP 49 229 230 if (x12(1)%c1 /= '37001') STOP 50 231 if (x12(2)%c1 /= '37002') STOP 51 232 if (any (x12(1)%c2 /= ['47001','47002','47003'])) STOP 52 233 if (any (x12(2)%c2 /= ['47011','47012','47013'])) STOP 53 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'])) STOP 54 305 if (any (x1p /= ['98', '99'])) STOP 55 306 if (x2 /= '7') STOP 56 307 if (x2p /= '101') STOP 57 308 if (x3 /= '8') STOP 58 309 if (any (x4 /= ['-1', '-2', '-3'])) STOP 59 310 311 if (x6%c1 /= '-701') STOP 60 312 if (any (x6%c2 /= ['-702','-703','-704'])) STOP 61 313 if (x7(1)%c1 /= '33001') STOP 62 314 if (x7(2)%c1 /= '33002') STOP 63 315 if (any (x7(1)%c2 /= ['44001','44002','44003'])) STOP 64 316 if (any (x7(2)%c2 /= ['44011','44012','44013'])) STOP 65 317 318 if (x8%c1 /= '-601') STOP 66 319 if (any(x8%c2 /= ['-602','6703','-604'])) STOP 67 320 if (x9(1)%c1 /= '35001') STOP 68 321 if (x9(2)%c1 /= '35002') STOP 69 322 if (any (x9(1)%c2 /= ['45001','45002','45003'])) STOP 70 323 if (any (x9(2)%c2 /= ['45011','45012','45013'])) STOP 71 324 325 if (x10%c1 /= '-501') STOP 72 326 if (any (x10%c2 /= ['-502','-503','-504'])) STOP 73 327 if (x11(1)%c1 /= '36001') STOP 74 328 if (x11(2)%c1 /= '36002') STOP 75 329 if (any (x11(1)%c2 /= ['46001','46002','46003'])) STOP 76 330 if (any (x11(2)%c2 /= ['46011','46012','46013'])) STOP 77 331 332 if (any (x5 /= [ 'x5-42', 'x5-53' ])) STOP 78 333 334 if (x12(1)%c1 /= '37001') STOP 79 335 if (x12(2)%c1 /= '37002') STOP 80 336 if (any (x12(1)%c2 /= ['47001','47002','47003'])) STOP 81 337 if (any (x12(2)%c2 /= ['47011','47012','47013'])) STOP 82 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'])) STOP 83 408 if (any (x1p /= ['98', '99'])) STOP 84 409 if (x2 /= '7') STOP 85 410 if (x2p /= '101') STOP 86 411 if (x3 /= '8') STOP 87 412 if (any (x4 /= ['-1', '-2', '-3'])) STOP 88 413 414 if (x6%c1 /= '-701') STOP 89 415 if (any (x6%c2 /= ['-702','-703','-704'])) STOP 90 416 if (x7(1)%c1 /= '33001') STOP 91 417 if (x7(2)%c1 /= '33002') STOP 92 418 if (any (x7(1)%c2 /= ['44001','44002','44003'])) STOP 93 419 if (any (x7(2)%c2 /= ['44011','44012','44013'])) STOP 94 420 421 if (x8%c1 /= '-601') STOP 95 422 if (any(x8%c2 /= ['-602','6703','-604'])) STOP 96 423 if (x9(1)%c1 /= '35001') STOP 97 424 if (x9(2)%c1 /= '35002') STOP 98 425 if (any (x9(1)%c2 /= ['45001','45002','45003'])) STOP 99 426 if (any (x9(2)%c2 /= ['45011','45012','45013'])) STOP 100 427 428 if (x10%c1 /= '-501') STOP 101 429 if (any (x10%c2 /= ['-502','-503','-504'])) STOP 102 430 if (x11(1)%c1 /= '36001') STOP 103 431 if (x11(2)%c1 /= '36002') STOP 104 432 if (any (x11(1)%c2 /= ['46001','46002','46003'])) STOP 105 433 if (any (x11(2)%c2 /= ['46011','46012','46013'])) STOP 106 434 435 if (any (x5 /= [ 'x5-42', 'x5-53' ])) STOP 107 436 437 if (x12(1)%c1 /= '37001') STOP 108 438 if (x12(2)%c1 /= '37002') STOP 109 439 if (any (x12(1)%c2 /= ['47001','47002','47003'])) STOP 110 440 if (any (x12(2)%c2 /= ['47011','47012','47013'])) STOP 111 441 end subroutine test4 442end program nml_test 443