diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9442f687e8d9175a3aafa9a4e2d577e643b67a82..be3e91e5dacb6d77e4ad3de9304ba031e863a1cc 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+2006-12-01 Thomas Koenig <Thomas.Koenig@online.de>
+
+ PR libfortran/29568
+ * gfortran.h (gfc_option_t): Add max_subrecord_length.
+ (top level): Define MAX_SUBRECORD_LENGTH.
+ * lang.opt: Add option -fmax-subrecord-length=.
+ * trans-decl.c: Add new function set_max_subrecord_length.
+ (gfc_generate_function_code): If we are within the main
+ program and max_subrecord_length has been set, call
+ set_max_subrecord_length.
+ * options.c (gfc_init_options): Add defaults for
+ max_subrecord_lenght, convert and record_marker.
+ (gfc_handle_option): Add handling for
+ -fmax_subrecord_length.
+ * invoke.texi: Document the new default for
+ -frecord-marker=<n>.
+
2006-11-28 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29976
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 277cc7836a092c57e884d53c0838f09c73f03c29..9a18e7851d725ff071bcff9581b7e1db1a158bd9 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -59,6 +59,9 @@ char *alloca ();
#define GFC_MAX_DIMENSIONS 7 /* Maximum dimensions in an array. */
#define GFC_LETTERS 26 /* Number of letters in the alphabet. */
+#define MAX_SUBRECORD_LENGTH 2147483639 /* 2**31-9 */
+
+
#define free(x) Use_gfc_free_instead_of_free()
#define gfc_is_whitespace(c) ((c==' ') || (c=='\t'))
@@ -1661,12 +1664,12 @@ typedef struct
int fshort_enums;
int convert;
int record_marker;
+ int max_subrecord_length;
}
gfc_option_t;
extern gfc_option_t gfc_option;
-
/* Constructor nodes for array and structure constructors. */
typedef struct gfc_constructor
{
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index c27218c4444c2dd081bc3d2fb6255446ccef3c69..c4ee5d351baa9275c16ac3d0d16a79c5e5e47bf2 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -650,13 +650,17 @@ variable override the default specified by -fconvert.}
@cindex -frecord-marker=@var{length}
@item -frecord-marker=@var{length}
Specify the length of record markers for unformatted files.
-Valid values for @var{length} are 4 and 8. Default is whatever
-@code{off_t} is specified to be on that particular system.
-Note that specifying @var{length} as 4 limits the record
-length of unformatted files to 2 GB. This option does not
-extend the maximum possible record length on systems where
-@code{off_t} is a four_byte quantity.
-
+Valid values for @var{length} are 4 and 8. Default is 4.
+@emph{This is different from previous versions of gfortran},
+which specified a default record marker length of 8 on most
+systems. If you want to read or write files compatible
+with earlier versions of gfortran, use @samp{-frecord-marker=8}.
+
+@cindex -fmax-subrecord-length=@var{length}
+@item -fmax-subrecord-length=@var{length}
+Specify the maximum length for a subrecord. The maximum permitted
+value for length is 2147483639, which is also the default. Only
+really useful for use by the gfortran testsuite.
@end table
@node Code Gen Options
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 053f63b00191aca47a3b5b7976bf7c914162a0a1..ebd6b8dd8ec05a379218c3f7862a69d502db14b2 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -189,6 +189,10 @@ fmax-identifier-length=
Fortran RejectNegative Joined UInteger
-fmax-identifier-length=<n> Maximum identifier length
+fmax-subrecord-length=
+Fortran RejectNegative Joined UInteger
+-fmax-subrecord-length=<n> Maximum length for subrecords
+
fmax-stack-var-size=
Fortran RejectNegative Joined UInteger
-fmax-stack-var-size=<n> Size in bytes of the largest array that will be put on the stack
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index f03319bbcea66e1985aafc4f6b8c86eb81d8bc2e..6ec846761850eb32f0c4b95a5d1f4fda874a4df8 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -51,6 +51,9 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
gfc_option.max_continue_fixed = 19;
gfc_option.max_continue_free = 39;
gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN;
+ gfc_option.max_subrecord_length = 0;
+ gfc_option.convert = CONVERT_NATIVE;
+ gfc_option.record_marker = 0;
gfc_option.verbose = 0;
gfc_option.warn_aliasing = 0;
@@ -636,6 +639,12 @@ gfc_handle_option (size_t scode, const char *arg, int value)
case OPT_frecord_marker_8:
gfc_option.record_marker = 8;
break;
+
+ case OPT_fmax_subrecord_length_:
+ if (value > MAX_SUBRECORD_LENGTH)
+ gfc_fatal_error ("Maximum subrecord length cannot exceed %d", MAX_SUBRECORD_LENGTH);
+
+ gfc_option.max_subrecord_length = value;
}
return result;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 1f3ab7d42f6da8dfb5233e6702d137507dea978c..270083f022e13efe9f834ba58a0821096074ef78 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -94,6 +94,7 @@ tree gfor_fndecl_set_fpe;
tree gfor_fndecl_set_std;
tree gfor_fndecl_set_convert;
tree gfor_fndecl_set_record_marker;
+tree gfor_fndecl_set_max_subrecord_length;
tree gfor_fndecl_ctime;
tree gfor_fndecl_fdate;
tree gfor_fndecl_ttynam;
@@ -2379,6 +2380,10 @@ gfc_build_builtin_function_decls (void)
gfc_build_library_function_decl (get_identifier (PREFIX("set_record_marker")),
void_type_node, 1, gfc_c_int_type_node);
+ gfor_fndecl_set_max_subrecord_length =
+ gfc_build_library_function_decl (get_identifier (PREFIX("set_max_subrecord_length")),
+ void_type_node, 1, gfc_c_int_type_node);
+
gfor_fndecl_in_pack = gfc_build_library_function_decl (
get_identifier (PREFIX("internal_pack")),
pvoid_type_node, 1, pvoid_type_node);
@@ -3187,6 +3192,18 @@ gfc_generate_function_code (gfc_namespace * ns)
}
+ if (sym->attr.is_main_program && gfc_option.max_subrecord_length != 0)
+ {
+ tree arglist, gfc_c_int_type_node;
+
+ gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
+ arglist = gfc_chainon_list (NULL_TREE,
+ build_int_cst (gfc_c_int_type_node,
+ gfc_option.max_subrecord_length));
+ tmp = build_function_call_expr (gfor_fndecl_set_max_subrecord_length, arglist);
+ gfc_add_expr_to_block (&body, tmp);
+ }
+
if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
&& sym->attr.subroutine)
{
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 08b4e0446e5626f9281e463b2fccaaf62eaf7d8b..fe29e8615eb677cdeaaf7c15fa12d8d03193e7d6 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2006-12-01 Thomas Koenig <Thomas.Koenig@online.de>
+
+ PR libfortran/29568
+ * gfortran.dg/convert_implied_open.f90: Change to
+ new default record length.
+ * gfortran.dg/unf_short_record_1.f90: Adapt to
+ new error message.
+ * gfortran.dg/unformatted_subrecords_1.f90: New test.
+
2006-12-01 Andrew MacLeod <amacleod@redhat.com>
* gcc.dg/max-1.c: Remove reference to -fno-tree-lrs option.
diff --git a/gcc/testsuite/gfortran.dg/convert_implied_open.f90 b/gcc/testsuite/gfortran.dg/convert_implied_open.f90
index 4066f618cc223f50bd0312ad6a3c781c1caf0d54..9c25b5d961c2ce306e059bd15643fca2f41f2adc 100644
--- a/gcc/testsuite/gfortran.dg/convert_implied_open.f90
+++ b/gcc/testsuite/gfortran.dg/convert_implied_open.f90
@@ -3,13 +3,13 @@
! PR 26735 - implied open didn't use to honor -fconvert
program main
implicit none
- integer (kind=8) :: i1, i2, i3
- write (10) 1_8
+ integer (kind=4) :: i1, i2, i3
+ write (10) 1_4
close (10)
- open (10, form="unformatted", access="direct", recl=8)
+ open (10, form="unformatted", access="direct", recl=4)
read (10,rec=1) i1
read (10,rec=2) i2
read (10,rec=3) i3
- if (i1 /= 8 .or. i2 /= 1 .or. i3 /= 8) call abort
+ if (i1 /= 4 .or. i2 /= 1 .or. i3 /= 4) call abort
close (10,status="delete")
end program main
diff --git a/gcc/testsuite/gfortran.dg/unf_short_record_1.f90 b/gcc/testsuite/gfortran.dg/unf_short_record_1.f90
index 1bb62736a361e421843f37504d9edf253a607632..45c94c29405dbe935990078bb6e9552af3fbf798 100644
--- a/gcc/testsuite/gfortran.dg/unf_short_record_1.f90
+++ b/gcc/testsuite/gfortran.dg/unf_short_record_1.f90
@@ -11,7 +11,7 @@ program main
read (10, err=20, iomsg=msg) a
call abort
20 continue
- if (msg .ne. "Short record on unformatted read") call abort
+ if (msg .ne. "I/O past end of record on unformatted file") 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/gcc/testsuite/gfortran.dg/unformatted_subrecord_1.f90 b/gcc/testsuite/gfortran.dg/unformatted_subrecord_1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5812a8eaaf569a4f5bd9846e57db7be0278f06cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unformatted_subrecord_1.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! { dg-options "-fmax-subrecord-length=16" }
+! Test Intel record markers with 16-byte subrecord sizes.
+program main
+ implicit none
+ integer, dimension(20) :: n
+ integer, dimension(30) :: m
+ integer :: i
+ real :: r
+ integer :: k
+ ! Maximum subrecord length is 16 here, or the test will fail.
+ open (10, file="f10.dat", &
+ form="unformatted", access="sequential")
+ n = (/ (i**2, i=1, 20) /)
+ write (10) n
+ close (10)
+ ! Read back the file, including record markers.
+ open (10, file="f10.dat", form="unformatted", access="stream")
+ read (10) m
+ if (any(m .ne. (/ -16, 1, 4, 9, 16, 16, -16, 25, 36, 49, 64, &
+ -16, -16, 81, 100, 121, 144, -16, -16, 169, 196, 225, &
+ 256, -16, 16, 289, 324, 361, 400, -16 /))) call abort
+ close (10)
+ open (10, file="f10.dat", form="unformatted", &
+ access="sequential")
+ m = 42
+ read (10) m(1:5)
+ if (any(m(1:5) .ne. (/ 1, 4, 9, 16, 25 /))) call abort
+ if (any(m(6:30) .ne. 42)) call abort
+ backspace 10
+ n = 0
+ read (10) n(1:5)
+ if (any(n(1:5) .ne. (/ 1, 4, 9, 16, 25 /))) call abort
+ if (any(n(6:20) .ne. 0)) call abort
+ ! Append to the end of the file
+ write (10) 3.14
+ ! Test multiple backspace statements
+ backspace 10
+ backspace 10
+ read (10) k
+ if (k .ne. 1) call abort
+ read (10) r
+ if (abs(r-3.14) .gt. 1e-7) call abort
+ close (10, status="delete")
+end program main
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 97e7f3a2c2bdb6efac546d77e989c12b66a6a34c..ca823924d0b0fb4abb654f34c08ebe88966c81ec 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,46 @@
+2006-12-01 Thomas Koenig <Thomas.Koenig@online.de>
+
+ PR libfortran/29568
+ * libgfortran/libgfortran.h (compile_options_t): Add
+ record_marker. (top level): Define GFC_MAX_SUBRECORD_LENGTH.
+ * runtime/compile_options.c (set_record_marker): Change
+ default to four-byte record marker.
+ (set_max_subrecord_length): New function.
+ * runtime/error.c (translate_error): Change error message
+ for short record on unformatted read.
+ * io/io.h (gfc_unit): Add recl_subrecord, bytes_left_subrecord
+ and continued.
+ * io/file_pos.c (unformatted_backspace): Change default of record
+ marker size to four bytes. Loop over subrecords.
+ * io/open.c: Default recl is max_offset. If
+ compile_options.max_subrecord_length has been set, set set
+ u->recl_subrecord to its value, to the maximum value otherwise.
+ * io/transfer.c (top level): Add prototypes for us_read, us_write,
+ next_record_r_unf and next_record_w_unf.
+ (read_block_direct): Separate codepaths for unformatted direct
+ and unformatted sequential. If a recl has been set by the
+ user, use the number of bytes left for the record if it is smaller
+ than the read request. Loop over subrecords. Set an error if the
+ user has set a recl and the read was short.
+ (write_buf): Separate codepaths for unformatted direct and
+ unformatted sequential. If a recl has been set by the
+ user, use the number of bytes left for the record if it is smaller
+ than the read request. Loop over subrecords. Set an error if the
+ user has set a recl and the read was short.
+ (us_read): Add parameter continued (to indicate that bytes_left
+ should not be intialized). Change default of record marker size
+ to four bytes. Use subrecord. If the subrecord length is smaller than
+ zero, this indicates a continuation.
+ (us_write): Add parameter continued (to indicate that the continued
+ flag should be set). Use subrecord.
+ (pre_position): Use 0 for continued on us_write and us_read calls.
+ (skip_record): New function.
+ (next_record_r_unf): New function.
+ (next_record_r): Use next_record_r_unf.
+ (write_us_marker): Default size for record markers is four bytes.
+ (next_record_w_unf): New function.
+ (next_record_w): Use next_record_w_unf.
+
2006-11-25 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* Makefile.am: Remove intrinsics/erf.c and intrinsics/bessel.c.
diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 979dec55513b7395bbdc386a73919ea3839d56dc..df722e4cbc795f5bd91e90ca89e12c1482c26486 100644
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -98,7 +98,7 @@ formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
/* unformatted_backspace(fpp) -- Move the file backwards for an unformatted
sequential file. We are guaranteed to be between records on entry and
- we have to shift to the previous record. */
+ we have to shift to the previous record. Loop over subrecords. */
static void
unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
@@ -107,74 +107,74 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
GFC_INTEGER_4 m4;
GFC_INTEGER_8 m8;
int length, length_read;
+ int continued;
char *p;
if (compile_options.record_marker == 0)
- length = sizeof (gfc_offset);
+ length = sizeof (GFC_INTEGER_4);
else
length = compile_options.record_marker;
- length_read = length;
+ do
+ {
+ length_read = length;
- p = salloc_r_at (u->s, &length_read,
- file_position (u->s) - length);
- if (p == NULL || length_read != length)
- goto io_error;
+ p = salloc_r_at (u->s, &length_read,
+ file_position (u->s) - length);
+ if (p == NULL || length_read != length)
+ goto io_error;
- /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
- if (u->flags.convert == CONVERT_NATIVE)
- {
- switch (compile_options.record_marker)
+ /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
+ if (u->flags.convert == CONVERT_NATIVE)
{
- case 0:
- memcpy (&m, p, sizeof(gfc_offset));
- break;
-
- case sizeof(GFC_INTEGER_4):
- memcpy (&m4, p, sizeof (m4));
- m = m4;
- break;
-
- case sizeof(GFC_INTEGER_8):
- memcpy (&m8, p, sizeof (m8));
- m = m8;
- break;
-
- default:
- runtime_error ("Illegal value for record marker");
- break;
+ switch (length)
+ {
+ case sizeof(GFC_INTEGER_4):
+ memcpy (&m4, p, sizeof (m4));
+ m = m4;
+ break;
+
+ case sizeof(GFC_INTEGER_8):
+ memcpy (&m8, p, sizeof (m8));
+ m = m8;
+ break;
+
+ default:
+ runtime_error ("Illegal value for record marker");
+ break;
+ }
}
- }
- else
- {
- switch (compile_options.record_marker)
+ else
{
- case 0:
- reverse_memcpy (&m, p, sizeof(gfc_offset));
- break;
-
- case sizeof(GFC_INTEGER_4):
- reverse_memcpy (&m4, p, sizeof (m4));
- m = m4;
- break;
-
- case sizeof(GFC_INTEGER_8):
- reverse_memcpy (&m8, p, sizeof (m8));
- m = m8;
- break;
-
- default:
- runtime_error ("Illegal value for record marker");
- break;
+ switch (length)
+ {
+ case sizeof(GFC_INTEGER_4):
+ reverse_memcpy (&m4, p, sizeof (m4));
+ m = m4;
+ break;
+
+ case sizeof(GFC_INTEGER_8):
+ reverse_memcpy (&m8, p, sizeof (m8));
+ m = m8;
+ break;
+
+ default:
+ runtime_error ("Illegal value for record marker");
+ break;
+ }
+
}
- }
+ continued = m < 0;
+ if (continued)
+ m = -m;
- if ((new = file_position (u->s) - m - 2*length) < 0)
- new = 0;
+ if ((new = file_position (u->s) - m - 2*length) < 0)
+ new = 0;
- if (sseek (u->s, new) == FAILURE)
- goto io_error;
+ if (sseek (u->s, new) == FAILURE)
+ goto io_error;
+ } while (continued);
u->last_record--;
return;
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index e8e8390d1c54bf732c9f167bf93c7744a1ac1fc5..4d227dd3b8c80fd10f6464ed6a366daa13001c8e 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -499,12 +499,19 @@ typedef struct gfc_unit
unit_mode mode;
unit_flags flags;
- /* 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.
- strm_pos -- Current position in file for STREAM I/O. */
- gfc_offset recl, last_record, maxrec, bytes_left, strm_pos;
+ /* 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.
+ strm_pos -- Current position in file for STREAM I/O.
+ recl_subrecord -- Maximum length for subrecord.
+ bytes_left_subrecord -- Bytes left in current subrecord. */
+ gfc_offset recl, last_record, maxrec, bytes_left, strm_pos,
+ recl_subrecord, bytes_left_subrecord;
+
+ /* Set to 1 if we have read a subrecord. */
+
+ int continued;
__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 9b4f0cd7122d440dfae0482febec754def8b2447..06fba75e1df0af11eeba2e4c05ecde57aa2226bc 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -413,23 +413,29 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
else
{
u->flags.has_recl = 0;
- switch (compile_options.record_marker)
+ u->recl = max_offset;
+ if (compile_options.max_subrecord_length)
{
- case 0:
- u->recl = max_offset;
- break;
-
- case sizeof (GFC_INTEGER_4):
- u->recl = GFC_INTEGER_4_HUGE;
- break;
-
- case sizeof (GFC_INTEGER_8):
- u->recl = max_offset;
- break;
-
- default:
- runtime_error ("Illegal value for record marker");
- break;
+ u->recl_subrecord = compile_options.max_subrecord_length;
+ }
+ else
+ {
+ switch (compile_options.record_marker)
+ {
+ case 0:
+ /* Fall through */
+ case sizeof (GFC_INTEGER_4):
+ u->recl_subrecord = GFC_MAX_SUBRECORD_LENGTH;
+ break;
+
+ case sizeof (GFC_INTEGER_8):
+ u->recl_subrecord = max_offset - 16;
+ break;
+
+ default:
+ runtime_error ("Illegal value for record marker");
+ break;
+ }
}
}
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 329d49828d4ea9a65330a72629870a519ce77a89..4270d61e693cb01410bafd6645330317e3a79f45 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -82,6 +82,11 @@ extern void transfer_array (st_parameter_dt *, gfc_array_char *, int,
gfc_charlen_type);
export_proto(transfer_array);
+static void us_read (st_parameter_dt *, int);
+static void us_write (st_parameter_dt *, int);
+static void next_record_r_unf (st_parameter_dt *, int);
+static void next_record_w_unf (st_parameter_dt *, int);
+
static const st_option advance_opt[] = {
{"yes", ADVANCE_YES},
{"no", ADVANCE_NO},
@@ -336,12 +341,16 @@ read_block (st_parameter_dt *dtp, int *length)
}
-/* Reads a block directly into application data space. */
+/* Reads a block directly into application data space. This is for
+ unformatted files. */
static void
read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
{
- size_t nread;
+ size_t to_read_record;
+ size_t have_read_record;
+ size_t to_read_subrecord;
+ size_t have_read_subrecord;
int short_record;
if (is_stream_io (dtp))
@@ -353,62 +362,169 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
return;
}
- nread = *nbytes;
- if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
+ to_read_record = *nbytes;
+ have_read_record = to_read_record;
+ if (sread (dtp->u.p.current_unit->s, buf, &have_read_record) != 0)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return;
}
- 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);
+ dtp->u.p.current_unit->strm_pos += (gfc_offset) have_read_record;
+ if (to_read_record != have_read_record)
+ {
+ /* Short read, e.g. if we hit EOF. */
+ generate_error (&dtp->common, ERROR_END, NULL);
+ return;
+ }
return;
}
- /* Unformatted file with records */
- if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
+ if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
{
- short_record = 1;
- nread = (size_t) dtp->u.p.current_unit->bytes_left;
- *nbytes = nread;
+ if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
+ {
+ short_record = 1;
+ to_read_record = (size_t) dtp->u.p.current_unit->bytes_left;
+ *nbytes = to_read_record;
- if (dtp->u.p.current_unit->bytes_left == 0)
+ 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;
+ }
+ }
+
+ else
+ {
+ short_record = 0;
+ to_read_record = *nbytes;
+ }
+
+ dtp->u.p.current_unit->bytes_left -= to_read_record;
+
+ if (sread (dtp->u.p.current_unit->s, buf, &to_read_record) != 0)
+ {
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return;
+ }
+
+ if (to_read_record != *nbytes) /* Short read, e.g. if we hit EOF. */
{
- dtp->u.p.current_unit->endfile = AT_ENDFILE;
+ *nbytes = to_read_record;
generate_error (&dtp->common, ERROR_END, NULL);
return;
}
+
+ if (short_record)
+ {
+ generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
+ return;
+ }
+ return;
}
+ /* Unformatted sequential. We loop over the subrecords, reading
+ until the request has been fulfilled or the record has run out
+ of continuation subrecords. */
+
+ /* Check whether we exceed the total record length. */
+
+ if (dtp->u.p.current_unit->flags.has_recl)
+ {
+ to_read_record =
+ *nbytes > (size_t) dtp->u.p.current_unit->bytes_left ?
+ *nbytes : (size_t) dtp->u.p.current_unit->bytes_left;
+ short_record = 1;
+ }
else
{
+ to_read_record = *nbytes;
short_record = 0;
- nread = *nbytes;
}
+ have_read_record = 0;
- dtp->u.p.current_unit->bytes_left -= nread;
-
- if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
+ while(1)
{
- generate_error (&dtp->common, ERROR_OS, NULL);
- return;
- }
+ if (dtp->u.p.current_unit->bytes_left_subrecord
+ < (gfc_offset) to_read_record)
+ {
+ to_read_subrecord = (size_t) dtp->u.p.current_unit->bytes_left_subrecord;
+ to_read_record -= to_read_subrecord;
- if (nread != *nbytes) /* Short read, e.g. if we hit EOF. */
- {
- *nbytes = nread;
- generate_error (&dtp->common, ERROR_END, NULL);
- return;
+ if (dtp->u.p.current_unit->bytes_left_subrecord == 0)
+ {
+ if (dtp->u.p.current_unit->continued)
+ {
+ /* Skip to the next subrecord */
+ next_record_r_unf (dtp, 0);
+ us_read (dtp, 1);
+ continue;
+ }
+ else
+ {
+ dtp->u.p.current_unit->endfile = AT_ENDFILE;
+ generate_error (&dtp->common, ERROR_END, NULL);
+ return;
+ }
+ }
+ }
+
+ else
+ {
+ to_read_subrecord = to_read_record;
+ to_read_record = 0;
+ }
+
+ dtp->u.p.current_unit->bytes_left_subrecord -= to_read_subrecord;
+
+ have_read_subrecord = to_read_subrecord;
+ if (sread (dtp->u.p.current_unit->s, buf + have_read_record,
+ &have_read_subrecord) != 0)
+ {
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return;
+ }
+
+ have_read_record += have_read_subrecord;
+
+ if (to_read_subrecord != have_read_subrecord) /* Short read,
+ e.g. if we hit EOF. */
+ {
+ *nbytes = have_read_record;
+ generate_error (&dtp->common, ERROR_END, NULL);
+ return;
+ }
+
+ if (to_read_record > 0)
+ {
+ if (dtp->u.p.current_unit->continued)
+ {
+ next_record_r_unf (dtp, 0);
+ us_read (dtp, 1);
+ }
+ else
+ {
+ generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
+ return;
+ }
+ }
+ else
+ {
+ /* Normal exit, the read request has been fulfilled. */
+ break;
+ }
}
+ dtp->u.p.current_unit->bytes_left -= have_read_record;
if (short_record)
{
generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
return;
}
+ return;
}
@@ -471,11 +587,20 @@ write_block (st_parameter_dt *dtp, int length)
}
-/* High level interface to swrite(), taking care of errors. */
+/* High level interface to swrite(), taking care of errors. This is only
+ called for unformatted files. There are three cases to consider:
+ Stream I/O, unformatted direct, unformatted sequential. */
static try
write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
{
+
+ size_t have_written, to_write_subrecord;
+ int short_record;
+
+
+ /* Stream I/O. */
+
if (is_stream_io (dtp))
{
if (sseek (dtp->u.p.current_unit->s,
@@ -484,42 +609,88 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
generate_error (&dtp->common, ERROR_OS, NULL);
return FAILURE;
}
+
+ if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
+ {
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return FAILURE;
+ }
+
+ dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes;
+
+ return SUCCESS;
}
- else
+
+ /* Unformatted direct access. */
+
+ if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
{
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes)
{
- /* 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->flags.access == ACCESS_DIRECT)
- generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
- else
- generate_error (&dtp->common, ERROR_EOR, NULL);
- return FAILURE;
- }
+ generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
+ return FAILURE;
+ }
+
+ if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
+ {
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return FAILURE;
}
- dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
+ dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes;
+
+ return SUCCESS;
+
}
- if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
+ /* Unformatted sequential. */
+
+ have_written = 0;
+
+ if (dtp->u.p.current_unit->flags.has_recl
+ && (gfc_offset) nbytes > dtp->u.p.current_unit->bytes_left)
{
- generate_error (&dtp->common, ERROR_OS, NULL);
- return FAILURE;
+ nbytes = dtp->u.p.current_unit->bytes_left;
+ short_record = 1;
+ }
+ else
+ {
+ short_record = 0;
}
- if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- dtp->u.p.size_used += (gfc_offset) nbytes;
+ while (1)
+ {
+
+ to_write_subrecord =
+ (size_t) dtp->u.p.current_unit->bytes_left_subrecord < nbytes ?
+ (size_t) dtp->u.p.current_unit->bytes_left_subrecord : nbytes;
+
+ dtp->u.p.current_unit->bytes_left_subrecord -=
+ (gfc_offset) to_write_subrecord;
- dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes;
+ if (swrite (dtp->u.p.current_unit->s, buf + have_written,
+ &to_write_subrecord) != 0)
+ {
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return FAILURE;
+ }
+
+ dtp->u.p.current_unit->strm_pos += (gfc_offset) to_write_subrecord;
+ nbytes -= to_write_subrecord;
+ have_written += to_write_subrecord;
+ if (nbytes == 0)
+ break;
+
+ next_record_w_unf (dtp, 1);
+ us_write (dtp, 1);
+ }
+ dtp->u.p.current_unit->bytes_left -= have_written;
+ if (short_record)
+ {
+ generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
+ return FAILURE;
+ }
return SUCCESS;
}
@@ -1357,7 +1528,7 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
/* Preposition a sequential unformatted file while reading. */
static void
-us_read (st_parameter_dt *dtp)
+us_read (st_parameter_dt *dtp, int continued)
{
char *p;
int n;
@@ -1370,7 +1541,7 @@ us_read (st_parameter_dt *dtp)
return;
if (compile_options.record_marker == 0)
- n = sizeof (gfc_offset);
+ n = sizeof (GFC_INTEGER_4);
else
n = compile_options.record_marker;
@@ -1393,12 +1564,8 @@ us_read (st_parameter_dt *dtp)
/* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
{
- switch (compile_options.record_marker)
+ switch (nr)
{
- case 0:
- memcpy (&i, p, sizeof(gfc_offset));
- break;
-
case sizeof(GFC_INTEGER_4):
memcpy (&i4, p, sizeof (i4));
i = i4;
@@ -1415,12 +1582,8 @@ us_read (st_parameter_dt *dtp)
}
}
else
- switch (compile_options.record_marker)
+ switch (nr)
{
- case 0:
- reverse_memcpy (&i, p, sizeof(gfc_offset));
- break;
-
case sizeof(GFC_INTEGER_4):
reverse_memcpy (&i4, p, sizeof (i4));
i = i4;
@@ -1436,7 +1599,19 @@ us_read (st_parameter_dt *dtp)
break;
}
- dtp->u.p.current_unit->bytes_left = i;
+ if (i >= 0)
+ {
+ dtp->u.p.current_unit->bytes_left_subrecord = i;
+ dtp->u.p.current_unit->continued = 0;
+ }
+ else
+ {
+ dtp->u.p.current_unit->bytes_left_subrecord = -i;
+ dtp->u.p.current_unit->continued = 1;
+ }
+
+ if (! continued)
+ dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
}
@@ -1444,7 +1619,7 @@ us_read (st_parameter_dt *dtp)
amount to writing a bogus length that will be filled in later. */
static void
-us_write (st_parameter_dt *dtp)
+us_write (st_parameter_dt *dtp, int continued)
{
size_t nbytes;
gfc_offset dummy;
@@ -1452,7 +1627,7 @@ us_write (st_parameter_dt *dtp)
dummy = 0;
if (compile_options.record_marker == 0)
- nbytes = sizeof (gfc_offset);
+ nbytes = sizeof (GFC_INTEGER_4);
else
nbytes = compile_options.record_marker ;
@@ -1460,12 +1635,12 @@ us_write (st_parameter_dt *dtp)
generate_error (&dtp->common, ERROR_OS, NULL);
/* For sequential unformatted, if RECL= was not specified in the OPEN
- we write until we have more bytes than can fit in the record markers.
- If disk space runs out first, it will error on the write. */
- if (dtp->u.p.current_unit->flags.has_recl == 0)
- dtp->u.p.current_unit->recl = max_offset;
+ we write until we have more bytes than can fit in the subrecord
+ markers, then we write a new subrecord. */
- dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
+ dtp->u.p.current_unit->bytes_left_subrecord =
+ dtp->u.p.current_unit->recl_subrecord;
+ dtp->u.p.current_unit->continued = continued;
}
@@ -1491,9 +1666,9 @@ pre_position (st_parameter_dt *dtp)
case UNFORMATTED_SEQUENTIAL:
if (dtp->u.p.mode == READING)
- us_read (dtp);
+ us_read (dtp, 0);
else
- us_write (dtp);
+ us_write (dtp, 0);
break;
@@ -1886,17 +2061,92 @@ next_array_record (st_parameter_dt *dtp, array_loop_spec *ls)
return index;
}
-/* Space to the next record for read mode. If the file is not
- seekable, we read MAX_READ chunks until we get to the right
+
+
+/* Skip to the end of the current record, taking care of an optional
+ record marker of size bytes. If the file is not seekable, we
+ read chunks of size MAX_READ until we get to the right
position. */
#define MAX_READ 4096
+static void
+skip_record (st_parameter_dt *dtp, size_t bytes)
+{
+ gfc_offset new;
+ int rlength, length;
+ char *p;
+
+ dtp->u.p.current_unit->bytes_left_subrecord += bytes;
+ if (dtp->u.p.current_unit->bytes_left_subrecord == 0)
+ return;
+
+ if (is_seekable (dtp->u.p.current_unit->s))
+ {
+ new = file_position (dtp->u.p.current_unit->s)
+ + dtp->u.p.current_unit->bytes_left_subrecord;
+
+ /* Direct access files do not generate END conditions,
+ only I/O errors. */
+ if (sseek (dtp->u.p.current_unit->s, new) == FAILURE)
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ }
+ else
+ { /* Seek by reading data. */
+ while (dtp->u.p.current_unit->bytes_left_subrecord > 0)
+ {
+ rlength = length =
+ (MAX_READ > dtp->u.p.current_unit->bytes_left_subrecord) ?
+ MAX_READ : dtp->u.p.current_unit->bytes_left_subrecord;
+
+ p = salloc_r (dtp->u.p.current_unit->s, &rlength);
+ if (p == NULL)
+ {
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return;
+ }
+
+ dtp->u.p.current_unit->bytes_left_subrecord -= length;
+ }
+ }
+
+}
+
+#undef MAX_READ
+
+/* Advance to the next record reading unformatted files, taking
+ care of subrecords. If complete_record is nonzero, we loop
+ until all subrecords are cleared. */
+
+static void
+next_record_r_unf (st_parameter_dt *dtp, int complete_record)
+{
+ size_t bytes;
+
+ bytes = compile_options.record_marker == 0 ?
+ sizeof (GFC_INTEGER_4) : compile_options.record_marker;
+
+ while(1)
+ {
+
+ /* Skip over tail */
+
+ skip_record (dtp, bytes);
+
+ if ( ! (complete_record && dtp->u.p.current_unit->continued))
+ return;
+
+ us_read (dtp, 1);
+ }
+}
+
+/* Space to the next record for read mode. */
+
static void
next_record_r (st_parameter_dt *dtp)
{
- gfc_offset new, record;
- int bytes_left, rlength, length;
+ gfc_offset record;
+ int length, bytes_left;
char *p;
switch (current_mode (dtp))
@@ -1906,47 +2156,12 @@ next_record_r (st_parameter_dt *dtp)
return;
case UNFORMATTED_SEQUENTIAL:
-
- /* Skip over tail */
- dtp->u.p.current_unit->bytes_left +=
- compile_options.record_marker == 0 ?
- sizeof (gfc_offset) : compile_options.record_marker;
-
- /* Fall through... */
+ next_record_r_unf (dtp, 1);
+ break;
case FORMATTED_DIRECT:
case UNFORMATTED_DIRECT:
- if (dtp->u.p.current_unit->bytes_left == 0)
- break;
-
- if (is_seekable (dtp->u.p.current_unit->s))
- {
- new = file_position (dtp->u.p.current_unit->s)
- + dtp->u.p.current_unit->bytes_left;
-
- /* Direct access files do not generate END conditions,
- only I/O errors. */
- if (sseek (dtp->u.p.current_unit->s, new) == FAILURE)
- generate_error (&dtp->common, ERROR_OS, NULL);
-
- }
- else
- { /* Seek by reading data. */
- while (dtp->u.p.current_unit->bytes_left > 0)
- {
- rlength = length = (MAX_READ > dtp->u.p.current_unit->bytes_left) ?
- MAX_READ : dtp->u.p.current_unit->bytes_left;
-
- p = salloc_r (dtp->u.p.current_unit->s, &rlength);
- if (p == NULL)
- {
- generate_error (&dtp->common, ERROR_OS, NULL);
- break;
- }
-
- dtp->u.p.current_unit->bytes_left -= length;
- }
- }
+ skip_record (dtp, 0);
break;
case FORMATTED_STREAM:
@@ -2025,19 +2240,15 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
char p[sizeof (GFC_INTEGER_8)];
if (compile_options.record_marker == 0)
- len = sizeof (gfc_offset);
+ len = sizeof (GFC_INTEGER_4);
else
len = compile_options.record_marker;
/* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
{
- switch (compile_options.record_marker)
+ switch (len)
{
- case 0:
- return swrite (dtp->u.p.current_unit->s, &buf, &len);
- break;
-
case sizeof (GFC_INTEGER_4):
buf4 = buf;
return swrite (dtp->u.p.current_unit->s, &buf4, &len);
@@ -2055,13 +2266,8 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
}
else
{
- switch (compile_options.record_marker)
+ switch (len)
{
- case 0:
- reverse_memcpy (p, &buf, sizeof (gfc_offset));
- return swrite (dtp->u.p.current_unit->s, p, &len);
- break;
-
case sizeof (GFC_INTEGER_4):
buf4 = buf;
reverse_memcpy (p, &buf4, sizeof (GFC_INTEGER_4));
@@ -2070,7 +2276,7 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
case sizeof (GFC_INTEGER_8):
buf8 = buf;
- reverse_memcpy (p, &buf8, sizeof (GFC_INTEGER_4));
+ reverse_memcpy (p, &buf8, sizeof (GFC_INTEGER_8));
return swrite (dtp->u.p.current_unit->s, p, &len);
break;
@@ -2082,16 +2288,72 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
}
+/* Position to the next (sub)record in write mode for
+ unformatted sequential files. */
+
+static void
+next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
+{
+ gfc_offset c, m, m_write;
+ size_t record_marker;
+
+ /* Bytes written. */
+ m = dtp->u.p.current_unit->recl_subrecord
+ - dtp->u.p.current_unit->bytes_left_subrecord;
+ c = file_position (dtp->u.p.current_unit->s);
+
+ /* Write the length tail. If we finish a record containing
+ subrecords, we write out the negative length. */
+
+ if (dtp->u.p.current_unit->continued)
+ m_write = -m;
+ else
+ m_write = m;
+
+ if (write_us_marker (dtp, m_write) != 0)
+ goto io_error;
+
+ if (compile_options.record_marker == 0)
+ record_marker = sizeof (GFC_INTEGER_4);
+ else
+ record_marker = compile_options.record_marker;
+
+ /* Seek to the head and overwrite the bogus length with the real
+ length. */
+
+ if (sseek (dtp->u.p.current_unit->s, c - m - record_marker)
+ == FAILURE)
+ goto io_error;
+
+ if (next_subrecord)
+ m_write = -m;
+ else
+ m_write = m;
+
+ if (write_us_marker (dtp, m_write) != 0)
+ goto io_error;
+
+ /* Seek past the end of the current record. */
+
+ if (sseek (dtp->u.p.current_unit->s, c + record_marker) == FAILURE)
+ goto io_error;
+
+ return;
+
+ io_error:
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return;
+
+}
/* Position to the next record in write mode. */
static void
next_record_w (st_parameter_dt *dtp, int done)
{
- gfc_offset c, m, record, max_pos;
+ gfc_offset m, record, max_pos;
int length;
char *p;
- size_t record_marker;
/* Zero counters for X- and T-editing. */
max_pos = dtp->u.p.max_pos;
@@ -2119,35 +2381,7 @@ next_record_w (st_parameter_dt *dtp, int done)
break;
case UNFORMATTED_SEQUENTIAL:
- /* Bytes written. */
- m = dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left;
- c = file_position (dtp->u.p.current_unit->s);
-
- /* Write the length tail. */
-
- if (write_us_marker (dtp, m) != 0)
- goto io_error;
-
- if (compile_options.record_marker == 4)
- record_marker = sizeof(GFC_INTEGER_4);
- else
- record_marker = sizeof (gfc_offset);
-
- /* Seek to the head and overwrite the bogus length with the real
- length. */
-
- if (sseek (dtp->u.p.current_unit->s, c - m - record_marker)
- == FAILURE)
- goto io_error;
-
- if (write_us_marker (dtp, m) != 0)
- goto io_error;
-
- /* Seek past the end of the current record. */
-
- if (sseek (dtp->u.p.current_unit->s, c + record_marker) == FAILURE)
- goto io_error;
-
+ next_record_w_unf (dtp, 0);
break;
case FORMATTED_STREAM:
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index ff947655806e589bf2dc7e5025fc9aa65926a69e..644a0adc7844557bfaaf50d283d58948c9ef38c3 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -370,6 +370,7 @@ typedef struct
int pedantic;
int convert;
size_t record_marker;
+ int max_subrecord_length;
}
compile_options_t;
@@ -379,6 +380,7 @@ internal_proto(compile_options);
extern void init_compile_options (void);
internal_proto(init_compile_options);
+#define GFC_MAX_SUBRECORD_LENGTH 2147483639 /* 2**31 - 9 */
/* Structure for statement options. */
diff --git a/libgfortran/runtime/compile_options.c b/libgfortran/runtime/compile_options.c
index fb6ac509f135b9125a0152e6a8b990e2726f20cd..b2aef05a832ee40dcd8eff6d9fea5fda437b578d 100644
--- a/libgfortran/runtime/compile_options.c
+++ b/libgfortran/runtime/compile_options.c
@@ -86,13 +86,11 @@ set_record_marker (int val)
switch(val)
{
case 4:
- if (sizeof (GFC_INTEGER_4) != sizeof (gfc_offset))
- compile_options.record_marker = sizeof (GFC_INTEGER_4);
+ compile_options.record_marker = sizeof (GFC_INTEGER_4);
break;
case 8:
- if (sizeof (GFC_INTEGER_8) != sizeof (gfc_offset))
- compile_options.record_marker = sizeof (GFC_INTEGER_8);
+ compile_options.record_marker = sizeof (GFC_INTEGER_8);
break;
default:
@@ -100,3 +98,17 @@ set_record_marker (int val)
break;
}
}
+
+extern void set_max_subrecord_length (int);
+export_proto (set_max_subrecord_length);
+
+void set_max_subrecord_length(int val)
+{
+ if (val > GFC_MAX_SUBRECORD_LENGTH || val < 1)
+ {
+ runtime_error ("Invalid value for maximum subrecord length");
+ return;
+ }
+
+ compile_options.max_subrecord_length = val;
+}
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 3f03f03f5004f93c61d2683254b4c34482208d1c..122f6d14bab426f596b4a45b5ae37441fbd52e0d 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -437,7 +437,7 @@ translate_error (int code)
break;
case ERROR_SHORT_RECORD:
- p = "Short record on unformatted read";
+ p = "I/O past end of record on unformatted file";
break;
default: