re PR libfortran/37707 (Namelist read of array of derived type incorrect)

2008-10-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	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

4 files changed, 79 insertions, 1 deletions

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  <jvdelisle@gcc.gnu.org>
+
+	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  <bernd.schmidt@analog.com>
 
 	* 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  <jvdelisle@gcc.gnu.org>
+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