OSDN Git Service

2006-08-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
authorjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 15 Aug 2006 23:06:44 +0000 (23:06 +0000)
committerjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 15 Aug 2006 23:06:44 +0000 (23:06 +0000)
PR libgfortran/25828
* libgfortran.h: Rename GFC_LARGE_IO_INT to GFC_IO_INT.
* io/file_pos.c (st_backspace): Ignore if access=STREAM.
(st_rewind): Handle case of access=STREAM.
* io/open.c (access_opt): Add STREAM_ACCESS.
(edit_modes): Set current_record to zero only if not STREAM.
(new_unit): Initialize maxrec, recl, and last_record for STREAM.
* io/read.c (read_x): Advance file position for STREAM.
* io/io.h (enum unit_access): Align IOPARM flags with frontend.
Add ACCESS_STREAM. Add prototype for is_stream_io () function.
Use GFC_IO_INT.
* io/inquire.c (inquire_via_unit): Add text for access = "STREAM".
* io/unit.c (is_stream_io): New function to return true if access =
STREAM.
* io/transfer.c (file_mode): Add modes for unformatted stream and
formatted stream. (current_mode): Return appropriate file mode based
on access flags.
(read_block): Handle formatted stream reads.
(read_block_direct): Handle unformatted stream reads.
(write_block): Handle formatted stream writes.
(write_buf): Handle unformatted stream writes.
(unformatted_read): Fix up, use temporary for size.
(pre_position): Position file for STREAM access.
(data_transfer_init): Initialize for stream access, skip irrelevent
error checks.
(next_record_r),(next_record_w), and (next_record): Do nothing for
stream I/O.
(finalize_transfer): Flush when all done if stream I/O.

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

libgfortran/ChangeLog
libgfortran/io/file_pos.c
libgfortran/io/inquire.c
libgfortran/io/io.h
libgfortran/io/open.c
libgfortran/io/read.c
libgfortran/io/transfer.c
libgfortran/io/unit.c
libgfortran/libgfortran.h

index bb8b344..773f806 100644 (file)
@@ -1,3 +1,34 @@
+2006-08-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libgfortran/25828
+       * libgfortran.h: Rename GFC_LARGE_IO_INT to GFC_IO_INT.
+       * io/file_pos.c (st_backspace): Ignore if access=STREAM.
+       (st_rewind): Handle case of access=STREAM.
+       * io/open.c (access_opt): Add STREAM_ACCESS.
+       (edit_modes): Set current_record to zero only if not STREAM.
+       (new_unit): Initialize maxrec, recl, and last_record for STREAM.
+       * io/read.c (read_x): Advance file position for STREAM.
+       * io/io.h (enum unit_access): Align IOPARM flags with frontend.
+       Add ACCESS_STREAM. Add prototype for is_stream_io () function.
+       Use GFC_IO_INT.
+       * io/inquire.c (inquire_via_unit): Add text for access = "STREAM".
+       * io/unit.c (is_stream_io): New function to return true if access =
+       STREAM.
+       * io/transfer.c (file_mode): Add modes for unformatted stream and
+       formatted stream. (current_mode): Return appropriate file mode based
+       on access flags.
+       (read_block): Handle formatted stream reads.
+       (read_block_direct): Handle unformatted stream reads.
+       (write_block): Handle formatted stream writes.
+       (write_buf): Handle unformatted stream writes.
+       (unformatted_read): Fix up, use temporary for size.
+       (pre_position): Position file for STREAM access.
+       (data_transfer_init): Initialize for stream access, skip irrelevent
+       error checks.
+       (next_record_r),(next_record_w), and (next_record): Do nothing for
+       stream I/O.
+       (finalize_transfer): Flush when all done if stream I/O.
+
 2006-08-12  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
        * intrinsics/bessel.c: Add prototypes for all functions.
index 05bb42d..3f6a332 100644 (file)
@@ -205,7 +205,7 @@ st_backspace (st_parameter_filepos *fpp)
      sequential I/O and the next direct access transfer repositions the file 
      anyway.  */
 
-  if (u->flags.access == ACCESS_DIRECT)
+  if (u->flags.access == ACCESS_DIRECT || u->flags.access == ACCESS_STREAM)
     goto done;
 
   /* Check for special cases involving the ENDFILE record first.  */
@@ -291,7 +291,7 @@ st_rewind (st_parameter_filepos *fpp)
   u = find_unit (fpp->common.unit);
   if (u != NULL)
     {
-      if (u->flags.access != ACCESS_SEQUENTIAL)
+      if (u->flags.access == ACCESS_DIRECT)
        generate_error (&fpp->common, ERROR_BAD_OPTION,
                        "Cannot REWIND a file opened for DIRECT access");
       else
@@ -301,7 +301,7 @@ st_rewind (st_parameter_filepos *fpp)
               file now.  Reset to read mode so two consecutive rewind
               statements do not delete the file contents.  */
          flush (u->s);
-         if (u->mode == WRITING)
+         if (u->mode == WRITING && u->flags.access != ACCESS_STREAM)
            struncate (u->s);
 
          u->mode = READING;
index 9044bf8..8a24f49 100644 (file)
@@ -75,6 +75,9 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
          case ACCESS_DIRECT:
            p = "DIRECT";
            break;
+         case ACCESS_STREAM:
+           p = "STREAM";
+           break;
          default:
            internal_error (&iqp->common, "inquire_via_unit(): Bad access");
          }
@@ -145,6 +148,9 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
   if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
     *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;
+
   if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
     *iqp->nextrec = (u != NULL) ? u->last_record + 1 : 0;
 
index e16d4b6..fba0ae8 100644 (file)
@@ -156,7 +156,7 @@ namelist_info;
 /* Options for the OPEN statement.  */
 
 typedef enum
-{ ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND,
+{ ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM,
   ACCESS_UNSPECIFIED
 }
 unit_access;
@@ -290,29 +290,31 @@ st_parameter_filepos;
 #define IOPARM_INQUIRE_HAS_NAMED       (1 << 10)
 #define IOPARM_INQUIRE_HAS_NEXTREC     (1 << 11)
 #define IOPARM_INQUIRE_HAS_RECL_OUT    (1 << 12)
-#define IOPARM_INQUIRE_HAS_FILE                (1 << 13)
-#define IOPARM_INQUIRE_HAS_ACCESS      (1 << 14)
-#define IOPARM_INQUIRE_HAS_FORM                (1 << 15)
-#define IOPARM_INQUIRE_HAS_BLANK       (1 << 16)
-#define IOPARM_INQUIRE_HAS_POSITION    (1 << 17)
-#define IOPARM_INQUIRE_HAS_ACTION      (1 << 18)
-#define IOPARM_INQUIRE_HAS_DELIM       (1 << 19)
-#define IOPARM_INQUIRE_HAS_PAD         (1 << 20)
-#define IOPARM_INQUIRE_HAS_NAME                (1 << 21)
-#define IOPARM_INQUIRE_HAS_SEQUENTIAL  (1 << 22)
-#define IOPARM_INQUIRE_HAS_DIRECT      (1 << 23)
-#define IOPARM_INQUIRE_HAS_FORMATTED   (1 << 24)
-#define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 25)
-#define IOPARM_INQUIRE_HAS_READ                (1 << 26)
-#define IOPARM_INQUIRE_HAS_WRITE       (1 << 27)
-#define IOPARM_INQUIRE_HAS_READWRITE   (1 << 28)
-#define IOPARM_INQUIRE_HAS_CONVERT     (1 << 29)
+#define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13)
+#define IOPARM_INQUIRE_HAS_FILE                (1 << 14)
+#define IOPARM_INQUIRE_HAS_ACCESS      (1 << 15)
+#define IOPARM_INQUIRE_HAS_FORM                (1 << 16)
+#define IOPARM_INQUIRE_HAS_BLANK       (1 << 17)
+#define IOPARM_INQUIRE_HAS_POSITION    (1 << 18)
+#define IOPARM_INQUIRE_HAS_ACTION      (1 << 19)
+#define IOPARM_INQUIRE_HAS_DELIM       (1 << 20)
+#define IOPARM_INQUIRE_HAS_PAD         (1 << 21)
+#define IOPARM_INQUIRE_HAS_NAME                (1 << 22)
+#define IOPARM_INQUIRE_HAS_SEQUENTIAL  (1 << 23)
+#define IOPARM_INQUIRE_HAS_DIRECT      (1 << 24)
+#define IOPARM_INQUIRE_HAS_FORMATTED   (1 << 25)
+#define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 26)
+#define IOPARM_INQUIRE_HAS_READ                (1 << 27)
+#define IOPARM_INQUIRE_HAS_WRITE       (1 << 28)
+#define IOPARM_INQUIRE_HAS_READWRITE   (1 << 29)
+#define IOPARM_INQUIRE_HAS_CONVERT     (1 << 30)
 
 typedef struct
 {
   st_parameter_common common;
   GFC_INTEGER_4 *exist, *opened, *number, *named;
   GFC_INTEGER_4 *nextrec, *recl_out;
+  GFC_IO_INT *strm_pos_out;
   CHARACTER1 (file);
   CHARACTER2 (access);
   CHARACTER1 (form);
@@ -351,7 +353,7 @@ struct format_data;
 typedef struct st_parameter_dt
 {
   st_parameter_common common;
-  GFC_LARGE_IO_INT rec;
+  GFC_IO_INT rec;
   GFC_INTEGER_4 *size, *iolength;
   gfc_array_char *internal_unit_desc;
   CHARACTER1 (format);
@@ -709,6 +711,9 @@ internal_proto(is_internal_unit);
 extern int is_array_io (st_parameter_dt *);
 internal_proto(is_array_io);
 
+extern int is_stream_io (st_parameter_dt *);
+internal_proto(is_stream_io);
+
 extern gfc_unit *find_unit (int);
 internal_proto(find_unit);
 
index 3515bef..b336079 100644 (file)
@@ -40,6 +40,7 @@ static const st_option access_opt[] = {
   {"sequential", ACCESS_SEQUENTIAL},
   {"direct", ACCESS_DIRECT},
   {"append", ACCESS_APPEND},
+  {"stream", ACCESS_STREAM},
   {NULL, 0}
 };
 
@@ -214,7 +215,9 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
       if (sseek (u->s, file_length (u->s)) == FAILURE)
        goto seek_error;
 
-      u->current_record = 0;
+      if (flags->access != ACCESS_STREAM)
+       u->current_record = 0;
+
       u->endfile = AT_ENDFILE; /* We are at the end.  */
       break;
 
@@ -432,6 +435,13 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
 
   if (flags->access == ACCESS_DIRECT)
     u->maxrec = max_offset / u->recl;
+  
+  if (flags->access == ACCESS_STREAM)
+    {
+      u->maxrec = max_offset;
+      u->recl = 1;
+      u->last_record = 1;
+    }
 
   memmove (u->file, opp->file, opp->file_len);
   u->file_len = opp->file_len;
index 9db5d58..db9ff99 100644 (file)
@@ -841,13 +841,17 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 void
 read_x (st_parameter_dt *dtp, int n)
 {
-  if ((dtp->u.p.current_unit->flags.pad == PAD_NO || is_internal_unit (dtp))
-      && dtp->u.p.current_unit->bytes_left < n)
-    n = dtp->u.p.current_unit->bytes_left;
-
-  dtp->u.p.sf_read_comma = 0;
-  if (n > 0)
-    read_sf (dtp, &n, 1);
-  dtp->u.p.sf_read_comma = 1;
-
+  if (!is_stream_io (dtp))
+    {
+      if ((dtp->u.p.current_unit->flags.pad == PAD_NO || is_internal_unit (dtp))
+         && dtp->u.p.current_unit->bytes_left < n)
+       n = dtp->u.p.current_unit->bytes_left;
+
+      dtp->u.p.sf_read_comma = 0;
+      if (n > 0)
+       read_sf (dtp, &n, 1);
+      dtp->u.p.sf_read_comma = 1;
+    }
+  else
+    dtp->rec += (GFC_IO_INT) n;
 }
index fc06131..99e8979 100644 (file)
@@ -91,7 +91,7 @@ static const st_option advance_opt[] = {
 
 typedef enum
 { FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL,
-  FORMATTED_DIRECT, UNFORMATTED_DIRECT
+  FORMATTED_DIRECT, UNFORMATTED_DIRECT, FORMATTED_STREAM, UNFORMATTED_STREAM
 }
 file_mode;
 
@@ -101,16 +101,23 @@ current_mode (st_parameter_dt *dtp)
 {
   file_mode m;
 
+  m = FORM_UNSPECIFIED;
+
   if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
     {
       m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ?
        FORMATTED_DIRECT : UNFORMATTED_DIRECT;
     }
-  else
+  else if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
     {
       m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ?
        FORMATTED_SEQUENTIAL : UNFORMATTED_SEQUENTIAL;
     }
+  else if (dtp->u.p.current_unit->flags.access == ACCESS_STREAM)
+    {
+      m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ?
+       FORMATTED_STREAM : UNFORMATTED_STREAM;
+    }
 
   return m;
 }
@@ -128,7 +135,7 @@ current_mode (st_parameter_dt *dtp)
    an I/O error.
 
    Given this, the solution is to read a byte at a time, stopping if
-   we hit the newline.  For small locations, we use a static buffer.
+   we hit the newline.  For small allocations, we use a static buffer.
    For larger allocations, we are forced to allocate memory on the
    heap.  Hopefully this won't happen very often.  */
 
@@ -256,56 +263,86 @@ read_block (st_parameter_dt *dtp, int *length)
   char *source;
   int nread;
 
-  if (dtp->u.p.current_unit->bytes_left < *length)
+  if (!is_stream_io (dtp))
     {
-      /* For preconnected units with default record length, set bytes left
-        to unit record length and proceed, otherwise error.  */
-      if (dtp->u.p.current_unit->unit_number == options.stdin_unit
-         && dtp->u.p.current_unit->recl == DEFAULT_RECL)
-        dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
-      else
+      if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *length)
        {
-         if (dtp->u.p.current_unit->flags.pad == PAD_NO)
+         /* For preconnected units with default record length, set bytes left
+          to unit record length and proceed, otherwise error.  */
+         if (dtp->u.p.current_unit->unit_number == options.stdin_unit
+             && dtp->u.p.current_unit->recl == DEFAULT_RECL)
+          dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
+         else
            {
-             /* Not enough data left.  */
-             generate_error (&dtp->common, ERROR_EOR, NULL);
+             if (dtp->u.p.current_unit->flags.pad == PAD_NO)
+               {
+                 /* Not enough data left.  */
+                 generate_error (&dtp->common, ERROR_EOR, NULL);
+                 return NULL;
+               }
+           }
+
+         if (dtp->u.p.current_unit->bytes_left == 0)
+           {
+             dtp->u.p.current_unit->endfile = AT_ENDFILE;
+             generate_error (&dtp->common, ERROR_END, NULL);
              return NULL;
            }
+
+         *length = dtp->u.p.current_unit->bytes_left;
        }
 
-      if (dtp->u.p.current_unit->bytes_left == 0)
+      if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
+       dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
+         return read_sf (dtp, length, 0);      /* Special case.  */
+
+      dtp->u.p.current_unit->bytes_left -= (gfc_offset) *length;
+
+      nread = *length;
+      source = salloc_r (dtp->u.p.current_unit->s, &nread);
+
+      if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+       dtp->u.p.size_used += (gfc_offset) nread;
+
+      if (nread != *length)
+       {                               /* Short read, this shouldn't happen.  */
+         if (dtp->u.p.current_unit->flags.pad == PAD_YES)
+           *length = nread;
+         else
+           {
+             generate_error (&dtp->common, ERROR_EOR, NULL);
+             source = NULL;
+           }
+       }
+    }
+  else
+    {
+      if (sseek (dtp->u.p.current_unit->s,
+                (gfc_offset) (dtp->rec - 1)) == FAILURE)
        {
-         dtp->u.p.current_unit->endfile = AT_ENDFILE;
          generate_error (&dtp->common, ERROR_END, NULL);
          return NULL;
        }
 
-      *length = dtp->u.p.current_unit->bytes_left;
-    }
-
-  if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
-      dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
-    return read_sf (dtp, length, 0);   /* Special case.  */
-
-  dtp->u.p.current_unit->bytes_left -= *length;
-
-  nread = *length;
-  source = salloc_r (dtp->u.p.current_unit->s, &nread);
+      nread = *length;
+      source = salloc_r (dtp->u.p.current_unit->s, &nread);
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    dtp->u.p.size_used += (gfc_offset) nread;
+      if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+       dtp->u.p.size_used += (gfc_offset) nread;
 
-  if (nread != *length)
-    {                          /* Short read, this shouldn't happen.  */
-      if (dtp->u.p.current_unit->flags.pad == PAD_YES)
-       *length = nread;
-      else
-       {
-         generate_error (&dtp->common, ERROR_EOR, NULL);
-         source = NULL;
+      if (nread != *length)
+       {                               /* Short read, this shouldn't happen.  */
+         if (dtp->u.p.current_unit->flags.pad == PAD_YES)
+           *length = nread;
+         else
+           {
+             generate_error (&dtp->common, ERROR_END, NULL);
+             source = NULL;
+           }
        }
-    }
 
+      dtp->rec += (GFC_IO_INT) nread;
+    }
   return source;
 }
 
@@ -319,44 +356,57 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
   void *data;
   size_t nread;
 
-  if (dtp->u.p.current_unit->bytes_left < *nbytes)
+  if (!is_stream_io (dtp))
     {
-      /* For preconnected units with default record length, set bytes left
-        to unit record length and proceed, otherwise error.  */
-      if (dtp->u.p.current_unit->unit_number == options.stdin_unit
-         && dtp->u.p.current_unit->recl == DEFAULT_RECL)
-        dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
-      else
+      if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
        {
-         if (dtp->u.p.current_unit->flags.pad == PAD_NO)
+         /* For preconnected units with default record length, set
+            bytes left to unit record length and proceed, otherwise
+            error.  */
+         if (dtp->u.p.current_unit->unit_number == options.stdin_unit
+             && dtp->u.p.current_unit->recl == DEFAULT_RECL)
+           dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
+         else
            {
-             /* Not enough data left.  */
-             generate_error (&dtp->common, ERROR_EOR, NULL);
+             if (dtp->u.p.current_unit->flags.pad == PAD_NO)
+               {
+                 /* Not enough data left.  */
+                 generate_error (&dtp->common, ERROR_EOR, NULL);
+                 return;
+               }
+           }
+         
+         if (dtp->u.p.current_unit->bytes_left == 0)
+           {
+             dtp->u.p.current_unit->endfile = AT_ENDFILE;
+             generate_error (&dtp->common, ERROR_END, NULL);
              return;
            }
+
+         *nbytes = (size_t) dtp->u.p.current_unit->bytes_left;
        }
 
-      if (dtp->u.p.current_unit->bytes_left == 0)
+      if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
+         dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
        {
-         dtp->u.p.current_unit->endfile = AT_ENDFILE;
-         generate_error (&dtp->common, ERROR_END, NULL);
+         length = (int *) nbytes;
+         data = read_sf (dtp, length, 0);      /* Special case.  */
+         memcpy (buf, data, (size_t) *length);
          return;
        }
 
-      *nbytes = dtp->u.p.current_unit->bytes_left;
+      dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes;
     }
-
-  if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
-      dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
+  else
     {
-      length = (int *) nbytes;
-      data = read_sf (dtp, length, 0); /* Special case.  */
-      memcpy (buf, data, (size_t) *length);
-      return;
+      if (sseek (dtp->u.p.current_unit->s,
+         (gfc_offset) (dtp->rec - 1)) == FAILURE)
+       {
+         generate_error (&dtp->common, ERROR_END, NULL);
+         return;
+       }
     }
 
-  dtp->u.p.current_unit->bytes_left -= *nbytes;
-
   nread = *nbytes;
   if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
     {
@@ -364,18 +414,20 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
       return;
     }
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    dtp->u.p.size_used += (gfc_offset) nread;
+  if (!is_stream_io (dtp))
+    {
+      if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+       dtp->u.p.size_used += (gfc_offset) nread;
+    }
+  else
+    dtp->rec += (GFC_IO_INT) nread; 
 
-  if (nread != *nbytes)
-    {                          /* Short read, e.g. if we hit EOF.  */
-      if (dtp->u.p.current_unit->flags.pad == PAD_YES)
-       {
-         memset (((char *) buf) + nread, ' ', *nbytes - nread);
-         *nbytes = nread;
-       }
-      else
+  if (nread != *nbytes)  /* Short read, e.g. if we hit EOF.  */
+    {
+      if (!is_stream_io (dtp))
        generate_error (&dtp->common, ERROR_EOR, NULL);
+      else
+       generate_error (&dtp->common, ERROR_END, NULL);   
     }
 }
 
@@ -390,35 +442,59 @@ write_block (st_parameter_dt *dtp, int length)
 {
   char *dest;
 
-  if (dtp->u.p.current_unit->bytes_left < length)
+  if (!is_stream_io (dtp))
     {
-      /* For preconnected units with default record length, set bytes left
-        to unit record length and proceed, otherwise error.  */
-      if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
-         || dtp->u.p.current_unit->unit_number == options.stderr_unit)
-         && dtp->u.p.current_unit->recl == DEFAULT_RECL)
-        dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
-      else
+      if (dtp->u.p.current_unit->bytes_left < (gfc_offset) length)
        {
-         generate_error (&dtp->common, ERROR_EOR, NULL);
-         return NULL;
+         /* For preconnected units with default record length, set bytes left
+            to unit record length and proceed, otherwise error.  */
+         if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
+               || dtp->u.p.current_unit->unit_number == options.stderr_unit)
+               && dtp->u.p.current_unit->recl == DEFAULT_RECL)
+           dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
+         else
+           {
+             generate_error (&dtp->common, ERROR_EOR, NULL);
+             return NULL;
+           }
        }
-    }
 
-  dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
-  dest = salloc_w (dtp->u.p.current_unit->s, &length);
+      dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
+
+
+      dest = salloc_w (dtp->u.p.current_unit->s, &length);
   
-  if (dest == NULL)
-    {
-      generate_error (&dtp->common, ERROR_END, NULL);
-      return NULL;
+      if (dest == NULL)
+       {
+         generate_error (&dtp->common, ERROR_END, NULL);
+         return NULL;
+       }
+
+      if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE)
+       generate_error (&dtp->common, ERROR_END, NULL);
+
+      if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+       dtp->u.p.size_used += (gfc_offset) length;
     }
+  else
+    {
+      if (sseek (dtp->u.p.current_unit->s,
+         (gfc_offset) (dtp->rec - 1)) == FAILURE)
+       {
+         generate_error (&dtp->common, ERROR_END, NULL);
+         return NULL;
+       }
 
-  if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE)
-    generate_error (&dtp->common, ERROR_END, NULL);
+      dest = salloc_w (dtp->u.p.current_unit->s, &length);
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    dtp->u.p.size_used += (gfc_offset) length;
+      if (dest == NULL)
+       {
+         generate_error (&dtp->common, ERROR_END, NULL);
+         return NULL;
+       }
+
+      dtp->rec += (GFC_IO_INT) length;
+    }
 
   return dest;
 }
@@ -429,34 +505,52 @@ write_block (st_parameter_dt *dtp, int length)
 static try
 write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
 {
-  if (dtp->u.p.current_unit->bytes_left < nbytes)
+  if (!is_stream_io (dtp))
     {
-      /* For preconnected units with default record length, set bytes left
-        to unit record length and proceed, otherwise error.  */
-      if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
-         || dtp->u.p.current_unit->unit_number == options.stderr_unit)
-         && dtp->u.p.current_unit->recl == DEFAULT_RECL)
-        dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
-      else
+      if (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes)
        {
-         if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
-           generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
+         /* For preconnected units with default record length, set
+            bytes left to unit record length and proceed, otherwise
+            error.  */
+         if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
+              || dtp->u.p.current_unit->unit_number == options.stderr_unit)
+             && dtp->u.p.current_unit->recl == DEFAULT_RECL)
+           dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
          else
-           generate_error (&dtp->common, ERROR_EOR, NULL);
+           {
+             if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
+               generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
+             else
+               generate_error (&dtp->common, ERROR_EOR, NULL);
+             return FAILURE;
+           }
+       }
+
+      dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
+    }
+  else
+    {
+      if (sseek (dtp->u.p.current_unit->s,
+                (gfc_offset) (dtp->rec - 1)) == FAILURE)
+       {
+         generate_error (&dtp->common, ERROR_OS, NULL);
          return FAILURE;
        }
     }
 
-  dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
-
   if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
     {
       generate_error (&dtp->common, ERROR_OS, NULL);
       return FAILURE;
     }
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    dtp->u.p.size_used += (gfc_offset) nbytes;
+  if (!is_stream_io (dtp))
+    {
+      if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+       dtp->u.p.size_used += (gfc_offset) nbytes;
+    }
+  else
+    dtp->rec += (GFC_IO_INT) nbytes; 
 
   return SUCCESS;
 }
@@ -469,18 +563,19 @@ unformatted_read (st_parameter_dt *dtp, bt type,
                  void *dest, int kind,
                  size_t size, size_t nelems)
 {
+  size_t i, sz;
+
   /* Currently, character implies size=1.  */
   if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE
       || size == 1 || type == BT_CHARACTER)
     {
-      size *= nelems;
-      read_block_direct (dtp, dest, &size);
+      sz = size * nelems;
+      read_block_direct (dtp, dest, &sz);
     }
   else
     {
       char buffer[16];
       char *p;
-      size_t i, sz;
       
       /* Break up complex into its constituent reals.  */
       if (type == BT_COMPLEX)
@@ -721,7 +816,8 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len,
          dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
        }
 
-      bytes_used = (int)(dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left);
+      bytes_used = (int)(dtp->u.p.current_unit->recl
+                        - dtp->u.p.current_unit->bytes_left);
 
       switch (t)
        {
@@ -1405,6 +1501,14 @@ pre_position (st_parameter_dt *dtp)
 
   switch (current_mode (dtp))
     {
+    case FORMATTED_STREAM:
+    case UNFORMATTED_STREAM:
+      /* 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;
+      break;
+    
     case UNFORMATTED_SEQUENTIAL:
       if (dtp->u.p.mode == READING)
        us_read (dtp);
@@ -1549,13 +1653,12 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
     generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
                    "Missing format for FORMATTED data transfer");
 
-
   if (is_internal_unit (dtp)
       && dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED)
     generate_error (&dtp->common, ERROR_OPTION_CONFLICT,
                    "Internal file cannot be accessed by UNFORMATTED data transfer");
 
-  /* Check the record number.  */
+  /* Check the record or position number.  */
 
   if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT
       && (cf & IOPARM_DT_HAS_REC) == 0)
@@ -1628,7 +1731,6 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
     return;
 
   /* Sanity checks on the record number.  */
-
   if ((cf & IOPARM_DT_HAS_REC) != 0)
     {
       if (dtp->rec <= 0)
@@ -1664,8 +1766,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
        }
 
       /* Position the file.  */
-      if (sseek (dtp->u.p.current_unit->s,
-              (dtp->rec - 1) * dtp->u.p.current_unit->recl) == FAILURE)
+      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;
@@ -1723,7 +1825,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 
   if (read_flag)
     {
-      if (dtp->u.p.current_unit->read_bad)
+      if (dtp->u.p.current_unit->read_bad && !is_stream_io (dtp))
        {
          generate_error (&dtp->common, ERROR_BAD_OPTION,
                          "Cannot READ after a nonadvancing WRITE");
@@ -1813,6 +1915,11 @@ next_record_r (st_parameter_dt *dtp)
 
   switch (current_mode (dtp))
     {
+    /* No records in STREAM I/O.  */
+    case FORMATTED_STREAM:
+    case UNFORMATTED_STREAM:
+      return;
+    
     case UNFORMATTED_SEQUENTIAL:
 
       /* Skip over tail */
@@ -2003,6 +2110,11 @@ next_record_w (st_parameter_dt *dtp, int done)
 
   switch (current_mode (dtp))
     {
+    /* No records in STREAM I/O.  */
+    case FORMATTED_STREAM:
+    case UNFORMATTED_STREAM:
+      return;
+
     case FORMATTED_DIRECT:
       if (dtp->u.p.current_unit->bytes_left == 0)
        break;
@@ -2166,6 +2278,9 @@ next_record_w (st_parameter_dt *dtp, int done)
 void
 next_record (st_parameter_dt *dtp, int done)
 {
+  if (is_stream_io (dtp))
+    return;
+
   gfc_offset fp; /* File position.  */
 
   dtp->u.p.current_unit->read_bad = 0;
@@ -2177,7 +2292,6 @@ next_record (st_parameter_dt *dtp, int done)
 
   /* keep position up to date for INQUIRE */
   dtp->u.p.current_unit->flags.position = POSITION_ASIS;
-
   dtp->u.p.current_unit->current_record = 0;
   if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
    {
@@ -2238,7 +2352,7 @@ finalize_transfer (st_parameter_dt *dtp)
 
   if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING)
     finish_list_read (dtp);
-  else
+  else if (!is_stream_io (dtp))
     {
       dtp->u.p.current_unit->current_record = 0;
       if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar)
@@ -2250,9 +2364,13 @@ finalize_transfer (st_parameter_dt *dtp)
          dtp->u.p.seen_dollar = 0;
          return;
        }
-
       next_record (dtp, 1);
     }
+  else
+    {
+      flush (dtp->u.p.current_unit->s);
+      dtp->u.p.current_unit->last_record = dtp->rec;
+    }
 
   sfree (dtp->u.p.current_unit->s);
 }
@@ -2325,7 +2443,6 @@ export_proto(st_read);
 void
 st_read (st_parameter_dt *dtp)
 {
-
   library_start (&dtp->common);
 
   data_transfer_init (dtp, 1);
index eca1b1e..6a22784 100644 (file)
@@ -493,6 +493,15 @@ is_array_io (st_parameter_dt *dtp)
 }
 
 
+/* is_stream_io () -- Determine if I/O is access="stream" mode */
+
+int
+is_stream_io (st_parameter_dt *dtp)
+{
+  return dtp->u.p.current_unit->flags.access == ACCESS_STREAM;
+}
+
+
 /*************************/
 /* Initialize everything */
 
index 4d27b65..0c0e6cd 100644 (file)
@@ -200,10 +200,10 @@ typedef off_t gfc_offset;
 /* Define the type used for the current record number for large file I/O.
    The size must be consistent with the size defined on the compiler side.  */
 #ifdef HAVE_GFC_INTEGER_8
-typedef GFC_INTEGER_8 GFC_LARGE_IO_INT;
+typedef GFC_INTEGER_8 GFC_IO_INT;
 #else
 #ifdef HAVE_GFC_INTEGER_4
-typedef GFC_INTEGER_4 GFC_LARGE_IO_INT;
+typedef GFC_INTEGER_4 GFC_IO_INT;
 #else
 #error "GFC_INTEGER_4 should be available for the library to compile".
 #endif