diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index adab396193e..0f2e06fc58d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2007-10-03 Jerry DeLisle + + PR libfortran/33253 + * gfortran.dg/namelist_38.f90: New test. + * gfortran.dg/namelist_39.f90: New test. + 2007-10-03 Francois-Xavier Coudert PR libfortran/33469 diff --git a/gcc/testsuite/gfortran.dg/namelist_38.f90 b/gcc/testsuite/gfortran.dg/namelist_38.f90 new file mode 100644 index 00000000000..5578654eea4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_38.f90 @@ -0,0 +1,36 @@ +! { dg-do run } +! PR33253 namelist: reading back a string, also fixed writing with delimiters. +! Test case modified from that of the PR by +! Jerry DeLisle +program main + implicit none + character(len=3) :: a + namelist /foo/ a + + open(10, status="scratch", delim="quote") + a = 'a"a' + write(10,foo) + rewind 10 + a = "" + read (10,foo) ! This gave a runtime error before the patch. + if (a.ne.'a"a') call abort + close (10) + + open(10, status="scratch", delim="apostrophe") + a = "a'a" + write(10,foo) + rewind 10 + a = "" + read (10,foo) + if (a.ne."a'a") call abort + close (10) + + open(10, status="scratch", delim="none") + a = "a'a" + write(10,foo) + rewind 10 + a = "" + read (10,foo) + if (a.ne."a'a") call abort + close (10) +end program main diff --git a/gcc/testsuite/gfortran.dg/namelist_39.f90 b/gcc/testsuite/gfortran.dg/namelist_39.f90 new file mode 100644 index 00000000000..758b2deccfd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_39.f90 @@ -0,0 +1,25 @@ +! { dg-do run } +! PR33421 and PR33253 Weird quotation of namelist output of character arrays +! Test case from Toon Moene, adapted by Jerry DeLisle + +program test +implicit none +character(len=45) :: b(3) +namelist /nam/ b +b = 'x' +open(99, status="scratch") +write(99,'(4(a,/),a)') "&NAM", & + " b(1)=' AAP NOOT MIES WIM ZUS JET',", & + " b(2)='SURF.PRESSURE',", & + " b(3)='APEKOOL',", & + " /" +rewind(99) +read(99,nml=nam) +close(99) + +if (b(1).ne." AAP NOOT MIES WIM ZUS JET ") call abort +if (b(2).ne."SURF.PRESSURE ") call abort +if (b(3).ne."APEKOOL ") call abort + +end program test +