[patch, libgfortran] PR35132, PR34954, and PR34974

[Jerry DeLisle <jvdelisle at verizon dot net>]

The attached patch combines the fixes for each of these bugs.  They have been 
accumulating waiting for 4.4 to open and are all simple and in the same file. 
Normally I would not clump these in one submittal, but it saves me time.

I have attached test cases where practical:

PR35132: Test streamio_15.f90 verifies the proper truncating of formatted STREAM 
I/O.

PR34974: Test fmt_t_7.f checks that 'a' and 'b' are in the correct file position 
and there are no null bytes in between.

PR34954: This is a valgrind error, no test case.

Regression tested on x86-64 linux.

OK for trunk?

Jerry


2008-02-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/35132
	* io/transfer.c (next_record_w): Truncate after the last record for
	STREAM I/O.

	PR libfortran/34954
	* io/transfer.c (data_transfer_init): Initialize dtp->rec if writing.

	PR libfortran/34974
	* io/transfer.c (formatted_transfer_scalar): Flush the buffer if skips
	is less than zero. (next_record_w): Use sseek to position the file to
	the max position reached.	

! { dg-do run }
! PR35132 Formatted stream I/O write should truncate.
! Test case adapted from PR by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
program main
  implicit none
  character(len=6) :: c
  integer :: i
  open(20,file="foo.txt",form="formatted",access="stream")
  write(20,'(A)') '123456'
  write(20,'(A)') 'abcdef'
  write(20,'(A)') 'qwerty'
  rewind 20
  ! Skip over the first line
  read(20,'(A)') c
  if (c.ne.'123456') call abort
  ! Save the position
  inquire(20,pos=i)
  if (i.ne.8) call abort
  ! Read in the complete line...
  read(20,'(A)') c
  if (c.ne.'abcdef') call abort
  ! Write out the first four characters
  write(20,'(A)',pos=i,advance="no") 'ASDF'
  ! Fill up the rest of the line.  Here, we know the length.  If we
  ! don't, things will be a bit more complicated.
  write(20,'(A)') c(5:6)
  ! Copy the file to standard output
  rewind 20
  c = ""
  read(20,'(A)') c
  if (c.ne.'123456') call abort
  read(20,'(A)') c
  if (c.ne.'ASDFef') call abort
  read(20,'(A)', iostat=i) c
  if (i /= -1) call abort
  close (20, status="delete")
end program main

! { dg-do run }
! PR34974 null bytes when reverse-tabbing long records
! Test case prpared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
       program test
       character(1) :: a, b, c
       write (10,'(t50000,a,t1,a)') 'b', 'a'
       close (10)
       open (10, access="stream")
       read (10, pos=1) a
       read (10, pos=50000) b
       read (10, pos=25474) c
       close (10, status="delete")
       if (a /= "a") call abort
       if (b /= "b") call abort
       if (c /= " ") call abort
       end

Index: transfer.c
===================================================================
--- transfer.c	(revision 132412)
+++ transfer.c	(working copy)
@@ -916,8 +916,8 @@ formatted_transfer_scalar (st_parameter_
      the entire field has been read.  The next read field will start right after
      the comma in the stream.  (Set to 0 for character reads).  */
   dtp->u.p.sf_read_comma = 1;
-
   dtp->u.p.line_buffer = scratch;
+
   for (;;)
     {
       /* If reversion has occurred and there is another real data item,
@@ -1274,6 +1274,11 @@ formatted_transfer_scalar (st_parameter_
 	      else
 		read_x (dtp, dtp->u.p.skips);
 	    }
+	  else
+	    {
+	      if (dtp->u.p.skips < 0)
+		flush (dtp->u.p.current_unit->s);
+	    }
 
 	  break;
 
@@ -2007,6 +2012,8 @@ data_transfer_init (st_parameter_dt *dtp
 	dtp->u.p.current_unit->strm_pos = dtp->rec;
 
     }
+  else
+    dtp->rec = 0;
 
   /* Overwriting an existing sequential file ?
      it is always safe to truncate the file on the first write */
@@ -2583,7 +2590,8 @@ next_record_w (st_parameter_dt *dtp, int
 	  if (max_pos > m)
 	    {
 	      length = (int) (max_pos - m);
-	      p = salloc_w (dtp->u.p.current_unit->s, &length);
+	      sseek (dtp->u.p.current_unit->s,
+		     file_position (dtp->u.p.current_unit->s) + length);
 	    }
 #ifdef HAVE_CRLF
 	  len = 2;
@@ -2594,7 +2602,10 @@ next_record_w (st_parameter_dt *dtp, int
 	    goto io_error;
 	  
 	  if (is_stream_io (dtp))
-	    dtp->u.p.current_unit->strm_pos += len;
+	    {
+	      dtp->u.p.current_unit->strm_pos += len;
+	      struncate(dtp->u.p.current_unit->s);
+	    }
 	}
 
       break;