From 4d8ee55b7d3fd31406d095afb53a1fac983490c6 Mon Sep 17 00:00:00 2001
From: jvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Tue, 15 Aug 2006 23:06:44 +0000
Subject: [PATCH] 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@116172 138bc75d-0d04-0410-961f-82ee72b054a4
---
libgfortran/ChangeLog | 31 ++++
libgfortran/io/file_pos.c | 6 +-
libgfortran/io/inquire.c | 6 +
libgfortran/io/io.h | 43 +++--
libgfortran/io/open.c | 12 +-
libgfortran/io/read.c | 22 ++-
libgfortran/io/transfer.c | 357 +++++++++++++++++++++++++-------------
libgfortran/io/unit.c | 9 +
libgfortran/libgfortran.h | 4 +-
9 files changed, 336 insertions(+), 154 deletions(-)
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index bb8b34410e2b..773f80636dbe 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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.
diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 05bb42dc804e..3f6a332d9799 100644
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -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;
diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 9044bf83e211..8a24f498575d 100644
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -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;
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index e16d4b6ec025..fba0ae839914 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -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);
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index 3515bef75cef..b3360792a22e 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -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;
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 9db5d583078d..db9ff99cd121 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -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;
}
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index fc0613129d56..99e897944177 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -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);
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index eca1b1eb98b3..6a2278456491 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -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 */
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 4d27b6592334..0c0e6cd29be3 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -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
--
GitLab