This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[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>
- Date: Thu, 14 Sep 2006 19:58:43 -0700
- Subject: [Patch,libgfortran] PR29053 Consecutive STREAM I/O file positions mixed up
:ADDPATCH Fortran:
In my first version of the STREAM I/O, I incorrectly assumed that the dtp->rec
variable was static across multiple writes. This is not true, the dtp structure
is strictly for passing parameters from the frontend to the I/O library.
This makes it necessary to have a variable within the gfc_unit structure to
track the STREAM I/O position. The attached patch implements this by using a
new variable, strm_pos, which is set to the dtp->rec value when it exists as
determined by testing the appropriate bit in the common flags.
I am still testing to see if this resolves PR28747.
Regression tested on i686-linux-gnu.
OK to commit to 4.2?
2006-09-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/29053
* io.h (gfc_unit): Add variable, strm_pos, to track
STREAM I/O file position.
* file_pos.c (st_rewind): Set strm_pos to beginning.
* open.c (new_unit): Initialize strm_pos.
* read.c (read_x): Bump strm_pos.
* inquire.c (inquire_via_unit): Return strm_pos value.
* transfer.c (read_block),(read_block_direct),(write_block)
(write_buf): Test for DT_HAS_REC and if so assign the POS=value to
strm_pos. Seek to strm_pos - 1. Update strm_pos when done.
(pre_position): Initialize strm_pos.
(finalize_transfer): Flush file, no need to update strm_pos.
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
*** 317,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;
--- 317,327 ----
}
else
{
+ if ((dtp->common.flags & IOPARM_DT_HAS_REC) != 0)
+ dtp->u.p.current_unit->strm_pos = dtp->rec;
+
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;
}
--- 344,350 ----
}
}
! dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
}
return source;
}
*************** read_block_direct (st_parameter_dt *dtp,
*** 399,406 ****
}
else
{
if (sseek (dtp->u.p.current_unit->s,
! (gfc_offset) (dtp->rec - 1)) == FAILURE)
{
generate_error (&dtp->common, ERROR_END, NULL);
return;
--- 402,412 ----
}
else
{
+ if ((dtp->common.flags & IOPARM_DT_HAS_REC) != 0)
+ dtp->u.p.current_unit->strm_pos = dtp->rec;
+
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. */
{
--- 426,432 ----
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
*** 478,485 ****
}
else
{
if (sseek (dtp->u.p.current_unit->s,
! (gfc_offset) (dtp->rec - 1)) == FAILURE)
{
generate_error (&dtp->common, ERROR_END, NULL);
return NULL;
--- 484,494 ----
}
else
{
+ if ((dtp->common.flags & IOPARM_DT_HAS_REC) != 0)
+ dtp->u.p.current_unit->strm_pos = dtp->rec;
+
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;
*************** write_block (st_parameter_dt *dtp, int l
*** 493,499 ****
return NULL;
}
! dtp->rec += (GFC_IO_INT) length;
}
return dest;
--- 502,508 ----
return NULL;
}
! dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
}
return dest;
*************** write_buf (st_parameter_dt *dtp, void *b
*** 530,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;
--- 539,549 ----
}
else
{
+ if ((dtp->common.flags & IOPARM_DT_HAS_REC) != 0)
+ dtp->u.p.current_unit->strm_pos = dtp->rec;
+
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;
}
--- 562,568 ----
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:
--- 1518,1524 ----
/* 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:
*************** 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);
}
--- 2379,2385 ----
next_record (dtp, 1);
}
else
! flush (dtp->u.p.current_unit->s);
sfree (dtp->u.p.current_unit->s);
}
! { dg-do run }
! PR29053 Stream IO test 9.
! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
! Test case derived from that given in PR by Steve Kargl.
program pr29053
implicit none
real dt, t, u, a(10), b(10)
integer i, place
dt = 1.e-6
a = real( (/ (i, i=1, 10) /) )
b = a
open(unit=11, file='a.dat', access='stream')
open(unit=12, file='b.dat', access='stream')
do i = 1, 10
t = i * dt
write(11) t
write(12) a
end do
rewind(11)
rewind(12)
do i = 1, 10
t = i * dt
read(12) a
if (any(a.ne.b)) print *, "a failed"
read(11) u
if (u.ne.t) print *, "t failed"
end do
close(11, status="delete")
close(12, status="delete")
end program pr29053