diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 8ba4cd32c7b17585d5c8c493233be13cfa309414..e77ef147b0a2b86b30025a3714fd95fe6d691e90 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,12 @@ +2007-12-02 Jerry DeLisle <jvdelisle@gcc.gnu.org> + Thomas Koenig <tkoenig@gcc.gnu.org> + + 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 <fxcoudert@gcc.gnu.org> * 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 4073137da7488b2aac752340e4afdd1350129e1c..05711a06015af7d0bb2940fc0a54645b90443e6c 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; }