From 67c24a8bd6141021da49e005c0111bd42bfc7d08 Mon Sep 17 00:00:00 2001 From: Janne Blomqvist Date: Tue, 28 Nov 2017 21:28:50 +0200 Subject: [PATCH] PR 53796 Improve INQUIRE(RECL=...) handling The current F2018 draft (N2137) specifies behavior of the RECL= specifier in the INQUIRE statement, where it previously was left as undefined. Namely: - If the unit is not connected, RECL= should be given the value -1. - If the unit is connected with stream access, RECL= should be given the value -2. Further, as PR 53796 describes, the handling of RECL= is poor in other ways as well. When the recl is set to the maximum possible (GFC_INTEGER_8_HUGE / LLONG_MAX), which it does by default except for preconnected units, and when INQUIRE(RECL=) is used with a 4 byte integer, the value is truncated and the 4 byte value is thus -1. Fixing this to generate an error is a lot of work, as currently the truncation is done by the frontend, the library sees only an 8 byte value with no indication that the frontend is going to copy it to a 4 byte one. Instead, this patch does a bit twiddling trick such that the truncated 4 byte value is GFC_INTEGER_4_HUGE while still being 0.99999999 * GFC_INTEGER_8_HUGE which is large enough for all practical purposes. Finally, the patch removes GFORTRAN_DEFAULT_RECL which was used only for preconnected units, and instead uses the same approach as describe above. Regtested on x86_64-pc-linux-gnu, Ok for trunk. gcc/fortran/ChangeLog: 2017-11-28 Janne Blomqvist PR fortran/53796 * gfortran.texi: Remove mentions of GFORTRAN_DEFAULT_RECL. libgfortran/ChangeLog: 2017-11-28 Janne Blomqvist PR fortran/53796 * io/inquire.c (inquire_via_unit): Set recl to -1 for unconnected units. * io/io.h (default_recl): New variable. * io/open.c (new_unit): Set recl to default_recl for sequential, -2 for stream access. * io/transfer.c (read_block_form): Test against default_recl instead of DEFAULT_RECL. (write_block): Likewise. * io/unit.c (init_units): Calculate max_offset, default_recl. * libgfortran.h (DEFAULT_RECL): Remove. * runtime/environ.c: Remove GFORTRAN_DEFAULT_RECL. gcc/testsuite/ChangeLog: 2017-11-28 Janne Blomqvist PR fortran/53796 * gfortran.dg/inquire_recl_f2018.f90: New test. From-SVN: r255215 --- gcc/fortran/ChangeLog | 5 +++ gcc/fortran/gfortran.texi | 9 ---- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/inquire_recl_f2018.f90 | 42 +++++++++++++++++++ libgfortran/io/inquire.c | 4 +- libgfortran/io/io.h | 5 +++ libgfortran/io/open.c | 6 ++- libgfortran/io/transfer.c | 4 +- libgfortran/io/unit.c | 33 ++++++++++----- libgfortran/libgfortran.h | 8 +--- libgfortran/runtime/environ.c | 4 -- 11 files changed, 89 insertions(+), 36 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/inquire_recl_f2018.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 91c57e0d43d..fc971583686 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2017-11-28 Janne Blomqvist + + PR fortran/53796 + * gfortran.texi: Remove mentions of GFORTRAN_DEFAULT_RECL. + 2017-11-28 Paul Thomas PR fortran/83021 diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 4b4688cd0a2..36c7b942355 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -600,7 +600,6 @@ Malformed environment variables are silently ignored. * GFORTRAN_UNBUFFERED_PRECONNECTED:: Do not buffer I/O for preconnected units. * GFORTRAN_SHOW_LOCUS:: Show location for runtime errors * GFORTRAN_OPTIONAL_PLUS:: Print leading + where permitted -* GFORTRAN_DEFAULT_RECL:: Default record length for new files * GFORTRAN_LIST_SEPARATOR:: Separator for list output * GFORTRAN_CONVERT_UNIT:: Set endianness for unformatted I/O * GFORTRAN_ERROR_BACKTRACE:: Show backtrace on run-time errors @@ -683,14 +682,6 @@ where permitted by the Fortran standard. If the first letter is @samp{n}, @samp{N} or @samp{0}, a plus sign is not printed in most cases. Default is not to print plus signs. -@node GFORTRAN_DEFAULT_RECL -@section @env{GFORTRAN_DEFAULT_RECL}---Default record length for new files - -This environment variable specifies the default record length, in -bytes, for files which are opened without a @code{RECL} tag in the -@code{OPEN} statement. This must be a positive integer. The -default value is 1073741824 bytes (1 GB). - @node GFORTRAN_LIST_SEPARATOR @section @env{GFORTRAN_LIST_SEPARATOR}---Separator for list output diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 67c1f272e62..e0e027b7653 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-11-28 Janne Blomqvist + + PR fortran/53796 + * gfortran.dg/inquire_recl_f2018.f90: New test. + 2017-11-28 Prathamesh Kulkarni Martin Jambor diff --git a/gcc/testsuite/gfortran.dg/inquire_recl_f2018.f90 b/gcc/testsuite/gfortran.dg/inquire_recl_f2018.f90 new file mode 100644 index 00000000000..8a1334029fc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/inquire_recl_f2018.f90 @@ -0,0 +1,42 @@ +! { dg-do run } +! PR 53796 INQUIRE(RECL=...) +program inqrecl + implicit none + integer(8) :: r + integer :: r4 + ! F2018 (N2137) 12.10.2.26: recl for unconnected should be -1 + inquire(10, recl=r) + if (r /= -1) then + call abort() + end if + + ! Formatted sequential + open(10, status="scratch") + inquire(10, recl=r) + inquire(10, recl=r4) + close(10) + if (r /= huge(0_8) - huge(0_4) - 1) then + call abort() + end if + if (r4 /= huge(0)) then + call abort() + end if + + ! Formatted sequential with recl= specifier + open(10, status="scratch", recl=100) + inquire(10, recl=r) + close(10) + if (r /= 100) then + call abort() + end if + + ! Formatted stream + ! F2018 (N2137) 12.10.2.26: If unit is connected + ! for stream access, recl should be assigned the value -2. + open(10, status="scratch", access="stream") + inquire(10, recl=r) + close(10) + if (r /= -2) then + call abort() + end if +end program inqrecl diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c index fe353c55314..848a08f6157 100644 --- a/libgfortran/io/inquire.c +++ b/libgfortran/io/inquire.c @@ -218,7 +218,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; + /* F2018 (N2137) 12.10.2.26: If there is no connection, recl is + assigned the value -1. */ + *iqp->recl_out = (u != NULL) ? u->recl : -1; if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0) *iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0; diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 50db35e1cff..fd48bf19e9b 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -735,6 +735,11 @@ gfc_saved_unit; extern gfc_offset max_offset; internal_proto(max_offset); +/* Default RECL for sequential access if not given in OPEN statement, + computed at library initialization time. */ +extern gfc_offset default_recl; +internal_proto(default_recl); + /* Unit tree root. */ extern gfc_unit *unit_root; internal_proto(unit_root); diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index fab20653c77..05e1773c841 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -586,7 +586,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags *flags) else { u->flags.has_recl = 0; - u->recl = max_offset; + u->recl = default_recl; if (compile_options.max_subrecord_length) { u->recl_subrecord = compile_options.max_subrecord_length; @@ -622,7 +622,9 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags *flags) if (flags->access == ACCESS_STREAM) { u->maxrec = max_offset; - u->recl = 1; + /* F2018 (N2137) 12.10.2.26: If the connection is for stream + access recl is assigned the value -2. */ + u->recl = -2; u->bytes_left = 1; u->strm_pos = stell (u->s) + 1; } diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index acaa88a01f9..1ac4c5164e9 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -451,7 +451,7 @@ read_block_form (st_parameter_dt *dtp, int *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.stdin_unit - && dtp->u.p.current_unit->recl == DEFAULT_RECL) + && dtp->u.p.current_unit->recl == default_recl) dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; else { @@ -757,7 +757,7 @@ write_block (st_parameter_dt *dtp, int length) == 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->recl == default_recl)) dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; else { diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index e62f9b839d4..fbb33046dee 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -95,7 +95,10 @@ static int newunit_lwi; #define CACHE_SIZE 3 static gfc_unit *unit_cache[CACHE_SIZE]; + gfc_offset max_offset; +gfc_offset default_recl; + gfc_unit *unit_root; #ifdef __GTHREAD_MUTEX_INIT __gthread_mutex_t unit_lock = __GTHREAD_MUTEX_INIT; @@ -575,7 +578,6 @@ void init_units (void) { gfc_unit *u; - unsigned int i; #ifdef HAVE_NEWLOCALE c_locale = newlocale (0, "C", 0); @@ -589,6 +591,22 @@ init_units (void) __GTHREAD_MUTEX_INIT_FUNCTION (&unit_lock); #endif + if (sizeof (max_offset) == 8) + { + max_offset = GFC_INTEGER_8_HUGE; + /* Why this weird value? Because if the recl specifier in the + inquire statement is a 4 byte value, u->recl is truncated, + and this trick ensures it becomes HUGE(0) rather than -1. + The full 8 byte value of default_recl is still 0.99999999 * + max_offset which is large enough for all practical + purposes. */ + default_recl = max_offset & ~(1LL<<31); + } + else if (sizeof (max_offset) == 4) + max_offset = default_recl = GFC_INTEGER_4_HUGE; + else + internal_error (NULL, "sizeof (max_offset) must be 4 or 8"); + if (options.stdin_unit >= 0) { /* STDIN */ u = insert_unit (options.stdin_unit); @@ -611,7 +629,7 @@ init_units (void) u->flags.share = SHARE_UNSPECIFIED; u->flags.cc = CC_LIST; - u->recl = options.default_recl; + u->recl = default_recl; u->endfile = NO_ENDFILE; u->filename = strdup (stdin_name); @@ -642,7 +660,7 @@ init_units (void) u->flags.share = SHARE_UNSPECIFIED; u->flags.cc = CC_LIST; - u->recl = options.default_recl; + u->recl = default_recl; u->endfile = AT_ENDFILE; u->filename = strdup (stdout_name); @@ -672,7 +690,7 @@ init_units (void) u->flags.share = SHARE_UNSPECIFIED; u->flags.cc = CC_LIST; - u->recl = options.default_recl; + u->recl = default_recl; u->endfile = AT_ENDFILE; u->filename = strdup (stderr_name); @@ -682,13 +700,6 @@ init_units (void) __gthread_mutex_unlock (&u->lock); } - - /* Calculate the maximum file offset in a portable manner. - max will be the largest signed number for the type gfc_offset. - set a 1 in the LSB and keep a running sum, stopping at MSB-1 bit. */ - max_offset = 0; - for (i = 0; i < sizeof (max_offset) * 8 - 1; i++) - max_offset = max_offset + ((gfc_offset) 1 << i); } diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 21ad5fc23fd..94aedc8c49f 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -511,7 +511,7 @@ typedef struct int separator_len; const char *separator; - int all_unbuffered, unbuffered_preconnected, default_recl; + int all_unbuffered, unbuffered_preconnected; int fpe, backtrace; } options_t; @@ -577,12 +577,6 @@ extern char *filename; iexport_data_proto(filename); -/* The default value of record length for preconnected units is defined - here. This value can be overriden by an environment variable. - Default value is 1 Gb. */ -#define DEFAULT_RECL 1073741824 - - #define CHARACTER2(name) \ gfc_charlen_type name ## _len; \ char * name diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c index f0a593e6074..fb9a3c170d5 100644 --- a/libgfortran/runtime/environ.c +++ b/libgfortran/runtime/environ.c @@ -208,10 +208,6 @@ static variable variable_table[] = { /* Print optional plus signs in numbers where permitted */ { "GFORTRAN_OPTIONAL_PLUS", 0, &options.optional_plus, init_boolean }, - /* Default maximum record length for sequential files */ - { "GFORTRAN_DEFAULT_RECL", DEFAULT_RECL, &options.default_recl, - init_unsigned_integer }, - /* Separator to use when writing list output */ { "GFORTRAN_LIST_SEPARATOR", 0, NULL, init_sep }, -- 2.30.2