[PATCH, libgfortran] Fix for PR25039

[Jerry DeLisle <jvdelisle at verizon dot net>]

:addpatch fortran:

The included patch and test case fixes the handling of commas encountered during 
numeric inputs.  I created a new flag to check to minimize having to change code 
all over the place.

2005-11-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/25039
	* io/io.h: Create a new flag sf_read_comma to control comma
	separators in numeric reads.
	* io/transfer.c (formatted_transfer_scalar): Initialize the flag.
	  (read_sf): Check for commas coming in and if the flag is set,
	  shortcut the read.
	* io/read.c (read_a) (read_x): Clear the flag for character reads and
	  reset it after the reads.

Attached patch regression tested.  OK for trunk? and 4.1?

I am think about adding some checks for std= and pedantic after I review the F95 
standard and see where this falls out.  Ifort and g77 do it this way.

Regards,

Jerry
Index: io/read.c
===================================================================
--- io/read.c	(revision 107588)
+++ io/read.c	(working copy)
@@ -244,7 +244,9 @@ read_a (st_parameter_dt *dtp, const fnod
   if (w == -1) /* '(A)' edit descriptor  */
     w = length;
 
+  dtp->u.p.sf_read_comma = 0;
   source = read_block (dtp, &w);
+  dtp->u.p.sf_read_comma = 1;
   if (source == NULL)
     return;
   if (w > length)
@@ -843,6 +845,9 @@ read_x (st_parameter_dt *dtp, int n)
       && dtp->u.p.current_unit->bytes_left < n)
     n = dtp->u.p.current_unit->bytes_left;
 
+  dtp->u.p.sf_read_comma = 0;
   if (n > 0)
     read_block (dtp, &n);
+  dtp->u.p.sf_read_comma = 1;
+
 }
Index: io/io.h
===================================================================
--- io/io.h	(revision 107588)
+++ io/io.h	(working copy)
@@ -398,7 +398,11 @@ typedef struct st_parameter_dt
 	     to flag read errors and return, so that an attempt can be
 	     made to read a new object name.  */
 	  unsigned nml_read_error : 1;
-	  /* 20 unused bits.  */
+	  /* A sequential formatted read specific flag used to signal that a
+	     character string is being read so don't use commas to shorten a
+	     formatted field width.  */
+	  unsigned sf_read_comma : 1;
+	  /* 19 unused bits.  */
 
 	  char last_char;
 	  char nml_delim;
Index: io/transfer.c
===================================================================
--- io/transfer.c	(revision 107588)
+++ io/transfer.c	(working copy)
@@ -210,6 +210,16 @@ read_sf (st_parameter_dt *dtp, int *leng
 	  dtp->u.p.sf_seen_eor = (crlf ? 2 : 1);
 	  break;
 	}
+      /*  Short circuit the read if a comma is found during numeric input.
+	  The flag is set to zero during character reads so that commas in
+	  strings are not ignored  */
+      if (*q == ',')
+	if (dtp->u.p.sf_read_comma == 1 &&
+	    dtp->u.p.current_unit->flags.pad == PAD_YES)
+	  {
+	    *length = n;
+	    break;
+	  }
 
       n++;
       *p++ = *q;
@@ -527,6 +537,11 @@ formatted_transfer_scalar (st_parameter_
   if (dtp->u.p.eor_condition)
     return;
 
+  /* Set this flag so that commas in reads cause the read to complete before
+     the entire field has been read.  The next read field will start right after
+     the comma in the stream.  (Set to 0 for character reads).  */
+  dtp->u.p.sf_read_comma = 1;
+
   dtp->u.p.line_buffer = scratch;
   for (;;)
     {

! { dg-do run }
! PR25039 This test checks that commas in input fields for formatted sequential
! reads are interpreted as the read completion.  If no comma is encountered the
! normal field width determines the end of the read.  The test case also checks
! that default blanks are interpreted as NULL in numerics.
! Test case derived from sample provided in PR by Iwan Kawrakow.
! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
!
      program pr25039
      implicit none
      integer :: i1, i2, i3
      real    :: r1, r2, r3
      character(10) :: a1, a2, a3

      open(10, status="scratch")
      write(10,'(a)') "1,2       35"
      rewind(10)
      read(10,'(3i9)') i1,i2,i3
      if(i1.ne.1) call abort()
      if(i2.ne.23) call abort()
      if(i3.ne.5) call abort()
      rewind(10)
      write(10,'(a)') "1.1,1.2     1.3"
      rewind(10)
      read(10,'(3f9.2)') r1,r2,r3
      if(r1.ne.1.1) call abort()
      if(r2.ne.1.21) call abort()
      if(r3.ne.0.3) call abort()
      rewind(10)
      write(10,'(a)') "1234,6789,1234,6789,1234,6789,"
      rewind(10)
      read(10,'(3a10)') a1,a2,a3
      if(a1.ne."1234,6789,") call abort()
      if(a2.ne."1234,6789,") call abort()
      if(a3.ne."1234,6789,") call abort()
      end