From 360f7fb4e560e4effa6a3ca4540820400e5f1764 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Thu, 23 Oct 2008 02:42:36 +0000 Subject: [PATCH] re PR libfortran/37707 (Namelist read of array of derived type incorrect) 2008-10-22 Jerry DeLisle PR libfortran/37707 * gfortran.dg/namelist_18.f90: Update test. * gfortran.dg/namelist_55.f90: New test. * gfortran.dg/namelist_56.f90: New test. From-SVN: r141318 --- gcc/testsuite/ChangeLog | 7 +++++ gcc/testsuite/gfortran.dg/namelist_18.f90 | 2 +- gcc/testsuite/gfortran.dg/namelist_55.f90 | 50 +++++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/namelist_56.f90 | 21 +++++++++++++ 4 files changed, 79 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/namelist_55.f90 create mode 100644 gcc/testsuite/gfortran.dg/namelist_56.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 583ddbc..e5bd048 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2008-10-22 Jerry DeLisle + + PR libfortran/37707 + * gfortran.dg/namelist_18.f90: Update test. + * gfortran.dg/namelist_55.f90: New test. + * gfortran.dg/namelist_56.f90: New test. + 2008-10-22 Bernd Schmidt * gcc.target/bfin/hisilh.c: New file. diff --git a/gcc/testsuite/gfortran.dg/namelist_18.f90 b/gcc/testsuite/gfortran.dg/namelist_18.f90 index f5d4b3d..92b1875 100644 --- a/gcc/testsuite/gfortran.dg/namelist_18.f90 +++ b/gcc/testsuite/gfortran.dg/namelist_18.f90 @@ -14,7 +14,7 @@ program namelist_18 read (10, '(a)', iostat = ier) buffer if (ier .ne. 0) call abort () close (10) - If ((buffer(5:5) /= "f") .or. (buffer(9:9) /= " ")) call abort () + If ((buffer(6:6) /= "f") .or. (buffer(9:9) /= """")) call abort () open (10, status = "scratch", delim ="quote") write (10, mynml) diff --git a/gcc/testsuite/gfortran.dg/namelist_55.f90 b/gcc/testsuite/gfortran.dg/namelist_55.f90 new file mode 100644 index 0000000..20c7a21 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_55.f90 @@ -0,0 +1,50 @@ +! { dg-do run } +! PR37707 Namelist read of array of derived type incorrect +! Test case from PR, prepared by Jerry DeLisle +TYPE geometry + INTEGER :: nlon,nlat,nlev,projection + INTEGER :: center,subcenter,process + REAL :: west,south,east,north + REAL :: dlon,dlat + REAL :: polat,polon + REAL :: lonc,latc + REAL :: projlat,projlat2,projlon + CHARACTER(LEN=1) :: arakawa ='#' + INTEGER :: truncx,truncy ! Spectral truncation + INTEGER :: cie ! Flag fort CI (0), CIE gridpoint (1) + ! or CIE spectral (-1) + INTEGER :: nlat_i,nlon_i ! I length in Y and X direction + INTEGER :: nlat_e ,nlon_e ! E length in Y and X direction + LOGICAL :: do_geo = .true. +END TYPE geometry + +TYPE shortkey + INTEGER :: PPP ! 2. Parameter + INTEGER :: NNN ! 12. Gridpoint or spectral field 0 = gridpoint, 1 = spectral + INTEGER :: INTPM + CHARACTER(LEN=16) :: name +END TYPE shortkey +INTEGER, PARAMETER :: maxl = 200 ! Maximum number of levels to be read from namelist +INTEGER, PARAMETER :: max_atmkey = 10 ! Maximum number of extra fields in the + +REAL :: ahalf(maxl),bhalf(maxl) +TYPE (geometry) :: outgeo ; SAVE outgeo ! Output geometry + +TYPE (shortkey) :: atmkey(max_atmkey) ; SAVE atmkey +TYPE (shortkey) :: mlevkey(max_atmkey) ; SAVE mlevkey + +character*600 :: l = " &NAMINTERP atmkey%ppp = 076,058,062,079, atmkey%nnn = 000,000,000,000, & + & atmkey%name ='LIQUID_WATER','SOLID_WATER','SNOW','RAIN', OUTGEO%NLEV=10, & + & AHALF=0.,1.,2.,3.,4.,5.,6.,7.,8.,9., BHALF=0.,1.,2.,3.,4.,5.,6.,7.,8.,9., /" + +namelist /naminterp/outgeo,ahalf,bhalf,atmkey +print *, outgeo%nlev +read(l,nml=naminterp) +if (outgeo%nlev /= 10) call abort +if (any(ahalf(1:10) .ne. [0.,1.,2.,3.,4.,5.,6.,7.,8.,9.])) call abort +if (any(bhalf(1:10) .ne. [0.,1.,2.,3.,4.,5.,6.,7.,8.,9.])) call abort +if (any(atmkey(1:4)%ppp .ne. [076,058,062,079])) call abort +if (any(atmkey(1:4)%nnn .ne. [0,0,0,0])) call abort +if (any(atmkey(1:4)%name .ne. ['LIQUID_WATER','SOLID_WATER ','SNOW ',& + &'RAIN '])) call abort +end diff --git a/gcc/testsuite/gfortran.dg/namelist_56.f90 b/gcc/testsuite/gfortran.dg/namelist_56.f90 new file mode 100644 index 0000000..03fda75 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_56.f90 @@ -0,0 +1,21 @@ +! { dg-do run } +! PR37707 Namelist read of array of derived type incorrect +! Test case from Tobias Burnus + IMPLICIT NONE + integer :: j + character(len=5) :: str(4) + character(len=900) :: nlstr + namelist /nml/ str, j + str = '' + j = -42 + nlstr = '&nml str = "a", "b", "cde", j = 5 /' + read(nlstr,nml) + write(99,nml) + rewind(99) + j = -54 + str = 'XXXX' + read(99,nml) + if (j.ne.5) call abort + if (any(str.ne.["a ","b ","cde "," "])) call abort + close(99,status="delete") +end -- 2.7.4