re PR fortran/43265 (No EOF condition if reading with '(x)' from an empty file)

2010-03-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/43265
	Backport from trunk.
	* io/read.c (read_x): Replace the use of read_sf with equivalent lower
	level I/O, eliminating unneeded code and handling EOF and EOR
	conditions.
	* io/io.h: Revise prototype for read_sf.
	* io/transfer.c (read_sf): Delete no_error parameter and all uses of it.
	Set eof and eor condition flags. (read_block_form): Likewise.
	(next_record_r): Add condition to call to hit_eof.

From-SVN: r157404

libgfortran/ChangeLog

@@ -1,3 +1,15 @@
+2010-03-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libfortran/43265
+	Backport from trunk.
+	* io/read.c (read_x): Replace the use of read_sf with equivalent lower
+	level I/O, eliminating unneeded code and handling EOF and EOR
+	conditions.
+	* io/io.h: Revise prototype for read_sf.
+	* io/transfer.c (read_sf): Delete no_error parameter and all uses of it.
+	Set eof and eor condition flags. (read_block_form): Likewise.
+	(next_record_r): Add condition to call to hit_eof.
+	
 2010-03-11  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/43228

libgfortran/io/io.h

@@ -848,7 +848,7 @@ internal_proto(type_name);
 extern void * read_block_form (st_parameter_dt *, int *);
 internal_proto(read_block_form);
 
-extern char *read_sf (st_parameter_dt *, int *, int);
+extern char *read_sf (st_parameter_dt *, int *);
 internal_proto(read_sf);
 
 extern void *write_block (st_parameter_dt *, int);

libgfortran/io/read.c

@@ -1019,16 +1019,70 @@ bad_float:
  * and never look at it. */
 
 void
-read_x (st_parameter_dt * dtp, int n)
+read_x (st_parameter_dt *dtp, int n)
 {
+  int length;
+  char *p, q;
+
   if ((dtp->u.p.current_unit->pad_status == PAD_NO || is_internal_unit (dtp))
        && dtp->u.p.current_unit->bytes_left < n)
     n = dtp->u.p.current_unit->bytes_left;
+    
+  if (n == 0)
+    return;
 
-  dtp->u.p.sf_read_comma = 0;
-  if (n > 0)
-    read_sf (dtp, &n, 1);
-  dtp->u.p.sf_read_comma = 1;
+  length = n;
+
+  if (is_internal_unit (dtp))
+    {
+      p = mem_alloc_r (dtp->u.p.current_unit->s, &length);
+      if (unlikely (length < n))
+	n = length;
+      goto done;
+    }
+
+  p = fbuf_read (dtp->u.p.current_unit, &length);
+  if (p == NULL || (length == 0 && dtp->u.p.item_count == 1))
+    {
+      hit_eof (dtp);
+      return;
+    }
+
+  n = 0;
+  while (n < length)
+    {
+      q = *p;
+      if (q == '\n' || q == '\r')
+	{
+	  /* Unexpected end of line. Set the position.  */
+	  fbuf_seek (dtp->u.p.current_unit, n + 1 ,SEEK_CUR);
+	  dtp->u.p.sf_seen_eor = 1;
+
+	  /* If we encounter a CR, it might be a CRLF.  */
+	  if (q == '\r') /* Probably a CRLF */
+	    {
+	      /* See if there is an LF. Use fbuf_read rather then fbuf_getc so
+		 the position is not advanced unless it really is an LF.  */
+	      int readlen = 1;
+	      p = fbuf_read (dtp->u.p.current_unit, &readlen);
+	      if (*p == '\n' && readlen == 1)
+	        {
+		  dtp->u.p.sf_seen_eor = 2;
+		  fbuf_seek (dtp->u.p.current_unit, 1 ,SEEK_CUR);
+		}
+	    }
+	  goto done;
+	}
+      n++;
+      p++;
+    } 
+
+  fbuf_seek (dtp->u.p.current_unit, n, SEEK_CUR);
+  
+ done:
+  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+    dtp->u.p.size_used += (GFC_IO_INT) n;
+  dtp->u.p.current_unit->bytes_left -= n;
   dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
 }
 

libgfortran/io/transfer.c

@@ -179,22 +179,12 @@ current_mode (st_parameter_dt *dtp)
    heap.  Hopefully this won't happen very often.  */
 
 char *
-read_sf (st_parameter_dt *dtp, int * length, int no_error)
+read_sf (st_parameter_dt *dtp, int * length)
 {
   static char *empty_string[0];
   char *base, *p, q;
   int n, lorig, memread, seen_comma;
 
-  /* If we hit EOF previously with the no_error flag set (i.e. X, T,
-     TR edit descriptors), and we now try to read again, this time
-     without setting no_error.  */
-  if (!no_error && dtp->u.p.at_eof)
-    {
-      *length = 0;
-      hit_eof (dtp);
-      return NULL;
-    }
-
   /* If we have seen an eor previously, return a length of 0.  The
      caller is responsible for correctly padding the input field.  */
   if (dtp->u.p.sf_seen_eor)
@@ -260,8 +250,6 @@ read_sf (st_parameter_dt *dtp, int * length, int no_error)
 	     so we can just continue with a short read.  */
 	  if (dtp->u.p.current_unit->pad_status == PAD_NO)
 	    {
-	      if (likely (no_error))
-		break;
 	      generate_error (&dtp->common, LIBERROR_EOR, NULL);
 	      return NULL;
 	    }
@@ -291,8 +279,21 @@ read_sf (st_parameter_dt *dtp, int * length, int no_error)
      some other stuff. Set the relevant flags.  */
   if (lorig > *length && !dtp->u.p.sf_seen_eor && !seen_comma)
     {
-      if (n > 0 || no_error)
-        dtp->u.p.at_eof = 1;
+      if (n > 0)
+        {
+	  if (dtp->u.p.advance_status == ADVANCE_NO)
+	    {
+	      if (dtp->u.p.current_unit->pad_status == PAD_NO)
+	        {
+		  hit_eof (dtp);
+		  return NULL;
+		}
+	      else
+		dtp->u.p.eor_condition = 1;
+	    }
+	  else
+	    dtp->u.p.at_eof = 1;
+	}
       else
         {
           hit_eof (dtp);
@@ -360,7 +361,7 @@ read_block_form (st_parameter_dt *dtp, int * nbytes)
       (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL ||
        dtp->u.p.current_unit->flags.access == ACCESS_STREAM))
     {
-      source = read_sf (dtp, nbytes, 0);
+      source = read_sf (dtp, nbytes);
       dtp->u.p.current_unit->strm_pos +=
 	(gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor);
       return source;
@@ -2720,8 +2721,8 @@ next_record_r (st_parameter_dt *dtp)
 		{
                   if (errno != 0)
                     generate_error (&dtp->common, LIBERROR_OS, NULL);
-                  else
-                    hit_eof (dtp);
+		  else if (dtp->u.p.item_count == 1)
+		    hit_eof (dtp);
 		  break;
                 }