FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Jerry DeLisle 2008-10-23 02:42:36 +00:00
parent a7f5d0542a
commit 360f7fb4e5
4 changed files with 79 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/testsuite/ChangeLog
View file

@ -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.

2
gcc/testsuite/gfortran.dg/namelist_18.f90
View file

@ -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)

50
gcc/testsuite/gfortran.dg/namelist_55.f90 Normal file
View file

@ -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

21
gcc/testsuite/gfortran.dg/namelist_56.f90 Normal file
View file

@ -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