From: Jerry DeLisle Date: Wed, 23 Nov 2005 02:14:26 +0000 (+0000) Subject: re PR libfortran/24794 (problem with namelist input of character array) X-Git-Tag: releases/gcc-4.2.0~5796 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=4cc233c4116f3fe96b04f36477578d003cbfa0f3;p=thirdparty%2Fgcc.git re PR libfortran/24794 (problem with namelist input of character array) 2005-11-22 Jerry DeLisle PR libgfortran/24794 * gfortran.dg/namelist_12.f: Fix quotes. * gfortran.dg/namelist_13.f90: Fix quotes. * gfortran.dg/namelist_14.f90: Fix quotes. * gfortran.dg/namelist_15.f90: Fix quotes. * gfortran.dg/namelist_use.f90: Fix quotes. * gfortran.dg/namelist_use_only.f90: Fix quotes. * gfortran.dg/namelist_21.f90: New test. * gfortran.dg/namelist_22.f90: New test. From-SVN: r107396 --- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ae58dc0cd7a9..85ff4845637d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,15 @@ +2005-11-22 Jerry DeLisle + + PR libgfortran/24794 + * gfortran.dg/namelist_12.f: Fix quotes. + * gfortran.dg/namelist_13.f90: Fix quotes. + * gfortran.dg/namelist_14.f90: Fix quotes. + * gfortran.dg/namelist_15.f90: Fix quotes. + * gfortran.dg/namelist_use.f90: Fix quotes. + * gfortran.dg/namelist_use_only.f90: Fix quotes. + * gfortran.dg/namelist_21.f90: New test. + * gfortran.dg/namelist_22.f90: New test. + 2005-11-22 Kazu Hirata PR target/23435 diff --git a/gcc/testsuite/gfortran.dg/namelist_12.f b/gcc/testsuite/gfortran.dg/namelist_12.f index e6d122463f1b..6a7bfad83ba5 100644 --- a/gcc/testsuite/gfortran.dg/namelist_12.f +++ b/gcc/testsuite/gfortran.dg/namelist_12.f @@ -1,9 +1,9 @@ c{ dg-do run } -c This program repeats many of the same tests as test_nml_1 but for integer instead of real. -c It also tests repeat nulls, comma delimited character read, a triplet qualifier, a range with -c and assumed start, a quote delimited string, a qualifier with an assumed end and a fully -c explicit range. It also tests that integers and characters are successfully read back by -c namelist. +c This program repeats many of the same tests as test_nml_1 but for integer +c instead of real. It also tests repeat nulls, comma delimited character read, +c a triplet qualifier, a range with and assumed start, a quote delimited string, +c a qualifier with an assumed end and a fully explicit range. It also tests +c that integers and characters are successfully read back by namelist. c Provided by Paul Thomas - pault@gcc.gnu.org program namelist_12 @@ -25,14 +25,14 @@ c set debug = 0 or 1 in the namelist! (line 33) ch ="zzzzzzzzzz" check="abcdefghij" - open (10,status="scratch") - write (10, *) "!mynml" - write (10, *) " " - write (10, *) "&mynml x(7) =+99 x=1, 2 ," - write (10, *) " 2*3, ,, 2* !comment" - write (10, *) " 9 ch=qqqdefghqq , x(8:7:-1) = 8 , 7" - write (10, *) " ch(:3) =""abc""," - write (10, *) " ch(9:)='ij' x(4:5)=4 ,5 xx = 42/" + open (10,status="scratch", delim="apostrophe") + write (10, '(a)') "!mynml" + write (10, '(a)') " " + write (10, '(a)') "&mynml x(7) =+99 x=1, 2 ," + write (10, '(a)') " 2*3, ,, 2* !comment" + write (10, '(a)') " 9 ch='qqqdefghqq' , x(8:7:-1) = 8 , 7" + write (10, '(a)') " ch(:3) =""abc""," + write (10, '(a)') " ch(9:)='ij' x(4:5)=4 ,5 xx = 42/" rewind (10) read (10, nml=mynml, IOSTAT=ier) @@ -52,5 +52,4 @@ c set debug = 0 or 1 in the namelist! (line 33) if ( ch(i:i).ne.check(I:I) ) call abort end do if (xx.ne.42) call abort () - end program diff --git a/gcc/testsuite/gfortran.dg/namelist_13.f90 b/gcc/testsuite/gfortran.dg/namelist_13.f90 index 5b7122ca302d..185b522e7f03 100644 --- a/gcc/testsuite/gfortran.dg/namelist_13.f90 +++ b/gcc/testsuite/gfortran.dg/namelist_13.f90 @@ -25,7 +25,7 @@ program namelist_13 zeros = 0 zeros(5) = 1 - open(10,status="scratch") + open(10,status="scratch", delim="apostrophe") write (10, nml=mynml, iostat=ier) if (ier.ne.0) call abort diff --git a/gcc/testsuite/gfortran.dg/namelist_14.f90 b/gcc/testsuite/gfortran.dg/namelist_14.f90 index d22040f8a2ad..d6fc9b6ca614 100644 --- a/gcc/testsuite/gfortran.dg/namelist_14.f90 +++ b/gcc/testsuite/gfortran.dg/namelist_14.f90 @@ -55,7 +55,7 @@ contains dts = mt ((/1, 2, 3, 4/)) dtl = mt ((/41, 42, 43, 44/)) - open (10, status = "scratch") + open (10, status = "scratch", delim='apostrophe') write (10, nml = z, iostat = ier) if (ier /= 0 ) call abort() rewind (10) diff --git a/gcc/testsuite/gfortran.dg/namelist_15.f90 b/gcc/testsuite/gfortran.dg/namelist_15.f90 index 8c64ab0ea225..50f02927ce5d 100644 --- a/gcc/testsuite/gfortran.dg/namelist_15.f90 +++ b/gcc/testsuite/gfortran.dg/namelist_15.f90 @@ -25,21 +25,22 @@ program namelist_15 write (10, '(A)') " x = 3, 4, 'dd', 'ee', 'ff', 'gg'," write (10, '(A)') " 4, 5, 'hh', 'ii', 'jj', 'kk'," write (10, '(A)') " x%i = , ,-3, -4" - write (10, '(A)') " x(2)%m(1)%ch(2) =q," - write (10, '(A)') " x(2)%m(2)%ch(1)(1) =w," - write (10, '(A)') " x%m%ch(:)(2) =z z z z z z z z," + write (10, '(A)') " x(2)%m(1)%ch(2) ='q'," + write (10, '(A)') " x(2)%m(2)%ch(1)(1) ='w'," + write (10, '(A)') " x%m%ch(:)(2) = 'z','z','z','z','z','z','z','z'," write (10, '(A)') "&end" rewind (10) read (10, nml = mynml, iostat = ier) - if (ier .ne. 0) call abort () + if (ier .ne. 0) print *, 'First read.' !call abort () close (10) - open (10, status = "scratch") + open (10, status = "scratch", delim='apostrophe') write (10, nml = mynml) rewind (10) + read (10, nml = mynml, iostat = ier) - if (ier .ne. 0) call abort () + if (ier .ne. 0) print *, 'Second read.' !call abort () close(10) if (.not. ((x(1)%i(1) == 3) .and. & @@ -55,4 +56,4 @@ program namelist_15 (x(2)%m(2)%ch(1) == "wz") .and. & (x(2)%m(2)%ch(2) == "kz"))) call abort () -end program namelist_15 +end program namelist_15 diff --git a/gcc/testsuite/gfortran.dg/namelist_21.f90 b/gcc/testsuite/gfortran.dg/namelist_21.f90 new file mode 100644 index 000000000000..463ef1b9e4f8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_21.f90 @@ -0,0 +1,41 @@ +!{ dg-do run } +! Tests filling arrays from a namelist read when object list is not complete. +! Developed from a test case provided by Christoph Jacob. +! Contributed by Jerry DeLisle . +program pr24794 + + implicit none + integer, parameter :: maxop=15, iunit=7 + character*8 namea(maxop), nameb(maxop) + integer i, ier + + namelist/ccsopr/ namea,nameb + namea="" + nameb="" + open (12, status="scratch", delim="apostrophe") + write (12, '(a)') "&ccsopr" + write (12, '(a)') " namea='spi01h','spi02o','spi03h','spi04o','spi05h'," + write (12, '(a)') " 'spi07o','spi08h','spi09h'," + write (12, '(a)') " nameb='spi01h','spi03h','spi05h','spi06h','spi08h'," + write (12, '(a)') "&end" + + rewind (12) + read (12, nml=ccsopr, iostat=ier) + if (ier.ne.0) call abort() + + rewind (12) + write(12,nml=ccsopr) + + rewind (12) + read (12, nml=ccsopr, iostat=ier) + if (ier.ne.0) call abort() + + if (namea(2).ne."spi02o ") call abort() + if (namea(9).ne." ") call abort() + if (namea(15).ne." ") call abort() + if (nameb(1).ne."spi01h ") call abort() + if (nameb(6).ne." ") call abort() + if (nameb(15).ne." ") call abort() + + close (12) +end program pr24794 diff --git a/gcc/testsuite/gfortran.dg/namelist_22.f90 b/gcc/testsuite/gfortran.dg/namelist_22.f90 new file mode 100644 index 000000000000..6face8b1f5be --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_22.f90 @@ -0,0 +1,41 @@ +!{ dg-do run } +! Tests filling arrays from a namelist read when object list is not complete. +! This is the same as namelist_21.f90 except using spaces as seperators instead +! of commas. Developed from a test case provided by Christoph Jacob. +! Contributed by Jerry DeLisle . +program pr24794 + + implicit none + integer, parameter :: maxop=15, iunit=7 + character*8 namea(maxop), nameb(maxop) + integer i, ier + + namelist/ccsopr/ namea,nameb + namea="" + nameb="" + open (12, status="scratch", delim="apostrophe") + write (12, '(a)') "&ccsopr" + write (12, '(a)') " namea='spi01h' 'spi02o' 'spi03h' 'spi04o' 'spi05h'" + write (12, '(a)') " 'spi07o' 'spi08h' 'spi09h'" + write (12, '(a)') " nameb='spi01h' 'spi03h' 'spi05h' 'spi06h' 'spi08h'" + write (12, '(a)') "&end" + + rewind (12) + read (12, nml=ccsopr, iostat=ier) + if (ier.ne.0) call abort() + + rewind (12) + write(12,nml=ccsopr) + + rewind (12) + read (12, nml=ccsopr, iostat=ier) + if (ier.ne.0) call abort() + if (namea(2).ne."spi02o ") call abort() + if (namea(9).ne." ") call abort() + if (namea(15).ne." ") call abort() + if (nameb(1).ne."spi01h ") call abort() + if (nameb(6).ne." ") call abort() + if (nameb(15).ne." ") call abort() + + close (12) +end program pr24794 diff --git a/gcc/testsuite/gfortran.dg/namelist_use.f90 b/gcc/testsuite/gfortran.dg/namelist_use.f90 index bbbb178c99b8..871e529a1a4d 100644 --- a/gcc/testsuite/gfortran.dg/namelist_use.f90 +++ b/gcc/testsuite/gfortran.dg/namelist_use.f90 @@ -17,8 +17,8 @@ program namelist_use real :: rrr namelist /nml2/ ii, rrr ! Concatenate use and host associated variables. open (10, status="scratch") - write (10,*) "&NML1 aa=lmno ii=1 rr=2.5 /" - write (10,*) "&NML2 aa=pqrs ii=2 rrr=3.5 /" + write (10,*) "&NML1 aa='lmno' ii=1 rr=2.5 /" + write (10,*) "&NML2 aa='pqrs' ii=2 rrr=3.5 /" rewind (10) read (10,nml=nml1,iostat=i) if ((i.ne.0).or.(aa.ne."lmno").or.(ii.ne.1).or.(rr.ne.2.5)) call abort () diff --git a/gcc/testsuite/gfortran.dg/namelist_use_only.f90 b/gcc/testsuite/gfortran.dg/namelist_use_only.f90 index f7a948c851b5..3f7b8e6ff4e6 100644 --- a/gcc/testsuite/gfortran.dg/namelist_use_only.f90 +++ b/gcc/testsuite/gfortran.dg/namelist_use_only.f90 @@ -22,8 +22,8 @@ program namelist_use_only use global, only : nml1, aa, ii, rr use global, only : nml2, rrrr=>rrr, foo open (10, status="scratch") - write (10,*) "&NML1 aa=lmno ii=1 rr=2.5 /" - write (10,*) "&NML2 aaa=pqrs iii=2 rrr=3.5 /" + write (10,'(a)') "&NML1 aa='lmno' ii=1 rr=2.5 /" + write (10,'(a)') "&NML2 aaa='pqrs' iii=2 rrr=3.5 /" rewind (10) read (10,nml=nml1,iostat=i) if ((i.ne.0).or.(aa.ne."lmno").or.(ii.ne.1).or.(rr.ne.2.5)) call abort ()