[patch, libfortran][Regression] PR35699

[Jerry DeLisle]

:ADDPATCH fortran:

The following patch fixes this problem by moving the code needed to pad the 
record to next_record_w, waiting for all transfers to complete before going to 
the next record. I apologize for the breakage.

Regression tested on x86-64-linux-gnu.  OK for trunk?
(Will backport in a few days to 4.3)

Regards,

Jerry

2008-03-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/35699
	* io/transfer.c (write_buf):  Don't pad the record, just return if the
	data is NULL.  (next_record_w): If there are bytes left in the record
	for unformatted direct I/O, pad out the record with zero bytes.

Index: transfer.c
===================================================================
--- transfer.c	(revision 133454)
+++ transfer.c	(working copy)
@@ -639,12 +639,7 @@ write_buf (st_parameter_dt *dtp, void *b
  	}

        if (buf == NULL && nbytes == 0)
-	{
-	   char *p;
-	   p = write_block (dtp, dtp->u.p.current_unit->recl);
-	   memset (p, 0, dtp->u.p.current_unit->recl);
-	   return SUCCESS;
-	}
+	return SUCCESS;

        if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
  	{
@@ -2493,6 +2488,12 @@ next_record_w (st_parameter_dt *dtp, int
        break;

      case UNFORMATTED_DIRECT:
+      if (dtp->u.p.current_unit->bytes_left > 0)
+	{
+	  p = write_block (dtp, dtp->u.p.current_unit->bytes_left);
+	  memset (p, 0, dtp->u.p.current_unit->bytes_left);
+	}
+
        if (sfree (dtp->u.p.current_unit->s) == FAILURE)
  	goto io_error;
        break;

New test case:

! { dg-do run }
! pr35699 run-time abort writing zero sized section to direct access file
       program directio
       call       qi0010 (  10,   1,   2,   3,   4,  9,   2)
       end

       subroutine qi0010 (nf10, nf1, nf2, nf3, nf4,nf9, np2)
       character(10) bda(nf10)
       character(10) bda1(nf10), bval

       integer  j_len
       bda1(1) = 'x'
       do i = 2,10
         bda1(i) = 'x'//bda1(i-1)
       enddo
       bda = 'unread'

       inquire(iolength = j_len) bda1(nf1:nf10:nf2), bda1(nf4:nf3),
      $                               bda1(nf2:nf10:nf2)

       open (unit=48,
      $      access='direct',
      $      status='scratch',
      $      recl = j_len,
      $      iostat = istat,
      $      form='unformatted',
      $      action='readwrite')

       write (48,iostat = istat, rec = 3) bda1(nf1:nf10:nf2),
      $                    bda1(nf4:nf3), bda1(nf2:nf10:nf2)
       if ( istat .ne. 0) then
         call abort
       endif
       istat = -314

       read (48,iostat = istat, rec = np2+1) bda(nf1:nf9:nf2),
      $                       bda(nf4:nf3), bda(nf2:nf10:nf2)
       if ( istat .ne. 0) then
         call abort
       endif

       do j1 = 1,10
         bval = bda1(j1)
         if (bda(j1) .ne. bval) call abort
       enddo
       end subroutine