|
|
31df50 |
From 9b45f3063dfd2b893e7963a4828c1b0afecdc68a Mon Sep 17 00:00:00 2001
|
|
|
31df50 |
From: Mark Eggleston <markeggleston@gcc.gnu.org>
|
|
|
31df50 |
Date: Fri, 22 Jan 2021 12:41:46 +0000
|
|
|
31df50 |
Subject: [PATCH 02/10] Convert LOGICAL to INTEGER for arithmetic ops, and vice
|
|
|
31df50 |
versa
|
|
|
31df50 |
|
|
|
31df50 |
We allow converting LOGICAL types to INTEGER when doing arithmetic
|
|
|
31df50 |
operations, and converting INTEGER types to LOGICAL for use in
|
|
|
31df50 |
boolean operations.
|
|
|
31df50 |
|
|
|
31df50 |
This feature is enabled with the -flogical-as-integer flag.
|
|
|
31df50 |
|
|
|
31df50 |
Note: using this feature will disable bitwise logical operations enabled by
|
|
|
31df50 |
-fdec.
|
|
|
31df50 |
---
|
|
|
31df50 |
gcc/fortran/lang.opt | 4 ++
|
|
|
31df50 |
gcc/fortran/resolve.cc | 55 ++++++++++++++++++-
|
|
|
31df50 |
.../logical_to_integer_and_vice_versa_1.f | 31 +++++++++++
|
|
|
31df50 |
.../logical_to_integer_and_vice_versa_2.f | 31 +++++++++++
|
|
|
31df50 |
.../logical_to_integer_and_vice_versa_3.f | 33 +++++++++++
|
|
|
31df50 |
.../logical_to_integer_and_vice_versa_4.f | 33 +++++++++++
|
|
|
31df50 |
6 files changed, 186 insertions(+), 1 deletion(-)
|
|
|
31df50 |
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
|
|
|
31df50 |
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
|
|
|
31df50 |
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
|
|
|
31df50 |
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
|
|
|
31df50 |
|
|
|
31df50 |
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
|
|
|
31df50 |
index 52bd522051e..c4da248f07c 100644
|
|
|
31df50 |
--- a/gcc/fortran/lang.opt
|
|
|
31df50 |
+++ b/gcc/fortran/lang.opt
|
|
|
31df50 |
@@ -497,6 +497,10 @@ fdec-static
|
|
|
31df50 |
Fortran Var(flag_dec_static)
|
|
|
31df50 |
Enable DEC-style STATIC and AUTOMATIC attributes.
|
|
|
31df50 |
|
|
|
31df50 |
+flogical-as-integer
|
|
|
31df50 |
+Fortran Var(flag_logical_as_integer)
|
|
|
31df50 |
+Convert from integer to logical or logical to integer for arithmetic operations.
|
|
|
31df50 |
+
|
|
|
31df50 |
fdefault-double-8
|
|
|
31df50 |
Fortran Var(flag_default_double)
|
|
|
31df50 |
Set the default double precision kind to an 8 byte wide type.
|
|
|
31df50 |
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
|
|
|
31df50 |
index c075d0fa0c4..4b90cb59902 100644
|
|
|
31df50 |
--- a/gcc/fortran/resolve.cc
|
|
|
31df50 |
+++ b/gcc/fortran/resolve.cc
|
|
|
31df50 |
@@ -3915,7 +3915,6 @@ lookup_uop_fuzzy (const char *op, gfc_symtree *uop)
|
|
|
31df50 |
return gfc_closest_fuzzy_match (op, candidates);
|
|
|
31df50 |
}
|
|
|
31df50 |
|
|
|
31df50 |
-
|
|
|
31df50 |
/* Callback finding an impure function as an operand to an .and. or
|
|
|
31df50 |
.or. expression. Remember the last function warned about to
|
|
|
31df50 |
avoid double warnings when recursing. */
|
|
|
31df50 |
@@ -3975,6 +3974,22 @@ convert_hollerith_to_character (gfc_expr *e)
|
|
|
31df50 |
}
|
|
|
31df50 |
}
|
|
|
31df50 |
|
|
|
31df50 |
+/* If E is a logical, convert it to an integer and issue a warning
|
|
|
31df50 |
+ for the conversion. */
|
|
|
31df50 |
+
|
|
|
31df50 |
+static void
|
|
|
31df50 |
+convert_integer_to_logical (gfc_expr *e)
|
|
|
31df50 |
+{
|
|
|
31df50 |
+ if (e->ts.type == BT_INTEGER)
|
|
|
31df50 |
+ {
|
|
|
31df50 |
+ /* Convert to LOGICAL */
|
|
|
31df50 |
+ gfc_typespec t;
|
|
|
31df50 |
+ t.type = BT_LOGICAL;
|
|
|
31df50 |
+ t.kind = 1;
|
|
|
31df50 |
+ gfc_convert_type_warn (e, &t, 2, 1);
|
|
|
31df50 |
+ }
|
|
|
31df50 |
+}
|
|
|
31df50 |
+
|
|
|
31df50 |
/* Convert to numeric and issue a warning for the conversion. */
|
|
|
31df50 |
|
|
|
31df50 |
static void
|
|
|
31df50 |
@@ -3987,6 +4002,22 @@ convert_to_numeric (gfc_expr *a, gfc_expr *b)
|
|
|
31df50 |
gfc_convert_type_warn (a, &t, 2, 1);
|
|
|
31df50 |
}
|
|
|
31df50 |
|
|
|
31df50 |
+/* If E is a logical, convert it to an integer and issue a warning
|
|
|
31df50 |
+ for the conversion. */
|
|
|
31df50 |
+
|
|
|
31df50 |
+static void
|
|
|
31df50 |
+convert_logical_to_integer (gfc_expr *e)
|
|
|
31df50 |
+{
|
|
|
31df50 |
+ if (e->ts.type == BT_LOGICAL)
|
|
|
31df50 |
+ {
|
|
|
31df50 |
+ /* Convert to INTEGER */
|
|
|
31df50 |
+ gfc_typespec t;
|
|
|
31df50 |
+ t.type = BT_INTEGER;
|
|
|
31df50 |
+ t.kind = 1;
|
|
|
31df50 |
+ gfc_convert_type_warn (e, &t, 2, 1);
|
|
|
31df50 |
+ }
|
|
|
31df50 |
+}
|
|
|
31df50 |
+
|
|
|
31df50 |
/* Resolve an operator expression node. This can involve replacing the
|
|
|
31df50 |
operation with a user defined function call. */
|
|
|
31df50 |
|
|
|
31df50 |
@@ -4072,6 +4103,12 @@ resolve_operator (gfc_expr *e)
|
|
|
31df50 |
case INTRINSIC_TIMES:
|
|
|
31df50 |
case INTRINSIC_DIVIDE:
|
|
|
31df50 |
case INTRINSIC_POWER:
|
|
|
31df50 |
+ if (flag_logical_as_integer)
|
|
|
31df50 |
+ {
|
|
|
31df50 |
+ convert_logical_to_integer (op1);
|
|
|
31df50 |
+ convert_logical_to_integer (op2);
|
|
|
31df50 |
+ }
|
|
|
31df50 |
+
|
|
|
31df50 |
if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
|
|
|
31df50 |
{
|
|
|
31df50 |
gfc_type_convert_binary (e, 1);
|
|
|
31df50 |
@@ -4108,6 +4145,13 @@ resolve_operator (gfc_expr *e)
|
|
|
31df50 |
case INTRINSIC_OR:
|
|
|
31df50 |
case INTRINSIC_EQV:
|
|
|
31df50 |
case INTRINSIC_NEQV:
|
|
|
31df50 |
+
|
|
|
31df50 |
+ if (flag_logical_as_integer)
|
|
|
31df50 |
+ {
|
|
|
31df50 |
+ convert_integer_to_logical (op1);
|
|
|
31df50 |
+ convert_integer_to_logical (op2);
|
|
|
31df50 |
+ }
|
|
|
31df50 |
+
|
|
|
31df50 |
if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
|
|
|
31df50 |
{
|
|
|
31df50 |
e->ts.type = BT_LOGICAL;
|
|
|
31df50 |
@@ -4158,6 +4202,9 @@ resolve_operator (gfc_expr *e)
|
|
|
31df50 |
goto simplify_op;
|
|
|
31df50 |
}
|
|
|
31df50 |
|
|
|
31df50 |
+ if (flag_logical_as_integer)
|
|
|
31df50 |
+ convert_integer_to_logical (op1);
|
|
|
31df50 |
+
|
|
|
31df50 |
if (op1->ts.type == BT_LOGICAL)
|
|
|
31df50 |
{
|
|
|
31df50 |
e->ts.type = BT_LOGICAL;
|
|
|
31df50 |
@@ -4198,6 +4245,12 @@ resolve_operator (gfc_expr *e)
|
|
|
31df50 |
convert_hollerith_to_character (op2);
|
|
|
31df50 |
}
|
|
|
31df50 |
|
|
|
31df50 |
+ if (flag_logical_as_integer)
|
|
|
31df50 |
+ {
|
|
|
31df50 |
+ convert_logical_to_integer (op1);
|
|
|
31df50 |
+ convert_logical_to_integer (op2);
|
|
|
31df50 |
+ }
|
|
|
31df50 |
+
|
|
|
31df50 |
if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
|
|
|
31df50 |
&& op1->ts.kind == op2->ts.kind)
|
|
|
31df50 |
{
|
|
|
31df50 |
diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
|
|
|
31df50 |
new file mode 100644
|
|
|
31df50 |
index 00000000000..938a91d9e9a
|
|
|
31df50 |
--- /dev/null
|
|
|
31df50 |
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
|
|
|
31df50 |
@@ -0,0 +1,31 @@
|
|
|
31df50 |
+! { dg-do run }
|
|
|
31df50 |
+! { dg-options "-std=legacy -flogical-as-integer" }
|
|
|
31df50 |
+!
|
|
|
31df50 |
+! Test conversion between logical and integer for logical operators
|
|
|
31df50 |
+!
|
|
|
31df50 |
+! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
|
31df50 |
+! Modified for -flogical-as-integer by Mark Eggleston
|
|
|
31df50 |
+! <mark.eggleston@codethink.com>
|
|
|
31df50 |
+!
|
|
|
31df50 |
+ PROGRAM logical_integer_conversion
|
|
|
31df50 |
+ LOGICAL lpos /.true./
|
|
|
31df50 |
+ INTEGER ineg/0/
|
|
|
31df50 |
+ INTEGER ires
|
|
|
31df50 |
+ LOGICAL lres
|
|
|
31df50 |
+
|
|
|
31df50 |
+ ! Test Logicals converted to Integers
|
|
|
31df50 |
+ if ((lpos.AND.ineg).EQ.1) STOP 3
|
|
|
31df50 |
+ if ((ineg.AND.lpos).NE.0) STOP 4
|
|
|
31df50 |
+ ires = (.true..AND.0)
|
|
|
31df50 |
+ if (ires.NE.0) STOP 5
|
|
|
31df50 |
+ ires = (1.AND..false.)
|
|
|
31df50 |
+ if (ires.EQ.1) STOP 6
|
|
|
31df50 |
+
|
|
|
31df50 |
+ ! Test Integers converted to Logicals
|
|
|
31df50 |
+ if (lpos.EQ.ineg) STOP 7
|
|
|
31df50 |
+ if (ineg.EQ.lpos) STOP 8
|
|
|
31df50 |
+ lres = (.true..EQ.0)
|
|
|
31df50 |
+ if (lres) STOP 9
|
|
|
31df50 |
+ lres = (1.EQ..false.)
|
|
|
31df50 |
+ if (lres) STOP 10
|
|
|
31df50 |
+ END
|
|
|
31df50 |
diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
|
|
|
31df50 |
new file mode 100644
|
|
|
31df50 |
index 00000000000..9f146202ba5
|
|
|
31df50 |
--- /dev/null
|
|
|
31df50 |
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
|
|
|
31df50 |
@@ -0,0 +1,31 @@
|
|
|
31df50 |
+! { dg-do compile }
|
|
|
31df50 |
+! { dg-options "-std=legacy -flogical-as-integer -fno-logical-as-integer" }
|
|
|
31df50 |
+!
|
|
|
31df50 |
+! Based on logical_to_integer_and_vice_versa_1.f but with option disabled
|
|
|
31df50 |
+! to test for error messages.
|
|
|
31df50 |
+!
|
|
|
31df50 |
+! Test case contributed by by Mark Eggleston <mark.eggleston@codethink.com>
|
|
|
31df50 |
+!
|
|
|
31df50 |
+!
|
|
|
31df50 |
+ PROGRAM logical_integer_conversion
|
|
|
31df50 |
+ LOGICAL lpos /.true./
|
|
|
31df50 |
+ INTEGER ineg/0/
|
|
|
31df50 |
+ INTEGER ires
|
|
|
31df50 |
+ LOGICAL lres
|
|
|
31df50 |
+
|
|
|
31df50 |
+ ! Test Logicals converted to Integers
|
|
|
31df50 |
+ if ((lpos.AND.ineg).EQ.1) STOP 3 ! { dg-error "Operands of logical operator" }
|
|
|
31df50 |
+ if ((ineg.AND.lpos).NE.0) STOP 4 ! { dg-error "Operands of logical operator" }
|
|
|
31df50 |
+ ires = (.true..AND.0) ! { dg-error "Operands of logical operator" }
|
|
|
31df50 |
+ if (ires.NE.0) STOP 5
|
|
|
31df50 |
+ ires = (1.AND..false.) ! { dg-error "Operands of logical operator" }
|
|
|
31df50 |
+ if (ires.EQ.1) STOP 6
|
|
|
31df50 |
+
|
|
|
31df50 |
+ ! Test Integers converted to Logicals
|
|
|
31df50 |
+ if (lpos.EQ.ineg) STOP 7 ! { dg-error "Operands of comparison operator" }
|
|
|
31df50 |
+ if (ineg.EQ.lpos) STOP 8 ! { dg-error "Operands of comparison operator" }
|
|
|
31df50 |
+ lres = (.true..EQ.0) ! { dg-error "Operands of comparison operator" }
|
|
|
31df50 |
+ if (lres) STOP 9
|
|
|
31df50 |
+ lres = (1.EQ..false.) ! { dg-error "Operands of comparison operator" }
|
|
|
31df50 |
+ if (lres) STOP 10
|
|
|
31df50 |
+ END
|
|
|
31df50 |
diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
|
|
|
31df50 |
new file mode 100644
|
|
|
31df50 |
index 00000000000..446873eb2dc
|
|
|
31df50 |
--- /dev/null
|
|
|
31df50 |
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
|
|
|
31df50 |
@@ -0,0 +1,33 @@
|
|
|
31df50 |
+! { dg-do compile }
|
|
|
31df50 |
+! { dg-options "-std=legacy -flogical-as-integer" }
|
|
|
31df50 |
+!
|
|
|
31df50 |
+! Test conversion between logical and integer for logical operators
|
|
|
31df50 |
+!
|
|
|
31df50 |
+ program test
|
|
|
31df50 |
+ logical f /.false./
|
|
|
31df50 |
+ logical t /.true./
|
|
|
31df50 |
+ real x
|
|
|
31df50 |
+
|
|
|
31df50 |
+ x = 7.7
|
|
|
31df50 |
+ x = x + t*3.0
|
|
|
31df50 |
+ if (abs(x - 10.7).gt.0.00001) stop 1
|
|
|
31df50 |
+ x = x + .false.*5.0
|
|
|
31df50 |
+ if (abs(x - 10.7).gt.0.00001) stop 2
|
|
|
31df50 |
+ x = x - .true.*5.0
|
|
|
31df50 |
+ if (abs(x - 5.7).gt.0.00001) stop 3
|
|
|
31df50 |
+ x = x + t
|
|
|
31df50 |
+ if (abs(x - 6.7).gt.0.00001) stop 4
|
|
|
31df50 |
+ x = x + f
|
|
|
31df50 |
+ if (abs(x - 6.7).gt.0.00001) stop 5
|
|
|
31df50 |
+ x = x - t
|
|
|
31df50 |
+ if (abs(x - 5.7).gt.0.00001) stop 6
|
|
|
31df50 |
+ x = x - f
|
|
|
31df50 |
+ if (abs(x - 5.7).gt.0.00001) stop 7
|
|
|
31df50 |
+ x = x**.true.
|
|
|
31df50 |
+ if (abs(x - 5.7).gt.0.00001) stop 8
|
|
|
31df50 |
+ x = x**.false.
|
|
|
31df50 |
+ if (abs(x - 1.0).gt.0.00001) stop 9
|
|
|
31df50 |
+ x = x/t
|
|
|
31df50 |
+ if (abs(x - 1.0).gt.0.00001) stop 10
|
|
|
31df50 |
+ if ((x/.false.).le.huge(x)) stop 11
|
|
|
31df50 |
+ end
|
|
|
31df50 |
diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
|
|
|
31df50 |
new file mode 100644
|
|
|
31df50 |
index 00000000000..4301a4988d8
|
|
|
31df50 |
--- /dev/null
|
|
|
31df50 |
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
|
|
|
31df50 |
@@ -0,0 +1,33 @@
|
|
|
31df50 |
+! { dg-do compile }
|
|
|
31df50 |
+! { dg-options "-std=legacy -flogical-as-integer -fno-logical-as-integer" }
|
|
|
31df50 |
+!
|
|
|
31df50 |
+! Test conversion between logical and integer for logical operators
|
|
|
31df50 |
+!
|
|
|
31df50 |
+ program test
|
|
|
31df50 |
+ logical f /.false./
|
|
|
31df50 |
+ logical t /.true./
|
|
|
31df50 |
+ real x
|
|
|
31df50 |
+
|
|
|
31df50 |
+ x = 7.7
|
|
|
31df50 |
+ x = x + t*3.0 ! { dg-error "Operands of binary numeric" }
|
|
|
31df50 |
+ if (abs(x - 10.7).gt.0.00001) stop 1
|
|
|
31df50 |
+ x = x + .false.*5.0 ! { dg-error "Operands of binary numeric" }
|
|
|
31df50 |
+ if (abs(x - 10.7).gt.0.00001) stop 2
|
|
|
31df50 |
+ x = x - .true.*5.0 ! { dg-error "Operands of binary numeric" }
|
|
|
31df50 |
+ if (abs(x - 5.7).gt.0.00001) stop 3
|
|
|
31df50 |
+ x = x + t ! { dg-error "Operands of binary numeric" }
|
|
|
31df50 |
+ if (abs(x - 6.7).gt.0.00001) stop 4
|
|
|
31df50 |
+ x = x + f ! { dg-error "Operands of binary numeric" }
|
|
|
31df50 |
+ if (abs(x - 6.7).gt.0.00001) stop 5
|
|
|
31df50 |
+ x = x - t ! { dg-error "Operands of binary numeric" }
|
|
|
31df50 |
+ if (abs(x - 5.7).gt.0.00001) stop 6
|
|
|
31df50 |
+ x = x - f ! { dg-error "Operands of binary numeric" }
|
|
|
31df50 |
+ if (abs(x - 5.7).gt.0.00001) stop 7
|
|
|
31df50 |
+ x = x**.true. ! { dg-error "Operands of binary numeric" }
|
|
|
31df50 |
+ if (abs(x - 5.7).gt.0.00001) stop 8
|
|
|
31df50 |
+ x = x**.false. ! { dg-error "Operands of binary numeric" }
|
|
|
31df50 |
+ if (abs(x - 1.0).gt.0.00001) stop 9
|
|
|
31df50 |
+ x = x/t ! { dg-error "Operands of binary numeric" }
|
|
|
31df50 |
+ if (abs(x - 1.0).gt.0.00001) stop 10
|
|
|
31df50 |
+ if ((x/.false.).le.huge(x)) stop 11 ! { dg-error "Operands of binary numeric" }
|
|
|
31df50 |
+ end
|
|
|
31df50 |
--
|
|
|
31df50 |
2.27.0
|
|
|
31df50 |
|