From 2ea74407863b9a20e652292fb7c0862d6a201c9b Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
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 <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
---
libgfortran/ChangeLog | 9 +++++++++
libgfortran/io/transfer.c | 33 +++++++++++++++++++++++----------
2 files changed, 32 insertions(+), 10 deletions(-)
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 8ba4cd32c7b1..e77ef147b0a2 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 4073137da748..05711a06015a 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;
}
--
GitLab