Skip to content

R
riscv-gcc-1
Commit 4cc233c4 by Jerry DeLisle
Options

re PR libfortran/24794 (problem with namelist input of character array) 

2005-11-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	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
parent c4a108fd
Showing with 120 additions and 26 deletions
gcc/testsuite/ChangeLog
2005-11-22 Jerry DeLisle <jvdelisle@gcc.gnu.org>
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 <kazu@codesourcery.com>
PR target/23435
gcc/testsuite/gfortran.dg/namelist_12.f
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
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
......
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)
......
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. &
......
gcc/testsuite/gfortran.dg/namelist_21.f90 0 → 100644
!{ 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 <jvdelisle@gcc.gnu.org>.
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
gcc/testsuite/gfortran.dg/namelist_22.f90 0 → 100644
!{ 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 <jvdelisle@gcc.gnu.org>.
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
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 ()
......
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 ()
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment