aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/unf_short_record_1.f9017
-rw-r--r--libgfortran/ChangeLog12
-rw-r--r--libgfortran/io/transfer.c90
-rw-r--r--libgfortran/libgfortran.h1
-rw-r--r--libgfortran/runtime/error.c4
6 files changed, 80 insertions, 49 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 53ed758..f6f95b3 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-10-31 Thomas Koenig <Thomas.Koenig@online.de>
+
+ PR libfortran/29627
+ * gfortran.dg/unf_short_record_1.f90: New test.
+
2006-10-31 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/29067
diff --git a/gcc/testsuite/gfortran.dg/unf_short_record_1.f90 b/gcc/testsuite/gfortran.dg/unf_short_record_1.f90
new file mode 100644
index 0000000..1bb6273
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unf_short_record_1.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! PR 29627 - partial reads of unformatted records
+program main
+ character a(3)
+ character(len=50) msg
+ open(10, form="unformatted", status="unknown")
+ write (10) 'a'
+ write (10) 'c'
+ a = 'b'
+ rewind 10
+ read (10, err=20, iomsg=msg) a
+ call abort
+20 continue
+ if (msg .ne. "Short record on unformatted read") call abort
+ if (a(1) .ne. 'a' .or. a(2) .ne. 'b' .or. a(3) .ne. 'b') call abort
+ close (10, status="delete")
+end program main
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 6dd8270..54849e0 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,15 @@
+2006-10-31 Thomas Koenig <Thomas.Koenig@online.de>
+
+ PR libfortran/29627
+ * libgfortran.h: Add ERROR_SHORT_RECORD
+ * runtime/error.c (translate_error): Add case
+ for ERROR_SHORT_RECORD.
+ * io/transfer.c (read_block_direct): Separate codepaths
+ for stream and record unformatted I/O. Remove unneeded
+ tests for standard input, padding and formatted I/O.
+ If the record is short, read in as much data as possible,
+ then raise the error.
+
2006-10-30 Tobias Burnus <burnus@net-b.de>
PR fortran/29452
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 46fae1b..b4c2bb6 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -359,82 +359,73 @@ read_block (st_parameter_dt *dtp, int *length)
static void
read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
{
- int *length;
- void *data;
size_t nread;
+ int short_record;
- if (!is_stream_io (dtp))
+ if (is_stream_io (dtp))
{
- if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
+ if (sseek (dtp->u.p.current_unit->s,
+ dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
- /* 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->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;
+ generate_error (&dtp->common, ERROR_END, NULL);
+ return;
}
- if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
- dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
+ nread = *nbytes;
+ if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
{
- length = (int *) nbytes;
- data = read_sf (dtp, length, 0); /* Special case. */
- memcpy (buf, data, (size_t) *length);
+ generate_error (&dtp->common, ERROR_OS, NULL);
return;
}
- dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes;
+ dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
+
+ if (nread != *nbytes) /* Short read, e.g. if we hit EOF. */
+ generate_error (&dtp->common, ERROR_END, NULL);
+
+ return;
}
- else
+
+ /* Unformatted file with records */
+ if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
{
- if (sseek (dtp->u.p.current_unit->s,
- dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+ short_record = 1;
+ nread = (size_t) dtp->u.p.current_unit->bytes_left;
+ *nbytes = nread;
+
+ 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;
}
}
- nread = *nbytes;
+ else
+ {
+ short_record = 0;
+ nread = *nbytes;
+ }
+
+ dtp->u.p.current_unit->bytes_left -= nread;
+
if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return;
}
- if (!is_stream_io (dtp))
+ if (nread != *nbytes) /* Short read, e.g. if we hit EOF. */
{
- if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- dtp->u.p.size_used += (gfc_offset) nread;
+ *nbytes = nread;
+ generate_error (&dtp->common, ERROR_END, NULL);
+ return;
}
- else
- dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
- if (nread != *nbytes) /* Short read, e.g. if we hit EOF. */
+ if (short_record)
{
- if (!is_stream_io (dtp))
- generate_error (&dtp->common, ERROR_EOR, NULL);
- else
- generate_error (&dtp->common, ERROR_END, NULL);
+ generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
+ return;
}
}
@@ -595,7 +586,8 @@ unformatted_read (st_parameter_dt *dtp, bt type,
/* By now, all complex variables have been split into their
constituent reals. For types with padding, we only need to
read kind bytes. We don't care about the contents
- of the padding. */
+ of the padding. If we hit a short record, then sz is
+ adjusted accordingly, making later reads no-ops. */
sz = kind;
for (i=0; i<nelems; i++)
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index e023f0e..ff94765 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -413,6 +413,7 @@ typedef enum
ERROR_INTERNAL_UNIT,
ERROR_ALLOCATION,
ERROR_DIRECT_EOR,
+ ERROR_SHORT_RECORD,
ERROR_LAST /* Not a real error, the last error # + 1. */
}
error_codes;
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index f8f76d3..245e04e 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -436,6 +436,10 @@ translate_error (int code)
p = "Write exceeds length of DIRECT access record";
break;
+ case ERROR_SHORT_RECORD:
+ p = "Short record on unformatted read";
+ break;
+
default:
p = "Unknown error code";
break;
generated by cgit v1.1 at 2024-11-05 03:36:44 +0000