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 <jb@gcc.gnu.org> PR fortran/53796 * gfortran.texi: Remove mentions of GFORTRAN_DEFAULT_RECL. libgfortran/ChangeLog: 2017-11-28 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-28 Janne Blomqvist <jb@gcc.gnu.org> PR fortran/53796 * gfortran.dg/inquire_recl_f2018.f90: New test. From-SVN: r255215
This commit is contained in:
parent
6df8934f6a
commit
67c24a8bd6
11 changed files with 89 additions and 36 deletions
|
@ -1,3 +1,8 @@
|
|||
2017-11-28 Janne Blomqvist <jb@gcc.gnu.org>
|
||||
|
||||
PR fortran/53796
|
||||
* gfortran.texi: Remove mentions of GFORTRAN_DEFAULT_RECL.
|
||||
|
||||
2017-11-28 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/83021
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2017-11-28 Janne Blomqvist <jb@gcc.gnu.org>
|
||||
|
||||
PR fortran/53796
|
||||
* gfortran.dg/inquire_recl_f2018.f90: New test.
|
||||
|
||||
2017-11-28 Prathamesh Kulkarni <prathamesh.kulkarni@linaro.org>
|
||||
Martin Jambor <mjambor@suse.cz>
|
||||
|
||||
|
|
42
gcc/testsuite/gfortran.dg/inquire_recl_f2018.f90
Normal file
42
gcc/testsuite/gfortran.dg/inquire_recl_f2018.f90
Normal file
|
@ -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
|
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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
|
||||
{
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 },
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue