This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [Patch,libgfortran] PR29053 Consecutive STREAM I/O file positions mixed up
- From: Jerry DeLisle <jvdelisle at verizon dot net>
- To: Fortran List <fortran at gcc dot gnu dot org>
- Cc: gcc-patches <gcc-patches at gcc dot gnu dot org>, Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- Date: Fri, 15 Sep 2006 00:32:56 -0700
- Subject: Re: [Patch,libgfortran] PR29053 Consecutive STREAM I/O file positions mixed up
- References: <450A16E3.5090700@verizon.net> <450A1876.8050108@verizon.net>
:REVIEWMAIL Fortran:
Attached is an updated patch resulting from additional testing on Steve's
freeBSD machine. This fixes a problem with a naked WRITE statement with a
position specified. This revises patch is also simpler since setting the
strm_pos is now done in data_transfer_init.
This also fixes pr28747 (tested case in PR on amd64-freeBSD and it passes.)
(yahoo!)
Additional test case illustrating the problem is attached.
Regression tested on i686-linux and amd64-freeBSD
OK to commit to 4.2?
Regards,
Jerry
! { dg-do run }
! PR25093 Stream IO test 10
! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
! Test case derived from that given in PR by Steve Kargl.
program stream_io_10
implicit none
integer :: a(4), b(4)
integer(kind=8) :: thepos
a = (/ 1, 2, 3, 4 /)
b = a
open(10, file="teststream", access="stream")
write(10) a
inquire(10, pos=thepos)
print *, thepos
read(10, pos=1)
inquire(10, pos=thepos)
print *, thepos
write(10, pos=15)
read(10, pos=3)
inquire(10, pos=thepos)
print *, thepos
write(10, pos=1)
inquire(10, pos=thepos)
print *, thepos
a = 0
read(10) a
if (any(a /= b)) call abort()
close(10, status="delete")
end program stream_io_10
Index: io/file_pos.c
===================================================================
*** io/file_pos.c (revision 116941)
--- io/file_pos.c (working copy)
*************** st_rewind (st_parameter_filepos *fpp)
*** 312,317 ****
--- 312,318 ----
u->endfile = NO_ENDFILE;
u->current_record = 0;
u->bytes_left = 0;
+ u->strm_pos = 1;
u->read_bad = 0;
test_endfile (u);
}
Index: io/open.c
===================================================================
*** io/open.c (revision 116941)
--- io/open.c (working copy)
*************** new_unit (st_parameter_open *opp, gfc_un
*** 440,446 ****
{
u->maxrec = max_offset;
u->recl = 1;
! u->last_record = 1;
}
memmove (u->file, opp->file, opp->file_len);
--- 440,446 ----
{
u->maxrec = max_offset;
u->recl = 1;
! u->strm_pos = 1;
}
memmove (u->file, opp->file, opp->file_len);
Index: io/read.c
===================================================================
*** io/read.c (revision 116941)
--- io/read.c (working copy)
*************** read_x (st_parameter_dt *dtp, int n)
*** 853,857 ****
dtp->u.p.sf_read_comma = 1;
}
else
! dtp->rec += (GFC_IO_INT) n;
}
--- 853,857 ----
dtp->u.p.sf_read_comma = 1;
}
else
! dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
}
Index: io/io.h
===================================================================
*** io/io.h (revision 116941)
--- io/io.h (working copy)
*************** typedef struct gfc_unit
*** 498,505 ****
/* recl -- Record length of the file.
last_record -- Last record number read or written
maxrec -- Maximum record number in a direct access file
! bytes_left -- Bytes left in current record. */
! gfc_offset recl, last_record, maxrec, bytes_left;
__gthread_mutex_t lock;
/* Number of threads waiting to acquire this unit's lock.
--- 498,506 ----
/* recl -- Record length of the file.
last_record -- Last record number read or written
maxrec -- Maximum record number in a direct access file
! bytes_left -- Bytes left in current record.
! strm_pos -- Current position in file for STREAM I/O. */
! gfc_offset recl, last_record, maxrec, bytes_left, strm_pos;
__gthread_mutex_t lock;
/* Number of threads waiting to acquire this unit's lock.
Index: io/inquire.c
===================================================================
*** io/inquire.c (revision 116941)
--- io/inquire.c (working copy)
*************** inquire_via_unit (st_parameter_inquire *
*** 149,155 ****
*iqp->recl_out = (u != NULL) ? u->recl : 0;
if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0)
! *iqp->strm_pos_out = (u != NULL) ? u->last_record : 0;
if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
*iqp->nextrec = (u != NULL) ? u->last_record + 1 : 0;
--- 149,155 ----
*iqp->recl_out = (u != NULL) ? u->recl : 0;
if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0)
! *iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0;
if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
*iqp->nextrec = (u != NULL) ? u->last_record + 1 : 0;
Index: io/transfer.c
===================================================================
*** io/transfer.c (revision 116941)
--- io/transfer.c (working copy)
*************** read_block (st_parameter_dt *dtp, int *l
*** 318,324 ****
else
{
if (sseek (dtp->u.p.current_unit->s,
! (gfc_offset) (dtp->rec - 1)) == FAILURE)
{
generate_error (&dtp->common, ERROR_END, NULL);
return NULL;
--- 318,324 ----
else
{
if (sseek (dtp->u.p.current_unit->s,
! dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, ERROR_END, NULL);
return NULL;
*************** read_block (st_parameter_dt *dtp, int *l
*** 341,347 ****
}
}
! dtp->rec += (GFC_IO_INT) nread;
}
return source;
}
--- 341,347 ----
}
}
! dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
}
return source;
}
*************** read_block_direct (st_parameter_dt *dtp,
*** 400,406 ****
else
{
if (sseek (dtp->u.p.current_unit->s,
! (gfc_offset) (dtp->rec - 1)) == FAILURE)
{
generate_error (&dtp->common, ERROR_END, NULL);
return;
--- 400,406 ----
else
{
if (sseek (dtp->u.p.current_unit->s,
! dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, ERROR_END, NULL);
return;
*************** read_block_direct (st_parameter_dt *dtp,
*** 420,426 ****
dtp->u.p.size_used += (gfc_offset) nread;
}
else
! dtp->rec += (GFC_IO_INT) nread;
if (nread != *nbytes) /* Short read, e.g. if we hit EOF. */
{
--- 420,426 ----
dtp->u.p.size_used += (gfc_offset) nread;
}
else
! dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
if (nread != *nbytes) /* Short read, e.g. if we hit EOF. */
{
*************** write_block (st_parameter_dt *dtp, int l
*** 479,487 ****
else
{
if (sseek (dtp->u.p.current_unit->s,
! (gfc_offset) (dtp->rec - 1)) == FAILURE)
{
! generate_error (&dtp->common, ERROR_END, NULL);
return NULL;
}
--- 479,487 ----
else
{
if (sseek (dtp->u.p.current_unit->s,
! dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
! generate_error (&dtp->common, ERROR_OS, NULL);
return NULL;
}
*************** write_block (st_parameter_dt *dtp, int l
*** 493,499 ****
return NULL;
}
! dtp->rec += (GFC_IO_INT) length;
}
return dest;
--- 493,499 ----
return NULL;
}
! dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
}
return dest;
*************** write_buf (st_parameter_dt *dtp, void *b
*** 531,537 ****
else
{
if (sseek (dtp->u.p.current_unit->s,
! (gfc_offset) (dtp->rec - 1)) == FAILURE)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return FAILURE;
--- 531,537 ----
else
{
if (sseek (dtp->u.p.current_unit->s,
! dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return FAILURE;
*************** write_buf (st_parameter_dt *dtp, void *b
*** 550,556 ****
dtp->u.p.size_used += (gfc_offset) nbytes;
}
else
! dtp->rec += (GFC_IO_INT) nbytes;
return SUCCESS;
}
--- 550,556 ----
dtp->u.p.size_used += (gfc_offset) nbytes;
}
else
! dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes;
return SUCCESS;
}
*************** pre_position (st_parameter_dt *dtp)
*** 1506,1512 ****
/* There are no records with stream I/O. Set the default position
to the beginning of the file if no position was specified. */
if ((dtp->common.flags & IOPARM_DT_HAS_REC) == 0)
! dtp->rec = 1;
break;
case UNFORMATTED_SEQUENTIAL:
--- 1506,1512 ----
/* There are no records with stream I/O. Set the default position
to the beginning of the file if no position was specified. */
if ((dtp->common.flags & IOPARM_DT_HAS_REC) == 0)
! dtp->u.p.current_unit->strm_pos = 1;
break;
case UNFORMATTED_SEQUENTIAL:
*************** data_transfer_init (st_parameter_dt *dtp
*** 1766,1777 ****
}
/* Position the file. */
! if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1)
! * dtp->u.p.current_unit->recl) == FAILURE)
{
! generate_error (&dtp->common, ERROR_OS, NULL);
! return;
}
}
/* Overwriting an existing sequential file ?
--- 1766,1783 ----
}
/* Position the file. */
! if (!is_stream_io (dtp))
{
! if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1)
! * dtp->u.p.current_unit->recl) == FAILURE)
! {
! generate_error (&dtp->common, ERROR_OS, NULL);
! return;
! }
}
+ else
+ dtp->u.p.current_unit->strm_pos = dtp->rec;
+
}
/* Overwriting an existing sequential file ?
*************** finalize_transfer (st_parameter_dt *dtp)
*** 2367,2376 ****
next_record (dtp, 1);
}
else
! {
! flush (dtp->u.p.current_unit->s);
! dtp->u.p.current_unit->last_record = dtp->rec;
! }
sfree (dtp->u.p.current_unit->s);
}
--- 2373,2379 ----
next_record (dtp, 1);
}
else
! flush (dtp->u.p.current_unit->s);
sfree (dtp->u.p.current_unit->s);
}