[PATCH] PR 53796 Improve INQUIRE(RECL=...) handling

[Janne Blomqvist <blomqvist dot janne at gmail dot com>]

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-20  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/53796
	* gfortran.texi: Remove mentions of GFORTRAN_DEFAULT_RECL.

libgfortran/ChangeLog:

2017-11-20  Janne Blomqvist  <jb@gcc.gnu.org>

	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-20  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/53796
	* gfortran.dg/inquire_recl_f2018.f90: New test.
---
 gcc/fortran/gfortran.texi                        |  9 -----
 gcc/testsuite/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 ---
 9 files changed, 79 insertions(+), 36 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/inquire_recl_f2018.f90

diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 4b4688c..36c7b94 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/gfortran.dg/inquire_recl_f2018.f90 b/gcc/testsuite/gfortran.dg/inquire_recl_f2018.f90
new file mode 100644
index 0000000..8a13340
--- /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 4cf87d3..f6c6078 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 d29b112..41611c4 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 9d3988a..4d292ef 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 c173447..7f881c7 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 e06867a..0f8bbbb 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -96,7 +96,10 @@ static void newunit_free (int);
 
 #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;
@@ -576,7 +579,6 @@ void
 init_units (void)
 {
   gfc_unit *u;
-  unsigned int i;
 
 #ifdef HAVE_NEWLOCALE
   c_locale = newlocale (0, "C", 0);
@@ -590,6 +592,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);
@@ -612,7 +630,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);
@@ -643,7 +661,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);
@@ -673,7 +691,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);
@@ -683,13 +701,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 cdbdd951..e9648b5 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -514,7 +514,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;
@@ -580,12 +580,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 f0a593e..fb9a3c1 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.7.4