diff options
| author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2007-12-02 23:17:16 +0000 |
|---|---|---|
| committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2007-12-02 23:17:16 +0000 |
| commit | 2ea74407863b9a20e652292fb7c0862d6a201c9b (patch) | |
| tree | e033e2ccdc3c68de4f1fe77225eb4e3da8a999ca | |
| parent | 0b93f014a71e3f5e3aa3b46822ae9f74875b2ce7 (diff) | |
| download | gcc-2ea74407863b9a20e652292fb7c0862d6a201c9b.zip gcc-2ea74407863b9a20e652292fb7c0862d6a201c9b.tar.gz gcc-2ea74407863b9a20e652292fb7c0862d6a201c9b.tar.bz2 | |
re PR libfortran/33985 (access="stream",form="unformatted" doesn't buffer)
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.
Co-Authored-By: Thomas Koenig <tkoenig@gcc.gnu.org>
From-SVN: r130574
| -rw-r--r-- | libgfortran/ChangeLog | 9 | ||||
| -rw-r--r-- | libgfortran/io/transfer.c | 33 |
2 files changed, 32 insertions, 10 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 8ba4cd3..e77ef14 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 4073137..05711a0 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; } |