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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130574 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 8ba4cd3..e77ef14 100644 (file)
--- 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 (file)
--- 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;
     }