[patch, libfortran] PR34427 namelist input of inf-nan

[Jerry DeLisle <jvdelisle at verizon dot net>]

Hi folks,   HJL will you please test this patch on SPEC?

This patch is a follow-up patch to Tobias patch for this PR.

This patch addresses a failure we got when no delimiter other than a line end 
was given between a value and a subsequent object name.

This was caused by reading the line end '\n' and saving it as part of the object 
name string.  I check for this in get_name and don't do that. (A latent bug sort of)

To handle multiple intervening lines and spaces, I added code to eat all the 
preceding line ends and spaces before checking for an "=" when trying to see if 
we are reading a value "Infinity" or an object name "Infinity".  With this patch 
we can have practically unlimited spaces and line ends since we just skip them.

Note: F95 Standard 10.9: "The end of a record has the same effect as a blank 
character, unless it is within a character constant."

We don't need to count the characters in the object name because as soon as we 
have a non separator after "infinity" we unwind. The get_name code will then 
takeover.  Likewise when looking for the "=", since we know we already have a 
separator at that point if the next character is "=" it must be an object name 
or a misplaced "=".

(side note: This is a quite different situation from read_logical where any 
value starting with a 't' or 'f' is interpreted as .true. or .false. value 
unless it is an object name.  The only way to know in that case is to read up to 
64 characters in the name and not hit a '='.)

I revised namelist_42.f90 and added namelist_43.f90 to illustrate some of the 
issues.  I have not gone through some of the other data type reads to see what 
happens for them in the intervening spaces and lines situations.  I will do that 
later.

Regression tested on x86-64.

OK for trunk?

Jerry

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

	PR fortran/34427
	* io/list_read.c (read_real): Handle intervening line ends and spaces.
	(get_name): Don't push separators to saved_string.
	(eat_separator): If in namelist mode eat spaces and line ends as well.

! { dg-do run }
! { dg-options "-mieee" { target sh*-*-* } }
!
! PR fortran/34427
!
! Check that namelists and the real values Inf, NaN, Infinity
! properly coexist.
!
 PROGRAM TEST
  IMPLICIT NONE
  real , DIMENSION(11) ::foo 
  integer :: infinity
  NAMELIST /nl/ foo
  NAMELIST /nl/ infinity
  foo = -1.0
  infinity = -1

  open (10, status="scratch")
! Works:
  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()
 END PROGRAM TEST

! { 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

Index: list_read.c
===================================================================
--- list_read.c	(revision 130941)
+++ list_read.c	(working copy)
@@ -316,6 +316,13 @@ eat_separator (st_parameter_dt *dtp)
 
     case '\n':
       dtp->u.p.at_eol = 1;
+      if (dtp->u.p.namelist_mode)
+	{
+	  do
+	    c = next_char (dtp);
+	  while (c == '\n' || c == '\r' || c == ' ');
+	  unget_char (dtp, c);
+	}
       break;
 
     case '!':
@@ -1578,20 +1585,22 @@ read_real (st_parameter_dt *dtp, int len
       l_push_char (dtp, c);
     }
 
-  if (!is_separator (c) || c == '=')
+  if (!is_separator (c))
     goto unwind;
 
-  if (dtp->u.p.namelist_mode && c != ',' && c != '/')
-    for (i = 0; i < 63; i++)
-    { 
-      eat_spaces (dtp);
-      c = next_char (dtp);
-      l_push_char (dtp, c);
-      if (c == '=')
-	goto unwind;
+  if (dtp->u.p.namelist_mode)
+    {	
+      if (c == ' ' || c =='\n' || c == '\r')
+	{
+	  do
+	    c = next_char (dtp);
+	  while (c == ' ' || c =='\n' || c == '\r');
 
-      if (c == ',' || c == '/' || !is_separator(c))
-	break;
+	  l_push_char (dtp, c);
+
+	  if (c == '=')
+	    goto unwind;
+	}
     }
 
   if (is_inf)
@@ -2594,7 +2603,8 @@ get_name:
 
   do
     {
-      push_char (dtp, tolower(c));
+      if (!is_separator (c))
+	push_char (dtp, tolower(c));
       c = next_char (dtp);
     } while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' ));