[patch, libfortran] PR33253 Namelist problems

[Jerry DeLisle <jvdelisle at verizon dot net>]

The attached patch I believe is a solid fix now.  I borrowed code from what I 
wrote for read_logical some time ago once I realized it was a similar problem.

We have to know when the next string read is an object name or a string to 
decide whether to do an extended read, more values read then are asked for.

To do this, I use the line_buffer to save characters and look ahead for a '=' or 
'(' that indicate an object name.  Realize that this is non-standard reading we 
are enabling as an extension.  If a string does not have a delimiter of ' or " 
we have to do this read ahead.  It won't work if the non-delimited string has an 
intentional = or ( in it.  So be it, its already bad practice that we are 
supporting for older code.  It will work for typical cases.

If someone runs into a situation that does not work, they need to use delimiters.

Regression tested on x86-64 twice.  Updated namelist_39.f90 to exercise the look 
ahead.

OK for trunk?

Jerry

2007-10-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/33253
	* io/list_read.c (read_character): Use line_buffer to scan ahead for
	object name or string when no delimiter is found.

Index: list_read.c
===================================================================
--- list_read.c	(revision 128973)
+++ list_read.c	(working copy)
@@ -893,14 +893,54 @@ read_character (st_parameter_dt *dtp, in
       goto get_string;
 
     default:
-      if (dtp->u.p.namelist_mode
-	  && (dtp->u.p.current_unit->flags.delim == DELIM_APOSTROPHE
-	      || dtp->u.p.current_unit->flags.delim == DELIM_QUOTE
-	      || quote == ' '))
+      if (dtp->u.p.namelist_mode)
 	{
-	  unget_char (dtp,c);
-	  return;
+	  if (dtp->u.p.current_unit->flags.delim == DELIM_APOSTROPHE
+	      || dtp->u.p.current_unit->flags.delim == DELIM_QUOTE)
+	    {
+	      unget_char (dtp, c);
+	      return;
+	    }
+
+	  /* Check to see if we are seeing a namelist object name by using the
+	     line buffer and looking ahead for an '=' or '('.  */
+	  l_push_char (dtp, c);
+
+	  int i;
+	  for(i = 0; i < 63; i++)
+	    {
+	      c = next_char (dtp);
+	      if (is_separator(c))
+		{
+		  unget_char (dtp, c);
+		  eat_separator (dtp);
+		  c = next_char (dtp);
+		  if (c != '=')
+		    {
+		      l_push_char (dtp, c);
+		      dtp->u.p.item_count = 0;
+		      dtp->u.p.line_buffer_enabled = 1;
+		      goto get_string;
+		    }
+		}
+ 
+	      l_push_char (dtp, c);
+	      if (c == '=' || c == '(')
+		{
+		  dtp->u.p.item_count = 0;
+		  dtp->u.p.nml_read_error = 1;
+		  dtp->u.p.line_buffer_enabled = 1;
+		  return;
+		}
+	    }
+
+	  /* The string is too long to be a valid object name so assume that it
+	     is a string to be read in as a value.  */
+	  dtp->u.p.nml_read_error = 1;
+	  dtp->u.p.line_buffer_enabled = 1;
+	  goto get_string;
 	}
+
       push_char (dtp, c);
       goto get_string;
     }
@@ -1007,6 +1047,7 @@ read_character (st_parameter_dt *dtp, in
       unget_char (dtp, c);
       eat_separator (dtp);
       dtp->u.p.saved_type = BT_CHARACTER;
+      free_line (dtp);
     }
   else
     {

! { dg-do run }
! PR33421 and PR33253 Weird quotation of namelist output of character arrays
! Test case from Toon Moone, adapted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>

! Long names used to test line_buffer feature is working.

program test
implicit none
character(len=45) :: b01234567890123456789012345678901234567890123456789012345678901(3)
namelist /nam/ b01234567890123456789012345678901234567890123456789012345678901
b01234567890123456789012345678901234567890123456789012345678901 = 'x'
open(99)
write(99,'(4(a,/),a)') "&NAM", &
      " b01234567890123456789012345678901234567890123456789012345678901(1)=' AAP NOOT MIES WIM ZUS JET',", &
      " b01234567890123456789012345678901234567890123456789012345678901(2)='SURF.PRESSURE',", &
      " b01234567890123456789012345678901234567890123456789012345678901(3)='APEKOOL',", &
      " /"
rewind(99)
read(99,nml=nam)
close(99)

if (b01234567890123456789012345678901234567890123456789012345678901(1).ne.&
    " AAP NOOT MIES WIM ZUS JET                   ") call abort
if (b01234567890123456789012345678901234567890123456789012345678901(2).ne.&
    "SURF.PRESSURE                                ") call abort
if (b01234567890123456789012345678901234567890123456789012345678901(3).ne.&
    "APEKOOL                                      ") call abort
end program test