Just saw that gcc-patches@ wasn't included in the list. See:
https://gcc.gnu.org/ml/fortran/2020-01/threads.html#00088 for the thread.
Tobias
-------- Forwarded Message --------
Subject: Re: [Patch][Fortran] On unformatted read, convert != 0 logical
to 1
Date: Mon, 27 Jan 2020 17:29:10 +0100
From: Tobias Burnus <tob...@codesourcery.com>
To: Tobias Burnus <tob...@codesourcery.com>, Thomas Koenig
<tkoe...@netcologne.de>, Janne Blomqvist <blomqvist.ja...@gmail.com>
CC: Richard Biener <richard.guent...@gmail.com>, Marco Jacopo
Ferrarotti <marco.ferraro...@gmail.com>, fort...@gcc.gnu.org
<fort...@gcc.gnu.org>, Jerry DeLisle <jvdeli...@charter.net>
On 1/27/20 9:58 AM, Tobias Burnus wrote:
I think (3) with (a) and only (iii) is my preferred combination, but I
am also open for other suggestions.
That's now what the attached patch does.
RFC: Should this option use "!= 0" as .true. or "(var % 2) == 1" as
.true.? – Either works for the ubiquitous 0 = .false. plus both 1
(gfortran, ifort –standard-semantics, …) and –1 (ifort, PGI, …) as
.true. [Other values can only occur when modifying the value directly,
which should be done in a proper program, or if interop goes wrong with
.not.. (".true.(1) xor -1" or ".true.(-1) xor 1")]
I have used != 0 – and placed it before the endian conversion ("else
if"). For the even/odd check, it has to be after the endian conversion.
Besides != 0 and even/odd, one could also change the Boolean flag into a
three-state flag, using != 0 or even/odd at the user's discretion but
that seems to be overkill.
What do you think?
Tobias
PS: Minor changes: libgomp.texi — I removed some tailing "." in the
@menu for consistency. And in libgfortran.h, I put "optional_plus" into
another like to avoid mixing Boolean and integer items. One could change
optional_plus, locus, all_unbuffered, unbuffered_preconnect, backtrace,
legacy_logical_read, backtrace to "bool" and moving the bool and the
char item together, saving 8*4 - 8*1 = 24 bytes. [However, the type is
only used once for static variable.]
* gfortran.texi (Internal representation of LOGICAL variables):
Add @ref.
(GFORTRAN_LEGACY_LOGICAL_READ): Document new env variable.
* gfortran.dg/read_logical_1.f90: New.
* gfortran.dg/read_logical_2.f90: New.
* libgfortran.h (options_t): Add legacy_logical_read.
* runtime/environ.c (variable_table): Add entry for
GFORTRAN_LEGACY_LOGICAL_READ.
* io/transfer.c (unformatted_read): If options.legacy_logical_read,
convert bitvalue != 0 to canonical .true. (= 1) for BT_LOGICAL.
gcc/fortran/gfortran.texi | 34 ++++-
gcc/testsuite/gfortran.dg/read_logical_1.f90 | 194 +++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/read_logical_2.f90 | 66 +++++++++
libgfortran/io/transfer.c | 60 ++++++++-
libgfortran/libgfortran.h | 5 +-
libgfortran/runtime/environ.c | 4 +
6 files changed, 355 insertions(+), 8 deletions(-)
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index a50634ab9d2..b0e0077e80e 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -604,15 +604,16 @@ Malformed environment variables are silently ignored.
* GFORTRAN_STDIN_UNIT:: Unit number for standard input
* GFORTRAN_STDOUT_UNIT:: Unit number for standard output
* GFORTRAN_STDERR_UNIT:: Unit number for standard error
-* GFORTRAN_UNBUFFERED_ALL:: Do not buffer I/O for all units.
+* GFORTRAN_UNBUFFERED_ALL:: Do not buffer I/O for all units
* 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_LIST_SEPARATOR:: Separator for list output
* GFORTRAN_CONVERT_UNIT:: Set endianness for unformatted I/O
+* GFORTRAN_LEGACY_LOGICAL_READ:: Nonzero, nonone unformatted reads of logicals
* GFORTRAN_ERROR_BACKTRACE:: Show backtrace on run-time errors
-* GFORTRAN_FORMATTED_BUFFER_SIZE:: Buffer size for formatted files.
-* GFORTRAN_UNFORMATTED_BUFFER_SIZE:: Buffer size for unformatted files.
+* GFORTRAN_FORMATTED_BUFFER_SIZE:: Buffer size for formatted files
+* GFORTRAN_UNFORMATTED_BUFFER_SIZE:: Buffer size for unformatted files
@end menu
@node TMPDIR
@@ -784,6 +785,30 @@ the backtracing, set the variable to @samp{n}, @samp{N}, @samp{0}.
Default is to print a backtrace unless the @option{-fno-backtrace}
compile option was used.
+@node GFORTRAN_LEGACY_LOGICAL_READ
+@section @env{GFORTRAN_LEGACY_LOGICAL_READ}--Nonzero, nonone unformatted reads of logicals
+
+GNU Fortran uses @code{0} and @code{1} as internal representation for
+logical @code{.false.} and @code{.true.}, respectively. However, some other
+compilers use different representations; the most common other representation
+is @code{-1} for @code{.true.}.
+
+The different internal representation affects procedure calls plus writing and
+reading unformatted files. This option only affects the latter. If the first
+character of the @env{GFORTRAN_LEGACY_LOGICAL_READ} environment variable is
+@samp{y}, @samp{Y} or @samp{1}, all nonzero values in unformatted reads of
+logical type are normalized to the internal representation @code{1}, which is
+GNU Fortran's @code{.true.}.
+
+NOTE: Some compilers regard all even integer values as @code{.false.}
+(e.g. 0, 2, -2, etc.) and only as odd values as true; still, those compilers
+default to @code{0} as @code{.false.}, which is, hence, compatible with the
+conversion done by this flag.
+
+See also @ref{Internal representation of LOGICAL variables},
+@ref{Argument passing conventions}, and @ref{Interoperability with C}.
+
+
@node GFORTRAN_FORMATTED_BUFFER_SIZE
@section @env{GFORTRAN_FORMATTED_BUFFER_SIZE}---Set buffer size for formatted I/O
@@ -1276,7 +1301,8 @@ A @code{LOGICAL(KIND=N)} variable is represented as an
values: @code{1} for @code{.TRUE.} and @code{0} for
@code{.FALSE.}. Any other integer value results in undefined behavior.
-See also @ref{Argument passing conventions} and @ref{Interoperability with C}.
+See also @ref{Argument passing conventions}, @ref{Interoperability with C},
+and @ref{GFORTRAN_LEGACY_LOGICAL_READ}.
@node Evaluation of logical expressions
diff --git a/gcc/testsuite/gfortran.dg/read_logical_1.f90 b/gcc/testsuite/gfortran.dg/read_logical_1.f90
new file mode 100644
index 00000000000..eaa62c8e879
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_logical_1.f90
@@ -0,0 +1,194 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_LEGACY_LOGICAL_READ "1" }
+!
+! When reading LOGICAL canonilize them to 1 and 0
+!
+! See https://gcc.gnu.org/ml/fortran/2020-01/threads.html#00088
+! and cf. PRs fortran/40539
+!
+implicit none
+integer :: lun
+
+open(newunit=lun, status='scratch', form='unformatted')
+call write_1(lun, .false.)
+call write_2(lun, .false.)
+call write_4(lun, .false.)
+call write_8(lun, .false.)
+rewind(lun)
+call read_1(lun, .false.)
+call read_2(lun, .false.)
+call read_4(lun, .false.)
+call read_8(lun, .false.)
+close(lun)
+
+open(newunit=lun, status='scratch', form='unformatted', asynchronous='yes')
+call write_1(lun, .true.)
+call write_2(lun, .true.)
+call write_4(lun, .true.)
+call write_8(lun, .true.)
+rewind(lun)
+call read_1(lun, .true.)
+call read_2(lun, .true.)
+call read_4(lun, .true.)
+call read_8(lun, .true.)
+close(lun)
+
+contains
+
+subroutine write_1(lun, async)
+ integer, value, intent(in) :: lun
+ logical, value, intent(in) :: async
+ integer(kind=1), asynchronous :: A, C(10)
+ A = -1
+ !1 2 3 4 5 6 7 8 9, 10
+ C = [0, -2, -1, 3, 5, 0, 1, 0, -6, -1]
+ if (async) then
+ write(lun, asynchronous='yes') A, C
+ wait(lun)
+ else
+ write(lun) A, C
+ endif
+end
+subroutine read_1(lun, async)
+ integer, value, intent(in) :: lun
+ logical, value, intent(in) :: async
+ integer :: i
+ logical(kind=1), asynchronous :: B, D(10)
+
+ B = .false.
+ D = .false.
+ if (async) then
+ read(lun, asynchronous='yes') B, D
+ wait(lun)
+ else
+ read(lun) B, D
+ endif
+
+ if (B .neqv. .true.) stop 11
+ if (any (D .neqv. [.false., .true., .true., .true., .true., &
+ .false., .true., .false., .true., .true.])) stop 12
+ ! 6 7 8 9 10
+ if (transfer(B, 0_1) /= 1) stop 13
+ if (any ([(transfer(D(i),0_1), i=1,10)] &
+ /= [0, 1, 1, 1, 1, 0, 1, 0, 1, 1])) stop 14
+ !1 2 3 4 5 6 7 8 9 10
+end
+
+subroutine write_2(lun, async)
+ integer, value, intent(in) :: lun
+ logical, value, intent(in) :: async
+ integer(kind=2), asynchronous :: A, C(10)
+ A = -1
+ !1 2 3 4 5 6 7 8 9, 10
+ C = [0, -2, -1, 3, 5, 0, 1, 0, -6, -1]
+ if (async) then
+ write(lun, asynchronous='yes') A, C
+ wait(lun)
+ else
+ write(lun) A, C
+ endif
+end
+subroutine read_2(lun, async)
+ integer, value, intent(in) :: lun
+ logical, value, intent(in) :: async
+ integer :: i
+ logical(kind=2), asynchronous :: B, D(10)
+
+ B = .false.
+ D = .false.
+ if (async) then
+ read(lun, asynchronous='yes') B, D
+ wait(lun)
+ else
+ read(lun) B, D
+ endif
+
+ if (B .neqv. .true.) stop 21
+ if (any (D .neqv. [.false., .true., .true., .true., .true., &
+ .false., .true., .false., .true., .true.])) stop 22
+ ! 6 7 8 9 10
+ if (transfer(B, 0_2) /= 1) stop 23
+ if (any ([(transfer(D(i),0_2), i=1,10)] &
+ /= [0, 1, 1, 1, 1, 0, 1, 0, 1, 1])) stop 24
+ !1 2 3 4 5 6 7 8 9 10
+end
+
+subroutine write_4(lun, async)
+ integer, value, intent(in) :: lun
+ logical, value, intent(in) :: async
+ integer(kind=4), asynchronous :: A, C(10)
+ A = -1
+ !1 2 3 4 5 6 7 8 9, 10
+ C = [0, -2, -1, 3, 5, 0, 1, 0, -6, -1]
+ if (async) then
+ write(lun, asynchronous='yes') A, C
+ wait(lun)
+ else
+ write(lun) A, C
+ endif
+end
+subroutine read_4(lun, async)
+ integer, value, intent(in) :: lun
+ logical, value, intent(in) :: async
+ integer :: i
+ logical(kind=4), asynchronous :: B, D(10)
+
+ B = .false.
+ D = .false.
+ if (async) then
+ read(lun, asynchronous='yes') B, D
+ wait(lun)
+ else
+ read(lun) B, D
+ endif
+
+ if (B .neqv. .true.) stop 41
+ if (any (D .neqv. [.false., .true., .true., .true., .true., &
+ .false., .true., .false., .true., .true.])) stop 42
+ ! 6 7 8 9 10
+ if (transfer(B, 0_4) /= 1) stop 43
+ if (any ([(transfer(D(i),0_4), i=1,10)] &
+ /= [0, 1, 1, 1, 1, 0, 1, 0, 1, 1])) stop 44
+ !1 2 3 4 5 6 7 8 9 10
+end
+
+subroutine write_8(lun, async)
+ integer, value, intent(in) :: lun
+ logical, value, intent(in) :: async
+ integer(kind=8), asynchronous :: A, C(10)
+ A = -1
+ !1 2 3 4 5 6 7 8 9, 10
+ C = [0, -2, -1, 3, 5, 0, 1, 0, -6, -1]
+ if (async) then
+ write(lun, asynchronous='yes') A, C
+ wait(lun)
+ else
+ write(lun) A, C
+ endif
+end
+subroutine read_8(lun, async)
+ integer, value, intent(in) :: lun
+ logical, value, intent(in) :: async
+ integer :: i
+ logical(kind=8), asynchronous :: B, D(10)
+
+ B = .false.
+ D = .false.
+ if (async) then
+ read(lun, asynchronous='yes') B, D
+ wait(lun)
+ else
+ read(lun) B, D
+ endif
+
+ if (B .neqv. .true.) stop 81
+ if (any (D .neqv. [.false., .true., .true., .true., .true., &
+ .false., .true., .false., .true., .true.])) stop 82
+ ! 6 7 8 9 10
+ if (transfer(B, 0_8) /= 1) stop 83
+ if (any ([(transfer(D(i),0_8), i=1,10)] &
+ /= [0, 1, 1, 1, 1, 0, 1, 0, 1, 1])) stop 84
+ !1 2 3 4 5 6 7 8 9 10
+end
+
+end
diff --git a/gcc/testsuite/gfortran.dg/read_logical_2.f90 b/gcc/testsuite/gfortran.dg/read_logical_2.f90
new file mode 100644
index 00000000000..9b867ecf1ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_logical_2.f90
@@ -0,0 +1,66 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_integer_16 }
+! { dg-set-target-env-var GFORTRAN_LEGACY_LOGICAL_READ "1" }
+!
+! When reading LOGICAL canonilize them to 1 and 0
+!
+! See https://gcc.gnu.org/ml/fortran/2020-01/threads.html#00088
+! and cf. PRs fortran/40539
+!
+implicit none
+integer :: lun
+
+open(newunit=lun, status='scratch', form='unformatted')
+call write_16(lun, .false.)
+rewind(lun)
+call read_16(lun, .false.)
+close(lun)
+
+open(newunit=lun, status='scratch', form='unformatted', asynchronous='yes')
+call write_16(lun, .true.)
+rewind(lun)
+call read_16(lun, .true.)
+close(lun)
+
+contains
+
+subroutine write_16(lun, async)
+ integer, value, intent(in) :: lun
+ logical, value, intent(in) :: async
+ integer(kind=16), asynchronous :: A, C(10)
+ A = -1
+ !1 2 3 4 5 6 7 8 9, 10
+ C = [0, -2, -1, 3, 5, 0, 1, 0, -6, -1]
+ if (async) then
+ write(lun, asynchronous='yes') A, C
+ wait(lun)
+ else
+ write(lun) A, C
+ endif
+end
+subroutine read_16(lun, async)
+ integer, value, intent(in) :: lun
+ logical, value, intent(in) :: async
+ integer :: i
+ logical(kind=16), asynchronous :: B, D(10)
+
+ B = .false.
+ D = .false.
+ if (async) then
+ read(lun, asynchronous='yes') B, D
+ wait(lun)
+ else
+ read(lun) B, D
+ endif
+
+ if (B .neqv. .true.) stop 11
+ if (any (D .neqv. [.false., .true., .true., .true., .true., &
+ .false., .true., .false., .true., .true.])) stop 12
+ ! 6 7 8 9 10
+ if (transfer(B, 0_16) /= 1) stop 13
+ if (any ([(transfer(D(i),0_16), i=1,10)] &
+ /= [0, 1, 1, 1, 1, 0, 1, 0, 1, 1])) stop 14
+ !1 2 3 4 5 6 7 8 9 10
+end
+
+end
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index b8db47dbff9..a1866ba2f53 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -1126,8 +1126,64 @@ unformatted_read (st_parameter_dt *dtp, bt type,
size *= GFC_SIZE_OF_CHAR_KIND(kind);
read_block_direct (dtp, dest, size * nelems);
- if (unlikely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_SWAP)
- && kind != 1)
+ /* GFORTRAN_LEGACY_LOGICAL_READ: A large set of Fortran compiler use -1
+ for .TRUE. - at least in legacy mode. By consistently using 1 and 0,
+ one avoids issues when comparing two logical variables and with .not.
+ which might use a simple bit flip (gfortran: "xor 1", some other
+ compilers "xor -1").
+ Note: gfortran uses != 0 for Boolean checks while other compilers
+ only check the last bit, i.e. 0 = 2 = .false, 1 = 3 = .true.
+ Below, we follow gfortran and use != 0, which is fine for -1 logicals.
+ If changing to the other convention, move this after the endian
+ conversion! */
+ if (unlikely (options.legacy_logical_read && type == BT_LOGICAL))
+ switch (kind)
+ {
+ case 1:
+ for (size_t i = 0; i < nelems; ++i)
+ {
+ GFC_INTEGER_1 *tmp = (GFC_INTEGER_1*) dest;
+ *tmp = (GFC_INTEGER_1) *tmp ? 1 : 0;
+ dest += sizeof (GFC_INTEGER_1);
+ }
+ break;
+ case 2:
+ for (size_t i = 0; i < nelems; ++i)
+ {
+ GFC_INTEGER_2 *tmp = (GFC_INTEGER_2*) dest;
+ *tmp = (GFC_INTEGER_2) *tmp ? 1 : 0;
+ dest += sizeof (GFC_INTEGER_2);
+ }
+ break;
+ case 4:
+ for (size_t i = 0; i < nelems; ++i)
+ {
+ GFC_INTEGER_4 *tmp = (GFC_INTEGER_4*) dest;
+ *tmp = (GFC_INTEGER_4) *tmp ? 1 : 0;
+ dest += sizeof (GFC_INTEGER_4);
+ }
+ break;
+ case 8:
+ for (size_t i = 0; i < nelems; ++i)
+ {
+ GFC_INTEGER_8 *tmp = (GFC_INTEGER_8*) dest;
+ *tmp = (GFC_INTEGER_8) *tmp ? 1 : 0;
+ dest += sizeof (GFC_INTEGER_8);
+ }
+ break;
+#ifdef HAVE_GFC_INTEGER_16
+ case 16:
+ for (size_t i = 0; i < nelems; ++i)
+ {
+ GFC_INTEGER_16 *tmp = (GFC_INTEGER_16*) dest;
+ *tmp = (GFC_INTEGER_16) *tmp ? 1 : 0;
+ dest += sizeof (GFC_INTEGER_16);
+ }
+ break;
+#endif /* HAVE_GFC_INTEGER_16 */
+ }
+ else if (unlikely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_SWAP)
+ && kind != 1)
{
/* Handle wide chracters. */
if (type == BT_CHARACTER)
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 8c539e0898b..84ac2bf7f6c 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -532,8 +532,8 @@ typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_a
typedef struct
{
- int stdin_unit, stdout_unit, stderr_unit, optional_plus;
- int locus;
+ int stdin_unit, stdout_unit, stderr_unit;
+ int optional_plus, locus;
int separator_len;
const char *separator;
@@ -541,6 +541,7 @@ typedef struct
int all_unbuffered, unbuffered_preconnected;
int fpe, backtrace;
int unformatted_buffer_size, formatted_buffer_size;
+ int legacy_logical_read;
}
options_t;
diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c
index 1daef37aea2..92186852413 100644
--- a/libgfortran/runtime/environ.c
+++ b/libgfortran/runtime/environ.c
@@ -206,6 +206,10 @@ static variable variable_table[] = {
{ "GFORTRAN_FORMATTED_BUFFER_SIZE", 0, &options.formatted_buffer_size,
init_integer },
+ /* If TRUE, LOGICALs on unformatted READ will be normalized to {0, 1}. */
+ { "GFORTRAN_LEGACY_LOGICAL_READ", 0, &options.legacy_logical_read,
+ init_boolean },
+
{ NULL, 0, NULL, NULL }
};
