[patch,libgfortran) PR31199 write with "t1" + nonadvancing transfer format gives wrong output

[Jerry DeLisle <jvdelisle at verizon dot net>]

:ADDPATCH fortran:

This was a bit tricky to fix.  There are two problems solved.

First, the maximum position reached was not being saved from a WRITE that used 
ADVANCE="no".  Without this the following WRITE can not know where to continue 
writing in the file.

This is fixed using a new variable in gfc_unit called saved_pos.

The second problem was that in finalize_transfer the maximum position was not 
being calculated correctly because the number of bytes written was not being 
factored into the positioning.  The result was that even though the strings in 
the test case were being written correctly, there were trailing NULL bytes 
inserted before the ends of records in the file.

This is fixed by calculating bytes_written and then using that to figure max_pos.

Regression tested on x86-64-Gnu/Linux.

OK for trunk?


Regards,

Jerry

 2007-03-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/31199
	*io/io.h: Add saved_pos to gfc_unit structure.
	*io/open.c (new_unit): Initialize saved_pos.
	*io/transfer.c (data_transfer_init): Set max_pos to value in saved_pos.
	(next_record_w): Fix whitespace.
	(finalze_transfer): Calculate max_pos for ADVANCE="no" and save it for
	later use.  If not ADVANCE="no" set saved_pos to zero.

Index: open.c
===================================================================
*** open.c	(revision 123145)
--- open.c	(working copy)
*************** new_unit (st_parameter_open *opp, gfc_un
*** 423,428 ****
--- 423,429 ----
    u->mode = READING;
    u->maxrec = 0;
    u->bytes_left = 0;
+   u->saved_pos = 0;
  
    if (flags->position == POSITION_APPEND)
      {
Index: io.h
===================================================================
*** io.h	(revision 123145)
--- io.h	(working copy)
*************** typedef struct gfc_unit
*** 443,449 ****
    struct gfc_unit *left, *right;
    int priority;
  
!   int read_bad, current_record;
    enum
    { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
    endfile;
--- 443,449 ----
    struct gfc_unit *left, *right;
    int priority;
  
!   int read_bad, current_record, saved_pos;
    enum
    { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
    endfile;
Index: transfer.c
===================================================================
*** transfer.c	(revision 123145)
--- transfer.c	(working copy)
*************** data_transfer_init (st_parameter_dt *dtp
*** 1951,1956 ****
--- 1951,1960 ----
  
    dtp->u.p.blank_status = dtp->u.p.current_unit->flags.blank;
    dtp->u.p.sign_status = SIGN_S;
+   
+   /* Set the maximum position reached from the previous I/O operation.  This
+      could be greater than zero from a previous non-advancing write.  */
+   dtp->u.p.max_pos = dtp->u.p.current_unit->saved_pos;
  
    pre_position (dtp);
  
*************** next_record_w (st_parameter_dt *dtp, int
*** 2461,2467 ****
  	}
        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) */
--- 2465,2470 ----
*************** finalize_transfer (st_parameter_dt *dtp)
*** 2603,2614 ****
--- 2606,2625 ----
        return;
      }
  
+   /* For non-advancing I/O, save the current maximum position for use in the
+      next I/O operation if needed.  */
    if (dtp->u.p.advance_status == ADVANCE_NO)
      {
+       int bytes_written = (int) (dtp->u.p.current_unit->recl
+ 	- dtp->u.p.current_unit->bytes_left);
+       dtp->u.p.current_unit->saved_pos =
+ 	dtp->u.p.max_pos > 0 ? dtp->u.p.max_pos - bytes_written : 0;
        flush (dtp->u.p.current_unit->s);
        return;
      }
  
+   dtp->u.p.current_unit->saved_pos = 0;
+ 
    next_record (dtp, 1);
    sfree (dtp->u.p.current_unit->s);
  }

! { dg-do run }
! PR31199, test case from PR report.
       program write_write
       character(len=20) :: a,b,c
       write (10,"(a,t1,a,a)") "xxxxxxxxx", "abc", "def"
       write (10,"(a,t1,a)",advance='no') "xxxxxxxxx", "abc"
       write (10,"(a)") "def"
       write (10,"(a)") "abcdefxxx"
       rewind(10)
       read(10,*) a
       read(10,*) b
       read(10,*) c
       if (a.ne.b) call abort()
       IF (b.ne.c) call abort()
       end