From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/gfortran.dg/namelist_70.f90 | 442 ++++++++++++++++++++++++++++++ 1 file changed, 442 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/namelist_70.f90 (limited to 'gcc/testsuite/gfortran.dg/namelist_70.f90') diff --git a/gcc/testsuite/gfortran.dg/namelist_70.f90 b/gcc/testsuite/gfortran.dg/namelist_70.f90 new file mode 100644 index 000000000..f3edfc50c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_70.f90 @@ -0,0 +1,442 @@ +! { 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 -- cgit v1.2.3