2006-09-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libgfortran/29053
	* io.h (gfc_unit): Add variable, strm_pos, to track
	STREAM I/O file position.
	* file_pos.c (st_rewind): Set strm_pos to beginning.
	* open.c (new_unit): Initialize strm_pos.
	* read.c (read_x): Bump strm_pos.
	* inquire.c (inquire_via_unit): Return strm_pos value.
	* transfer.c (read_block),(read_block_direct),(write_block)
	(write_buf): Seek to strm_pos - 1.  Update strm_pos when done.
	(pre_position): Initialize strm_pos.
	(data_transfer_init): Set strm_pos if DT_HAS_REC.
	(finalize_transfer): Flush file, no need to update strm_pos.

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

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 3671e05..b399bbe 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,18 @@
+2006-09-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libgfortran/29053
+       * io.h (gfc_unit): Add variable, strm_pos, to track
+       STREAM I/O file position.
+       * file_pos.c (st_rewind): Set strm_pos to beginning.
+       * open.c (new_unit): Initialize strm_pos.
+       * read.c (read_x): Bump strm_pos.
+       * inquire.c (inquire_via_unit): Return strm_pos value.
+       * transfer.c (read_block),(read_block_direct),(write_block)
+       (write_buf): Seek to strm_pos - 1.  Update strm_pos when done.
+       (pre_position): Initialize strm_pos.
+       (data_transfer_init): Set strm_pos if DT_HAS_REC.
+       (finalize_transfer): Flush file, no need to update strm_pos.
+
 2006-09-10  Paul Thomas  <pault@gcc.gnu.org>
 
        PR libfortran/28947

diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 3f6a332..979dec5 100644 (file)
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -312,6 +312,7 @@ st_rewind (st_parameter_filepos *fpp)
          u->endfile = NO_ENDFILE;
          u->current_record = 0;
          u->bytes_left = 0;
+         u->strm_pos = 1;
          u->read_bad = 0;
          test_endfile (u);
        }

diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 8a24f49..36e43c2 100644 (file)
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -149,7 +149,7 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
     *iqp->recl_out = (u != NULL) ? u->recl : 0;
 
   if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0)
-    *iqp->strm_pos_out = (u != NULL) ? u->last_record : 0;
+    *iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0;
 
   if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
     *iqp->nextrec = (u != NULL) ? u->last_record + 1 : 0;

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index fba0ae8..0bfc23d 100644 (file)
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -498,8 +498,9 @@ typedef struct gfc_unit
   /* recl           -- Record length of the file.
      last_record    -- Last record number read or written
      maxrec         -- Maximum record number in a direct access file
-     bytes_left     -- Bytes left in current record.  */
-  gfc_offset recl, last_record, maxrec, bytes_left;
+     bytes_left     -- Bytes left in current record.
+     strm_pos       -- Current position in file for STREAM I/O.  */
+  gfc_offset recl, last_record, maxrec, bytes_left, strm_pos;
 
   __gthread_mutex_t lock;
   /* Number of threads waiting to acquire this unit's lock.

diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index b336079..c75ee1a 100644 (file)
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -440,7 +440,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
     {
       u->maxrec = max_offset;
       u->recl = 1;
-      u->last_record = 1;
+      u->strm_pos = 1;
     }
 
   memmove (u->file, opp->file, opp->file_len);

diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index db9ff99..9477425 100644 (file)
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -853,5 +853,5 @@ read_x (st_parameter_dt *dtp, int n)
       dtp->u.p.sf_read_comma = 1;
     }
   else
-    dtp->rec += (GFC_IO_INT) n;
+    dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
 }

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 99e8979..663a1bf 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -318,7 +318,7 @@ read_block (st_parameter_dt *dtp, int *length)
   else
     {
       if (sseek (dtp->u.p.current_unit->s,
-                (gfc_offset) (dtp->rec - 1)) == FAILURE)
+                dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
        {
          generate_error (&dtp->common, ERROR_END, NULL);
          return NULL;
@@ -341,7 +341,7 @@ read_block (st_parameter_dt *dtp, int *length)
            }
        }
 
-      dtp->rec += (GFC_IO_INT) nread;
+      dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
     }
   return source;
 }
@@ -400,7 +400,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
   else
     {
       if (sseek (dtp->u.p.current_unit->s,
-         (gfc_offset) (dtp->rec - 1)) == FAILURE)
+                dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
        {
          generate_error (&dtp->common, ERROR_END, NULL);
          return;
@@ -420,7 +420,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
        dtp->u.p.size_used += (gfc_offset) nread;
     }
   else
-    dtp->rec += (GFC_IO_INT) nread; 
+    dtp->u.p.current_unit->strm_pos += (gfc_offset) nread; 
 
   if (nread != *nbytes)  /* Short read, e.g. if we hit EOF.  */
     {
@@ -479,9 +479,9 @@ write_block (st_parameter_dt *dtp, int length)
   else
     {
       if (sseek (dtp->u.p.current_unit->s,
-         (gfc_offset) (dtp->rec - 1)) == FAILURE)
+                dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
        {
-         generate_error (&dtp->common, ERROR_END, NULL);
+         generate_error (&dtp->common, ERROR_OS, NULL);
          return NULL;
        }
 
@@ -493,7 +493,7 @@ write_block (st_parameter_dt *dtp, int length)
          return NULL;
        }
 
-      dtp->rec += (GFC_IO_INT) length;
+      dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
     }
 
   return dest;
@@ -531,7 +531,7 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
   else
     {
       if (sseek (dtp->u.p.current_unit->s,
-                (gfc_offset) (dtp->rec - 1)) == FAILURE)
+                dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
        {
          generate_error (&dtp->common, ERROR_OS, NULL);
          return FAILURE;
@@ -550,7 +550,7 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
        dtp->u.p.size_used += (gfc_offset) nbytes;
     }
   else
-    dtp->rec += (GFC_IO_INT) nbytes; 
+    dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes; 
 
   return SUCCESS;
 }
@@ -1506,7 +1506,7 @@ pre_position (st_parameter_dt *dtp)
       /* There are no records with stream I/O.  Set the default position
         to the beginning of the file if no position was specified.  */
       if ((dtp->common.flags & IOPARM_DT_HAS_REC) == 0)
-        dtp->rec = 1;
+        dtp->u.p.current_unit->strm_pos = 1;
       break;
     
     case UNFORMATTED_SEQUENTIAL:
@@ -1766,12 +1766,18 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
        }
 
       /* Position the file.  */
-      if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1)
-                 * dtp->u.p.current_unit->recl) == FAILURE)
+      if (!is_stream_io (dtp))
        {
-         generate_error (&dtp->common, ERROR_OS, NULL);
-         return;
+         if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1)
+                    * dtp->u.p.current_unit->recl) == FAILURE)
+           {
+             generate_error (&dtp->common, ERROR_OS, NULL);
+             return;
+           }
        }
+      else
+       dtp->u.p.current_unit->strm_pos = dtp->rec;
+
     }
 
   /* Overwriting an existing sequential file ?
@@ -2367,10 +2373,7 @@ finalize_transfer (st_parameter_dt *dtp)
       next_record (dtp, 1);
     }
   else
-    {
-      flush (dtp->u.p.current_unit->s);
-      dtp->u.p.current_unit->last_record = dtp->rec;
-    }
+    flush (dtp->u.p.current_unit->s);
 
   sfree (dtp->u.p.current_unit->s);
 }