re PR libfortran/34427 (Revision 130708 breaks namelist input)

2007-12-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/34427
	* gfortran.dg/namelist_42.f90: Update.
	* gfortran.dg/namelist_43.f90: New.

From-SVN: r131004
This commit is contained in:
Jerry DeLisle 2007-12-17 00:51:25 +00:00
parent 78a15b1f3f
commit ffeb38bce9
3 changed files with 68 additions and 3 deletions

View File

@ -1,3 +1,9 @@
2007-12-16 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/34427
* gfortran.dg/namelist_42.f90: Update.
* gfortran.dg/namelist_43.f90: New.
2007-12-16 Tobias Burnus <burnus@net-b.de>
PR fortran/34495

View File

@ -20,9 +20,22 @@
write (10,*) " &nl foo = 5, 5, 5, nan, infinity, infinity "
write (10,*)
write (10,*) " = 1, /"
! Does not work
!write (10,*) " &nl foo = 5, 5, 5, nan, infinity, infinity"
!write (10,*) " = 1, /"
rewind (10)
READ (10, NML = nl)
close (10)
if(infinity /= 1) call abort()
if(any(foo(1:3) /= [5.0, 5.0, 5.0]) .or. .not.isnan(foo(4)) &
.or. foo(5) <= huge(foo) .or. any(foo(6:11) /= -1.0)) &
call abort()
! Works too:
foo = -1.0
infinity = -1
open (10, status="scratch")
rewind (10)
write (10,'(a)') "&nl foo = 5, 5, 5, nan, infinity, infinity"
write (10,'(a)') "=1,/"
rewind (10)
READ (10, NML = nl)
CLOSE (10)

View File

@ -0,0 +1,46 @@
! { dg-do run }
! { dg-options "-mieee" { target sh*-*-* } }
!
! PR fortran/34427
!
! Check that namelists and the real values Inf, NaN, Infinity
! properly coexist with interceding line ends and spaces.
!
PROGRAM TEST
IMPLICIT NONE
real , DIMENSION(10) ::foo
integer :: infinity
integer :: numb
NAMELIST /nl/ foo
NAMELIST /nl/ infinity
foo = -1.0
infinity = -1
open (10, status="scratch")
write (10,'(a)') " &nl foo(1:6) = 5, 5, 5, nan, infinity"
write (10,'(a)')
write (10,'(a)')
write (10,'(a)')
write (10,'(a)')
write (10,'(a)') "infinity"
write (10,'(a)')
write (10,'(a)')
write (10,'(a)') " "
write (10,'(a)')
write (10,'(a)')
write (10,'(a)')
write (10,'(a)')
write (10,'(a)')
write (10,'(a)')
write (10,'(a)')
write (10,'(a)')
write (10,'(a)') "=1/"
rewind (10)
READ (10, NML = nl)
CLOSE (10)
if(infinity /= 1) call abort
if(any(foo(1:3) /= [5.0, 5.0, 5.0]) .or. .not.isnan(foo(4)) &
.or. (foo(5) <= huge(foo)) .or. any(foo(6:10) /= -1.0)) &
call abort
END PROGRAM TEST