! { dg-do run } ! ! PR fortran/47339 ! PR fortran/43062 ! ! Run-time test for Fortran 2003 NAMELISTS ! Version for non-strings ! program nml_test implicit none character(len=1000) :: str character(len=5), allocatable :: a(:) character(len=5), allocatable :: b character(len=5), pointer :: ap(:) character(len=5), pointer :: bp character(len=5) :: c character(len=5) :: d(3) type t character(len=5) :: c1 character(len=5) :: c2(3) end type t type(t) :: e,f(2) type(t),allocatable :: g,h(:) type(t),pointer :: i,j(:) namelist /nml/ a, b, c, d, ap, bp,e,f,g,h,i,j a = ["aa01", "aa02"] allocate(b,ap(2),bp) ap = ['98', '99'] b = '7' bp = '101' c = '8' d = ['-1', '-2', '-3'] e%c1 = '-701' e%c2 = ['-702','-703','-704'] f(1)%c1 = '33001' f(2)%c1 = '33002' f(1)%c2 = ['44001','44002','44003'] f(2)%c2 = ['44011','44012','44013'] allocate(g,h(2),i,j(2)) g%c1 = '-601' g%c2 = ['-602','6703','-604'] h(1)%c1 = '35001' h(2)%c1 = '35002' h(1)%c2 = ['45001','45002','45003'] h(2)%c2 = ['45011','45012','45013'] i%c1 = '-501' i%c2 = ['-502','-503','-504'] j(1)%c1 = '36001' j(2)%c1 = '36002' j(1)%c2 = ['46001','46002','46003'] j(2)%c2 = ['46011','46012','46013'] ! SAVE NAMELIST str = repeat('X', len(str)) write(str,nml=nml) ! RESET NAMELIST a = repeat('X', len(a)) ap = repeat('X', len(ap)) b = repeat('X', len(b)) bp = repeat('X', len(bp)) c = repeat('X', len(c)) d = repeat('X', len(d)) e%c1 = repeat('X', len(e%c1)) e%c2 = repeat('X', len(e%c2)) f(1)%c1 = repeat('X', len(f(1)%c1)) f(2)%c1 = repeat('X', len(f(2)%c1)) f(1)%c2 = repeat('X', len(f(1)%c2)) f(2)%c2 = repeat('X', len(f(2)%c2)) g%c1 = repeat('X', len(g%c1)) g%c2 = repeat('X', len(g%c1)) h(1)%c1 = repeat('X', len(h(1)%c1)) h(2)%c1 = repeat('X', len(h(1)%c1)) h(1)%c2 = repeat('X', len(h(1)%c1)) h(2)%c2 = repeat('X', len(h(1)%c1)) i%c1 = repeat('X', len(i%c1)) i%c2 = repeat('X', len(i%c1)) j(1)%c1 = repeat('X', len(j(1)%c1)) j(2)%c1 = repeat('X', len(j(2)%c1)) j(1)%c2 = repeat('X', len(j(1)%c2)) j(2)%c2 = repeat('X', len(j(2)%c2)) ! Read back read(str,nml=nml) ! Check result if (any (a /= ['aa01','aa02'])) call abort() if (any (ap /= ['98', '99'])) call abort() if (b /= '7') call abort() if (bp /= '101') call abort() if (c /= '8') call abort() if (any (d /= ['-1', '-2', '-3'])) call abort() if (e%c1 /= '-701') call abort() if (any (e%c2 /= ['-702','-703','-704'])) call abort() if (f(1)%c1 /= '33001') call abort() if (f(2)%c1 /= '33002') call abort() if (any (f(1)%c2 /= ['44001','44002','44003'])) call abort() if (any (f(2)%c2 /= ['44011','44012','44013'])) call abort() if (g%c1 /= '-601') call abort() if (any(g%c2 /= ['-602','6703','-604'])) call abort() if (h(1)%c1 /= '35001') call abort() if (h(2)%c1 /= '35002') call abort() if (any (h(1)%c2 /= ['45001','45002','45003'])) call abort() if (any (h(2)%c2 /= ['45011','45012','45013'])) call abort() if (i%c1 /= '-501') call abort() if (any (i%c2 /= ['-502','-503','-504'])) call abort() if (j(1)%c1 /= '36001') call abort() if (j(2)%c1 /= '36002') call abort() if (any (j(1)%c2 /= ['46001','46002','46003'])) call abort() if (any (j(2)%c2 /= ['46011','46012','46013'])) call abort() ! Check argument passing (dummy processing) call test2(a,b,c,d,ap,bp,e,f,g,h,i,j,2) call test3(a,b,c,d,ap,bp,e,f,g,h,i,j,2,len(a)) call test4(a,b,c,d,ap,bp,e,f,g,h,i,j,2) contains subroutine test2(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n) character(len=5), allocatable :: x1(:) character(len=5), allocatable :: x2 character(len=5), pointer :: x1p(:) character(len=5), pointer :: x2p character(len=5) :: x3 character(len=5) :: x4(3) integer :: n character(len=5) :: x5(n) type(t) :: x6,x7(2) type(t),allocatable :: x8,x9(:) type(t),pointer :: x10,x11(:) type(t) :: x12(n) namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12 x5 = [ 'x5-42', 'x5-53' ] x12(1)%c1 = '37001' x12(2)%c1 = '37002' x12(1)%c2 = ['47001','47002','47003'] x12(2)%c2 = ['47011','47012','47013'] ! SAVE NAMELIST str = repeat('X', len(str)) write(str,nml=nml2) ! RESET NAMELIST x1 = repeat('X', len(x1)) x1p = repeat('X', len(x1p)) x2 = repeat('X', len(x2)) x2p = repeat('X', len(x2p)) x3 = repeat('X', len(x3)) x4 = repeat('X', len(x4)) x6%c1 = repeat('X', len(x6%c1)) x6%c2 = repeat('X', len(x6%c2)) x7(1)%c1 = repeat('X', len(x7(1)%c1)) x7(2)%c1 = repeat('X', len(x7(2)%c1)) x7(1)%c2 = repeat('X', len(x7(1)%c2)) x7(2)%c2 = repeat('X', len(x7(2)%c2)) x8%c1 = repeat('X', len(x8%c1)) x8%c2 = repeat('X', len(x8%c1)) x9(1)%c1 = repeat('X', len(x9(1)%c1)) x9(2)%c1 = repeat('X', len(x9(1)%c1)) x9(1)%c2 = repeat('X', len(x9(1)%c1)) x9(2)%c2 = repeat('X', len(x9(1)%c1)) x10%c1 = repeat('X', len(x10%c1)) x10%c2 = repeat('X', len(x10%c1)) x11(1)%c1 = repeat('X', len(x11(1)%c1)) x11(2)%c1 = repeat('X', len(x11(2)%c1)) x11(1)%c2 = repeat('X', len(x11(1)%c2)) x11(2)%c2 = repeat('X', len(x11(2)%c2)) x5 = repeat('X', len(x5)) x12(1)%c1 = repeat('X', len(x12(2)%c2)) x12(2)%c1 = repeat('X', len(x12(2)%c2)) x12(1)%c2 = repeat('X', len(x12(2)%c2)) x12(2)%c2 = repeat('X', len(x12(2)%c2)) ! Read back read(str,nml=nml2) ! Check result if (any (x1 /= ['aa01','aa02'])) call abort() if (any (x1p /= ['98', '99'])) call abort() if (x2 /= '7') call abort() if (x2p /= '101') call abort() if (x3 /= '8') call abort() if (any (x4 /= ['-1', '-2', '-3'])) call abort() if (x6%c1 /= '-701') call abort() if (any (x6%c2 /= ['-702','-703','-704'])) call abort() if (x7(1)%c1 /= '33001') call abort() if (x7(2)%c1 /= '33002') call abort() if (any (x7(1)%c2 /= ['44001','44002','44003'])) call abort() if (any (x7(2)%c2 /= ['44011','44012','44013'])) call abort() if (x8%c1 /= '-601') call abort() if (any(x8%c2 /= ['-602','6703','-604'])) call abort() if (x9(1)%c1 /= '35001') call abort() if (x9(2)%c1 /= '35002') call abort() if (any (x9(1)%c2 /= ['45001','45002','45003'])) call abort() if (any (x9(2)%c2 /= ['45011','45012','45013'])) call abort() if (x10%c1 /= '-501') call abort() if (any (x10%c2 /= ['-502','-503','-504'])) call abort() if (x11(1)%c1 /= '36001') call abort() if (x11(2)%c1 /= '36002') call abort() if (any (x11(1)%c2 /= ['46001','46002','46003'])) call abort() if (any (x11(2)%c2 /= ['46011','46012','46013'])) call abort() if (any (x5 /= [ 'x5-42', 'x5-53' ])) call abort() if (x12(1)%c1 /= '37001') call abort() if (x12(2)%c1 /= '37002') call abort() if (any (x12(1)%c2 /= ['47001','47002','47003'])) call abort() if (any (x12(2)%c2 /= ['47011','47012','47013'])) call abort() end subroutine test2 subroutine test3(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n,ll) integer :: n, ll character(len=ll), allocatable :: x1(:) character(len=ll), allocatable :: x2 character(len=ll), pointer :: x1p(:) character(len=ll), pointer :: x2p character(len=ll) :: x3 character(len=ll) :: x4(3) character(len=ll) :: x5(n) type(t) :: x6,x7(2) type(t),allocatable :: x8,x9(:) type(t),pointer :: x10,x11(:) type(t) :: x12(n) namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12 x5 = [ 'x5-42', 'x5-53' ] x12(1)%c1 = '37001' x12(2)%c1 = '37002' x12(1)%c2 = ['47001','47002','47003'] x12(2)%c2 = ['47011','47012','47013'] ! SAVE NAMELIST str = repeat('X', len(str)) write(str,nml=nml2) ! RESET NAMELIST x1 = repeat('X', len(x1)) x1p = repeat('X', len(x1p)) x2 = repeat('X', len(x2)) x2p = repeat('X', len(x2p)) x3 = repeat('X', len(x3)) x4 = repeat('X', len(x4)) x6%c1 = repeat('X', len(x6%c1)) x6%c2 = repeat('X', len(x6%c2)) x7(1)%c1 = repeat('X', len(x7(1)%c1)) x7(2)%c1 = repeat('X', len(x7(2)%c1)) x7(1)%c2 = repeat('X', len(x7(1)%c2)) x7(2)%c2 = repeat('X', len(x7(2)%c2)) x8%c1 = repeat('X', len(x8%c1)) x8%c2 = repeat('X', len(x8%c1)) x9(1)%c1 = repeat('X', len(x9(1)%c1)) x9(2)%c1 = repeat('X', len(x9(1)%c1)) x9(1)%c2 = repeat('X', len(x9(1)%c1)) x9(2)%c2 = repeat('X', len(x9(1)%c1)) x10%c1 = repeat('X', len(x10%c1)) x10%c2 = repeat('X', len(x10%c1)) x11(1)%c1 = repeat('X', len(x11(1)%c1)) x11(2)%c1 = repeat('X', len(x11(2)%c1)) x11(1)%c2 = repeat('X', len(x11(1)%c2)) x11(2)%c2 = repeat('X', len(x11(2)%c2)) x5 = repeat('X', len(x5)) x12(1)%c1 = repeat('X', len(x12(2)%c2)) x12(2)%c1 = repeat('X', len(x12(2)%c2)) x12(1)%c2 = repeat('X', len(x12(2)%c2)) x12(2)%c2 = repeat('X', len(x12(2)%c2)) ! Read back read(str,nml=nml2) ! Check result if (any (x1 /= ['aa01','aa02'])) call abort() if (any (x1p /= ['98', '99'])) call abort() if (x2 /= '7') call abort() if (x2p /= '101') call abort() if (x3 /= '8') call abort() if (any (x4 /= ['-1', '-2', '-3'])) call abort() if (x6%c1 /= '-701') call abort() if (any (x6%c2 /= ['-702','-703','-704'])) call abort() if (x7(1)%c1 /= '33001') call abort() if (x7(2)%c1 /= '33002') call abort() if (any (x7(1)%c2 /= ['44001','44002','44003'])) call abort() if (any (x7(2)%c2 /= ['44011','44012','44013'])) call abort() if (x8%c1 /= '-601') call abort() if (any(x8%c2 /= ['-602','6703','-604'])) call abort() if (x9(1)%c1 /= '35001') call abort() if (x9(2)%c1 /= '35002') call abort() if (any (x9(1)%c2 /= ['45001','45002','45003'])) call abort() if (any (x9(2)%c2 /= ['45011','45012','45013'])) call abort() if (x10%c1 /= '-501') call abort() if (any (x10%c2 /= ['-502','-503','-504'])) call abort() if (x11(1)%c1 /= '36001') call abort() if (x11(2)%c1 /= '36002') call abort() if (any (x11(1)%c2 /= ['46001','46002','46003'])) call abort() if (any (x11(2)%c2 /= ['46011','46012','46013'])) call abort() if (any (x5 /= [ 'x5-42', 'x5-53' ])) call abort() if (x12(1)%c1 /= '37001') call abort() if (x12(2)%c1 /= '37002') call abort() if (any (x12(1)%c2 /= ['47001','47002','47003'])) call abort() if (any (x12(2)%c2 /= ['47011','47012','47013'])) call abort() end subroutine test3 subroutine test4(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n) character(len=*), allocatable :: x1(:) character(len=*), allocatable :: x2 character(len=*), pointer :: x1p(:) character(len=*), pointer :: x2p character(len=*) :: x3 character(len=*) :: x4(3) integer :: n character(len=5) :: x5(n) type(t) :: x6,x7(2) type(t),allocatable :: x8,x9(:) type(t),pointer :: x10,x11(:) type(t) :: x12(n) namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12 x5 = [ 'x5-42', 'x5-53' ] x12(1)%c1 = '37001' x12(2)%c1 = '37002' x12(1)%c2 = ['47001','47002','47003'] x12(2)%c2 = ['47011','47012','47013'] ! SAVE NAMELIST str = repeat('X', len(str)) write(str,nml=nml2) ! RESET NAMELIST x1 = repeat('X', len(x1)) x1p = repeat('X', len(x1p)) x2 = repeat('X', len(x2)) x2p = repeat('X', len(x2p)) x3 = repeat('X', len(x3)) x4 = repeat('X', len(x4)) x6%c1 = repeat('X', len(x6%c1)) x6%c2 = repeat('X', len(x6%c2)) x7(1)%c1 = repeat('X', len(x7(1)%c1)) x7(2)%c1 = repeat('X', len(x7(2)%c1)) x7(1)%c2 = repeat('X', len(x7(1)%c2)) x7(2)%c2 = repeat('X', len(x7(2)%c2)) x8%c1 = repeat('X', len(x8%c1)) x8%c2 = repeat('X', len(x8%c1)) x9(1)%c1 = repeat('X', len(x9(1)%c1)) x9(2)%c1 = repeat('X', len(x9(1)%c1)) x9(1)%c2 = repeat('X', len(x9(1)%c1)) x9(2)%c2 = repeat('X', len(x9(1)%c1)) x10%c1 = repeat('X', len(x10%c1)) x10%c2 = repeat('X', len(x10%c1)) x11(1)%c1 = repeat('X', len(x11(1)%c1)) x11(2)%c1 = repeat('X', len(x11(2)%c1)) x11(1)%c2 = repeat('X', len(x11(1)%c2)) x11(2)%c2 = repeat('X', len(x11(2)%c2)) x5 = repeat('X', len(x5)) x12(1)%c1 = repeat('X', len(x12(2)%c2)) x12(2)%c1 = repeat('X', len(x12(2)%c2)) x12(1)%c2 = repeat('X', len(x12(2)%c2)) x12(2)%c2 = repeat('X', len(x12(2)%c2)) ! Read back read(str,nml=nml2) ! Check result if (any (x1 /= ['aa01','aa02'])) call abort() if (any (x1p /= ['98', '99'])) call abort() if (x2 /= '7') call abort() if (x2p /= '101') call abort() if (x3 /= '8') call abort() if (any (x4 /= ['-1', '-2', '-3'])) call abort() if (x6%c1 /= '-701') call abort() if (any (x6%c2 /= ['-702','-703','-704'])) call abort() if (x7(1)%c1 /= '33001') call abort() if (x7(2)%c1 /= '33002') call abort() if (any (x7(1)%c2 /= ['44001','44002','44003'])) call abort() if (any (x7(2)%c2 /= ['44011','44012','44013'])) call abort() if (x8%c1 /= '-601') call abort() if (any(x8%c2 /= ['-602','6703','-604'])) call abort() if (x9(1)%c1 /= '35001') call abort() if (x9(2)%c1 /= '35002') call abort() if (any (x9(1)%c2 /= ['45001','45002','45003'])) call abort() if (any (x9(2)%c2 /= ['45011','45012','45013'])) call abort() if (x10%c1 /= '-501') call abort() if (any (x10%c2 /= ['-502','-503','-504'])) call abort() if (x11(1)%c1 /= '36001') call abort() if (x11(2)%c1 /= '36002') call abort() if (any (x11(1)%c2 /= ['46001','46002','46003'])) call abort() if (any (x11(2)%c2 /= ['46011','46012','46013'])) call abort() if (any (x5 /= [ 'x5-42', 'x5-53' ])) call abort() if (x12(1)%c1 /= '37001') call abort() if (x12(2)%c1 /= '37002') call abort() if (any (x12(1)%c2 /= ['47001','47002','47003'])) call abort() if (any (x12(2)%c2 /= ['47011','47012','47013'])) call abort() end subroutine test4 end program nml_test