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

	PR libfortran/43265
	* io/io.h: Delete prototype for read_sf, making it static.
	* io/read.c (read_x): Modify to call hit_eof if PAD="no".
	* io/transfer.c (read_sf_internal): New static function extracted from
	read_sf for use on internal units only. Handle empty string case.
	(read_sf): New factoring of this function, make it static.  Add special
	conditions for EOF based on ADVANCE="no", PAD="no", and whether any
	bytes have been previously read from the record.
	(read_block_form): Modify to call read_sf or read_sf_internal.
	(next_record_r): Add a done flag similar to next_record_w. Call hit_eof
	if internal array unit next record returns finished, meaning an EOF was
	found and not done, ie not the last record expected.  For external
	units call hit_eof if item_count is 1 or there are no pending spaces.
	(next_record): Update call to next_record_r.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@157527 138bc75d-0d04-0410-961f-82ee72b054a4

3 files changed, 83 insertions, 34 deletions

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 8f482e63191..aa79eddabba 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -642,9 +642,6 @@ 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 *);
-internal_proto(read_sf);
-
 extern void *write_block (st_parameter_dt *, int);
 internal_proto(write_block);
 
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index a4c4a58b7bf..078c6e25fc8 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -1047,11 +1047,22 @@ read_x (st_parameter_dt *dtp, int n)
     }
 
   p = fbuf_read (dtp->u.p.current_unit, &length);
-  if (p == NULL || (length == 0 && dtp->u.p.item_count == 1))
+  if (p == NULL)
     {
       hit_eof (dtp);
       return;
     }
+  
+  if (length == 0 && dtp->u.p.item_count == 1)
+    {
+      if (dtp->u.p.current_unit->pad_status == PAD_NO)
+	{
+	  hit_eof (dtp);
+	  return;
+	}
+      else
+	return;
+    }
 
   n = 0;
   while (n < length)
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 958ef656b73..9c87b5e4fbd 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -175,9 +175,7 @@ current_mode (st_parameter_dt *dtp)
 }
 
 
-/* Mid level data transfer statements.  These subroutines do reading
-   and writing in the style of salloc_r()/salloc_w() within the
-   current record.  */
+/* Mid level data transfer statements.  */
 
 /* When reading sequential formatted records we have a problem.  We
    don't know how long the line is until we read the trailing newline,
@@ -190,13 +188,22 @@ current_mode (st_parameter_dt *dtp)
    we hit the newline.  For small allocations, we use a static buffer.
    For larger allocations, we are forced to allocate memory on the
    heap.  Hopefully this won't happen very often.  */
+   
+/* Read sequential file - internal unit  */
 
 char *
-read_sf (st_parameter_dt *dtp, int * length)
+read_sf_internal (st_parameter_dt *dtp, int * length);
+char *
+read_sf_internal (st_parameter_dt *dtp, int * length)
 {
   static char *empty_string[0];
-  char *base, *p, q;
-  int n, lorig, memread, seen_comma;
+  char *base;
+  int lorig;
+
+  /* Zero size array gives internal unit len of 0.  Nothing to read. */
+  if (dtp->internal_unit_len == 0
+      && dtp->u.p.current_unit->pad_status == PAD_NO)
+    hit_eof (dtp);
 
   /* If we have seen an eor previously, return a length of 0.  The
      caller is responsible for correctly padding the input field.  */
@@ -208,17 +215,40 @@ read_sf (st_parameter_dt *dtp, int * length)
       return (char*) empty_string;
     }
 
-  if (is_internal_unit (dtp))
+  lorig = *length;
+  base = mem_alloc_r (dtp->u.p.current_unit->s, length);
+  if (unlikely (lorig > *length))
     {
-      memread = *length;
-      base = mem_alloc_r (dtp->u.p.current_unit->s, length);
-      if (unlikely (memread > *length))
-	{
-          hit_eof (dtp);
-	  return NULL;
-	}
-      n = *length;
-      goto done;
+      hit_eof (dtp);
+      return NULL;
+    }
+
+  dtp->u.p.current_unit->bytes_left -= *length;
+
+  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+    dtp->u.p.size_used += (GFC_IO_INT) *length;
+
+  return base;
+
+}
+
+/* Read sequential file - external unit */
+
+static char *
+read_sf (st_parameter_dt *dtp, int * length)
+{
+  static char *empty_string[0];
+  char *base, *p, q;
+  int n, lorig, seen_comma;
+
+  /* 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)
+    {
+      *length = 0;
+      /* Just return something that isn't a NULL pointer, otherwise the
+         caller thinks an error occured.  */
+      return (char*) empty_string;
     }
 
   n = seen_comma = 0;
@@ -307,11 +337,14 @@ read_sf (st_parameter_dt *dtp, int * length)
 	  else
 	    dtp->u.p.at_eof = 1;
 	}
-      else
-        {
-          hit_eof (dtp);
-          return NULL;
-        }
+      else if (dtp->u.p.advance_status == ADVANCE_NO
+	       || dtp->u.p.current_unit->pad_status == PAD_NO
+	       || dtp->u.p.current_unit->bytes_left
+		    == dtp->u.p.current_unit->recl)
+	{
+	  hit_eof (dtp);
+	  return NULL;
+	}
     }
 
  done:
@@ -352,7 +385,8 @@ read_block_form (st_parameter_dt *dtp, int * nbytes)
             dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
 	  else
 	    {
-	      if (unlikely (dtp->u.p.current_unit->pad_status == PAD_NO))
+	      if (unlikely (dtp->u.p.current_unit->pad_status == PAD_NO)
+		  && !is_internal_unit (dtp))
 		{
 		  /* Not enough data left.  */
 		  generate_error (&dtp->common, LIBERROR_EOR, NULL);
@@ -360,9 +394,10 @@ read_block_form (st_parameter_dt *dtp, int * nbytes)
 		}
 	    }
 
-	  if (unlikely (dtp->u.p.current_unit->bytes_left == 0))
+	  if (unlikely (dtp->u.p.current_unit->bytes_left == 0
+	      && !is_internal_unit(dtp)))
 	    {
-              hit_eof (dtp);
+	      hit_eof (dtp);
 	      return NULL;
 	    }
 
@@ -374,7 +409,11 @@ 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);
+      if (is_internal_unit (dtp))
+	source = read_sf_internal (dtp, nbytes);
+      else
+	source = read_sf (dtp, nbytes);
+
       dtp->u.p.current_unit->strm_pos +=
 	(gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor);
       return source;
@@ -2731,7 +2770,7 @@ min_off (gfc_offset a, gfc_offset b)
 /* Space to the next record for read mode.  */
 
 static void
-next_record_r (st_parameter_dt *dtp)
+next_record_r (st_parameter_dt *dtp, int done)
 {
   gfc_offset record;
   int bytes_left;
@@ -2758,10 +2797,9 @@ next_record_r (st_parameter_dt *dtp)
     case FORMATTED_SEQUENTIAL:
       /* read_sf has already terminated input because of an '\n', or
          we have hit EOF.  */
-      if (dtp->u.p.sf_seen_eor || dtp->u.p.at_eof)
+      if (dtp->u.p.sf_seen_eor)
 	{
 	  dtp->u.p.sf_seen_eor = 0;
-          dtp->u.p.at_eof = 0;
 	  break;
 	}
 
@@ -2773,6 +2811,8 @@ next_record_r (st_parameter_dt *dtp)
 
 	      record = next_array_record (dtp, dtp->u.p.current_unit->ls,
 					  &finished);
+	      if (!done && finished)
+		hit_eof (dtp);
 
 	      /* Now seek to this record.  */
 	      record = record * dtp->u.p.current_unit->recl;
@@ -2810,7 +2850,8 @@ next_record_r (st_parameter_dt *dtp)
 		{
                   if (errno != 0)
                     generate_error (&dtp->common, LIBERROR_OS, NULL);
-		  else if (dtp->u.p.item_count == 1)
+		  else if (dtp->u.p.item_count == 1
+			   || dtp->u.p.pending_spaces == 0)
 		    hit_eof (dtp);
 		  break;
                 }
@@ -3151,7 +3192,7 @@ next_record (st_parameter_dt *dtp, int done)
   dtp->u.p.current_unit->read_bad = 0;
 
   if (dtp->u.p.mode == READING)
-    next_record_r (dtp);
+    next_record_r (dtp, done);
   else
     next_record_w (dtp, done);