[Patch, libgfortran, 4.0] Backport for PR24699, PR24700, PR24719,PR24584, PR24785

[Jerry DeLisle <jvdelisle at verizon dot net>]

The attached patch is a backport from 4.1 of the fixes recently committed there.

Bootstrapped and regression tested OK on i686-pc-linux-gnu.

OK to commit to 4.0 along with the associated test cases?


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

	PR libgfortran/24699, 24700, 24719, 24785
	* io/transfer.c (read_sf): Remove incorrect statement that was
	clearing bytes_left.
	(formatted_transfer_scalar): Add handling of end-of-record
	condition, setting values correctly to backup.  Handle x format
	when doing non-advancing write.
	(st_read): Initialize current_record.

	PR libgfortran/24584
	* io/list_read.c (free_saved): Set saved_used to zero.

Index: io/list_read.c
===================================================================
--- io/list_read.c	(revision 106801)
+++ io/list_read.c	(working copy)
@@ -134,6 +134,7 @@ free_saved (void)
     free_mem (saved_string);
 
   saved_string = NULL;
+  saved_used = 0;
 }
 
 
Index: io/transfer.c
===================================================================
--- io/transfer.c	(revision 106801)
+++ io/transfer.c	(working copy)
@@ -209,7 +209,6 @@ read_sf (int *length)
 	      return NULL;
 	    }
 
-	  current_unit->bytes_left = 0;
 	  *length = n;
 	  sf_seen_eor = 1;
 	  break;
@@ -245,10 +244,6 @@ read_block (int *length)
   char *source;
   int nread;
 
-  if (current_unit->flags.form == FORM_FORMATTED &&
-      current_unit->flags.access == ACCESS_SEQUENTIAL)
-    return read_sf (length);	/* Special case.  */
-
   if (current_unit->bytes_left < *length)
     {
       if (current_unit->flags.pad == PAD_NO)
@@ -260,6 +255,10 @@ read_block (int *length)
       *length = current_unit->bytes_left;
     }
 
+  if (current_unit->flags.form == FORM_FORMATTED &&
+      current_unit->flags.access == ACCESS_SEQUENTIAL)
+    return read_sf (length);	/* Special case.  */
+
   current_unit->bytes_left -= *length;
 
   nread = *length;
@@ -293,7 +292,7 @@ write_block (int length)
 {
   char *dest;
 
-  if (!is_internal_unit() && current_unit->bytes_left < length)
+  if (current_unit->bytes_left < length)
     {
       generate_error (ERROR_EOR, NULL);
       return NULL;
@@ -702,8 +701,15 @@ formatted_transfer (bt type, void *p, in
 	  skips = f->u.n + skips;
 	  pending_spaces = pos - max_pos;
 
-	  /* Writes occur just before the switch on f->format, above, so that
-	     trailing blanks are suppressed.  */
+	  /* Writes occur just before the switch on f->format, above, so
+	     that trailing blanks are suppressed, unless we are doing a
+	     non-advancing write in which case we want to output the blanks
+	     now.  */
+	  if (g.mode == WRITING && advance_status == ADVANCE_NO)
+	    {
+	      write_x (skips, pending_spaces);
+	      skips = pending_spaces = 0;
+	    }
 	  if (g.mode == READING)
 	    read_x (f->u.n);
 
@@ -735,17 +741,24 @@ formatted_transfer (bt type, void *p, in
 	     trailing blanks are suppressed.  */
 	  if (g.mode == READING)
 	    {
-	      if (skips > 0)
-		read_x (skips);
+	      /* Adjust everything for end-of-record condition */
+	      if (sf_seen_eor && !is_internal_unit())
+		{
+		  current_unit->bytes_left--;
+		  bytes_used = pos;
+		  sf_seen_eor = 0;
+		  skips--;
+		}
 	      if (skips < 0)
 		{
 		  move_pos_offset (current_unit->s, skips);
-		  current_unit->bytes_left -= skips;
+		  current_unit->bytes_left -= (gfc_offset)skips;
 		  skips = pending_spaces = 0;
 		}
+	      else
+		read_x (skips);
 	    }
-
-	break;
+	  break;
 
 	case FMT_S:
 	  consume_data_flag = 0 ;
@@ -1644,11 +1657,13 @@ st_read (void)
 	  {
 	    generate_error (ERROR_END, NULL);
 	    current_unit->endfile = AFTER_ENDFILE;
+	    current_unit->current_record = 0;
 	  }
 	break;
 
       case AFTER_ENDFILE:
 	generate_error (ERROR_ENDFILE, NULL);
+	current_unit->current_record = 0;
 	break;
       }
 }