re PR fortran/25264 (write to internal unit from the string itself gives wrong result ?)

2005-12-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/25264
	PR libgfortran/25349
	* io/unit.c (get_unit): Delete code that cleared the string when the
	unit was opened, which is too soon.
	* io/transfer.c (next_record_w): Pass done flag in.  Change logic for
	setting max_pos.  Add code to position unit and pad record as needed.

From-SVN: r108671

libgfortran/ChangeLog

+2005-12-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/25264
+	PR libgfortran/25349
+	* io/unit.c (get_unit): Delete code that cleared the string when the
+	unit was opened, which is too soon.
+	* io/transfer.c (next_record_w): Pass done flag in.  Change logic for
+	setting max_pos.  Add code to position unit and pad record as needed.
+
 2005-12-13  Richard Sandiford  <richard@codesourcery.com>
 	    Victor Leikehman  <LEI@il.ibm.com>
 

libgfortran/io/transfer.c

@@ -1746,13 +1746,14 @@ next_record_r (st_parameter_dt *dtp)
 /* Position to the next record in write mode.  */
 
 static void
-next_record_w (st_parameter_dt *dtp)
+next_record_w (st_parameter_dt *dtp, int done)
 {
-  gfc_offset c, m, record;
-  int bytes_left, length;
+  gfc_offset c, m, record, max_pos;
+  int length;
   char *p;
 
   /* Zero counters for X- and T-editing.  */
+  max_pos = dtp->u.p.max_pos;
   dtp->u.p.max_pos = dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
 
   switch (current_mode (dtp))
@@ -1831,18 +1832,31 @@ next_record_w (st_parameter_dt *dtp)
 	{
 	  if (is_array_io (dtp))
 	    {
-	      bytes_left = (int) dtp->u.p.current_unit->bytes_left;
-	      p = salloc_w (dtp->u.p.current_unit->s, &bytes_left);
+	      length = (int) dtp->u.p.current_unit->bytes_left;
+	      
+	      /* If the farthest position reached is greater than current
+	      position, adjust the position and set length to pad out
+	      whats left.  Otherwise just pad whats left.
+	      (for character array unit) */
+	      m = dtp->u.p.current_unit->recl
+			- dtp->u.p.current_unit->bytes_left;
+	      if (max_pos > m)
+		{
+		  length = (int) (max_pos - m);
+		  p = salloc_w (dtp->u.p.current_unit->s, &length);
+		  length = (int) (dtp->u.p.current_unit->recl - max_pos);
+		}
+
+	      p = salloc_w (dtp->u.p.current_unit->s, &length);
 	      if (p == NULL)
 		{
 		  generate_error (&dtp->common, ERROR_END, NULL);
 		  return;
 		}
-	      memset(p, ' ', bytes_left);
+	      memset(p, ' ', length);
 
 	      /* Now that the current record has been padded out,
 		 determine where the next record in the array is. */
-
 	      record = next_array_record (dtp, dtp->u.p.current_unit->ls);
 
 	      /* Now seek to this record */
@@ -1856,13 +1870,47 @@ next_record_w (st_parameter_dt *dtp)
 	  else
 	    {
 	      length = 1;
+
+	      /* If this is the last call to next_record move to the farthest
+		 position reached and set length to pad out the remainder
+		 of the record. (for character scaler unit) */
+	      if (done)
+		{
+		  m = dtp->u.p.current_unit->recl
+			- dtp->u.p.current_unit->bytes_left;
+		  if (max_pos > m)
+		    {
+		      length = (int) (max_pos - m);
+		      p = salloc_w (dtp->u.p.current_unit->s, &length);
+		      length = (int) (dtp->u.p.current_unit->recl - max_pos);
+		    }
+		  else
+		    length = (int) dtp->u.p.current_unit->bytes_left;
+		}
 	      p = salloc_w (dtp->u.p.current_unit->s, &length);
 	      if (p == NULL)
-		goto io_error;
+		{
+		  generate_error (&dtp->common, ERROR_END, NULL);
+		  return;
+		}
+	      memset (p, ' ', length);
 	    }
- 	}
+	}
       else
 	{
+	  /* If this is the last call to next_record move to the farthest
+	  position reached in preparation for completing the record.
+	  (for file unit) */
+	  if (done)
+	    {
+	      m = dtp->u.p.current_unit->recl -
+			dtp->u.p.current_unit->bytes_left;
+	      if (max_pos > m)
+		{
+		  length = (int) (max_pos - m);
+		  p = salloc_w (dtp->u.p.current_unit->s, &length);
+		}
+ 	    }
 #ifdef HAVE_CRLF
 	  length = 2;
 #else
@@ -1905,7 +1953,7 @@ next_record (st_parameter_dt *dtp, int done)
   if (dtp->u.p.mode == READING)
     next_record_r (dtp);
   else
-    next_record_w (dtp);
+    next_record_w (dtp, done);
 
   /* keep position up to date for INQUIRE */
   dtp->u.p.current_unit->flags.position = POSITION_ASIS;

libgfortran/io/unit.c

@@ -384,9 +384,6 @@ get_unit (st_parameter_dt *dtp, int do_create)
       internal_unit.maxrec=0;
       internal_unit.current_record=0;
 
-      if (dtp->u.p.mode==WRITING && !is_array_io (dtp))
-        empty_internal_buffer (internal_unit.s);
-
       /* Set flags for the internal unit */
 
       internal_unit.flags.access = ACCESS_SEQUENTIAL;