From 2ea74407863b9a20e652292fb7c0862d6a201c9b Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sun, 2 Dec 2007 23:17:16 +0000 Subject: [PATCH] re PR libfortran/33985 (access="stream",form="unformatted" doesn't buffer) 2007-12-02 Jerry DeLisle Thomas Koenig PR libfortran/33985 * io/transfer.c (read_block, read_block_direct, write_block, write_buf): Don't seek if file position is already there for STREAM I/O. (finalize_transfer): For STREAM I/O don't flush unless the file position has moved past the start position before the transfer. Co-Authored-By: Thomas Koenig From-SVN: r130574 --- libgfortran/ChangeLog | 9 +++++++++ libgfortran/io/transfer.c | 33 +++++++++++++++++++++++---------- 2 files changed, 32 insertions(+), 10 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 8ba4cd32c7b..e77ef147b0a 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,12 @@ +2007-12-02 Jerry DeLisle + Thomas Koenig + + PR libfortran/33985 + * io/transfer.c (read_block, read_block_direct, write_block, write_buf): + Don't seek if file position is already there for STREAM I/O. + (finalize_transfer): For STREAM I/O don't flush unless the file position + has moved past the start position before the transfer. + 2007-12-01 Francois-Xavier Coudert * intrinsic/stat.c (stat_i4_sub_0, stat_i8_sub_0): Mark parameter diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 4073137da74..05711a06015 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -272,8 +272,10 @@ read_block (st_parameter_dt *dtp, int *length) if (is_stream_io (dtp)) { - if (sseek (dtp->u.p.current_unit->s, - dtp->u.p.current_unit->strm_pos - 1) == FAILURE) + if (dtp->u.p.current_unit->strm_pos - 1 + != file_position (dtp->u.p.current_unit->s) + && sseek (dtp->u.p.current_unit->s, + dtp->u.p.current_unit->strm_pos - 1) == FAILURE) { generate_error (&dtp->common, LIBERROR_END, NULL); return NULL; @@ -357,8 +359,10 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) if (is_stream_io (dtp)) { - if (sseek (dtp->u.p.current_unit->s, - dtp->u.p.current_unit->strm_pos - 1) == FAILURE) + if (dtp->u.p.current_unit->strm_pos - 1 + != file_position (dtp->u.p.current_unit->s) + && sseek (dtp->u.p.current_unit->s, + dtp->u.p.current_unit->strm_pos - 1) == FAILURE) { generate_error (&dtp->common, LIBERROR_END, NULL); return; @@ -533,8 +537,10 @@ write_block (st_parameter_dt *dtp, int length) if (is_stream_io (dtp)) { - if (sseek (dtp->u.p.current_unit->s, - dtp->u.p.current_unit->strm_pos - 1) == FAILURE) + if (dtp->u.p.current_unit->strm_pos - 1 + != file_position (dtp->u.p.current_unit->s) + && sseek (dtp->u.p.current_unit->s, + dtp->u.p.current_unit->strm_pos - 1) == FAILURE) { generate_error (&dtp->common, LIBERROR_OS, NULL); return NULL; @@ -595,8 +601,10 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) if (is_stream_io (dtp)) { - if (sseek (dtp->u.p.current_unit->s, - dtp->u.p.current_unit->strm_pos - 1) == FAILURE) + if (dtp->u.p.current_unit->strm_pos - 1 + != file_position (dtp->u.p.current_unit->s) + && sseek (dtp->u.p.current_unit->s, + dtp->u.p.current_unit->strm_pos - 1) == FAILURE) { generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; @@ -2640,8 +2648,13 @@ finalize_transfer (st_parameter_dt *dtp) { if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED) next_record (dtp, 1); - flush (dtp->u.p.current_unit->s); - sfree (dtp->u.p.current_unit->s); + + if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED + && file_position (dtp->u.p.current_unit->s) >= dtp->rec) + { + flush (dtp->u.p.current_unit->s); + sfree (dtp->u.p.current_unit->s); + } return; }