[patch, libfortran][Regression] PR35699
Jerry DeLisle
jvdelisle@verizon.net
Thu Mar 27 07:49:00 GMT 2008
: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
More information about the Gcc-patches
mailing list