You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
306 lines
11 KiB
306 lines
11 KiB
3 years ago
|
From cb3a42eb8e7ca26714c8dea383f2111230fdc0b5 Mon Sep 17 00:00:00 2001
|
||
|
|
From: Mark Eggleston <markeggleston@gcc.gnu.org>
|
||
|
|
Date: Mon, 3 Feb 2020 08:51:11 +0000
|
||
|
|
Subject: [PATCH 02/10] Convert LOGICAL to INTEGER for arithmetic ops, and vice
|
||
|
|
versa
|
||
|
|
|
||
|
|
We allow converting LOGICAL types to INTEGER when doing arithmetic
|
||
|
|
operations, and converting INTEGER types to LOGICAL for use in
|
||
|
|
boolean operations.
|
||
|
|
|
||
|
|
This feature is enabled with the -flogical-as-integer flag.
|
||
|
|
|
||
|
|
Note: using this feature will disable bitwise logical operations enabled by
|
||
|
|
-fdec.
|
||
|
|
---
|
||
|
|
gcc/fortran/lang.opt | 4 ++
|
||
|
|
gcc/fortran/resolve.c | 55 +++++++++++++++++++++-
|
||
|
|
.../logical_to_integer_and_vice_versa_1.f | 31 ++++++++++++
|
||
|
|
.../logical_to_integer_and_vice_versa_2.f | 31 ++++++++++++
|
||
|
|
.../logical_to_integer_and_vice_versa_3.f | 33 +++++++++++++
|
||
|
|
.../logical_to_integer_and_vice_versa_4.f | 33 +++++++++++++
|
||
|
|
6 files changed, 186 insertions(+), 1 deletion(-)
|
||
|
|
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
|
||
|
|
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
|
||
|
|
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
|
||
|
|
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
|
||
|
|
|
||
|
|
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
|
||
|
|
index 6275dc3deff..5257da74b06 100644
|
||
|
|
--- a/gcc/fortran/lang.opt
|
||
|
|
+++ b/gcc/fortran/lang.opt
|
||
|
|
@@ -493,6 +493,10 @@ fdec-static
|
||
|
|
Fortran Var(flag_dec_static)
|
||
|
|
Enable DEC-style STATIC and AUTOMATIC attributes.
|
||
|
|
|
||
|
|
+flogical-as-integer
|
||
|
|
+Fortran Var(flag_logical_as_integer)
|
||
|
|
+Convert from integer to logical or logical to integer for arithmetic operations.
|
||
|
|
+
|
||
|
|
fdefault-double-8
|
||
|
|
Fortran Var(flag_default_double)
|
||
|
|
Set the default double precision kind to an 8 byte wide type.
|
||
|
|
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
|
||
|
|
index 354702bda0b..6e70eaf8812 100644
|
||
|
|
--- a/gcc/fortran/resolve.c
|
||
|
|
+++ b/gcc/fortran/resolve.c
|
||
|
|
@@ -3880,7 +3880,6 @@ lookup_uop_fuzzy (const char *op, gfc_symtree *uop)
|
||
|
|
return gfc_closest_fuzzy_match (op, candidates);
|
||
|
|
}
|
||
|
|
|
||
|
|
-
|
||
|
|
/* Callback finding an impure function as an operand to an .and. or
|
||
|
|
.or. expression. Remember the last function warned about to
|
||
|
|
avoid double warnings when recursing. */
|
||
|
|
@@ -3940,6 +3939,22 @@ convert_hollerith_to_character (gfc_expr *e)
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
+/* If E is a logical, convert it to an integer and issue a warning
|
||
|
|
+ for the conversion. */
|
||
|
|
+
|
||
|
|
+static void
|
||
|
|
+convert_integer_to_logical (gfc_expr *e)
|
||
|
|
+{
|
||
|
|
+ if (e->ts.type == BT_INTEGER)
|
||
|
|
+ {
|
||
|
|
+ /* Convert to LOGICAL */
|
||
|
|
+ gfc_typespec t;
|
||
|
|
+ t.type = BT_LOGICAL;
|
||
|
|
+ t.kind = 1;
|
||
|
|
+ gfc_convert_type_warn (e, &t, 2, 1);
|
||
|
|
+ }
|
||
|
|
+}
|
||
|
|
+
|
||
|
|
/* Convert to numeric and issue a warning for the conversion. */
|
||
|
|
|
||
|
|
static void
|
||
|
|
@@ -3952,6 +3967,22 @@ convert_to_numeric (gfc_expr *a, gfc_expr *b)
|
||
|
|
gfc_convert_type_warn (a, &t, 2, 1);
|
||
|
|
}
|
||
|
|
|
||
|
|
+/* If E is a logical, convert it to an integer and issue a warning
|
||
|
|
+ for the conversion. */
|
||
|
|
+
|
||
|
|
+static void
|
||
|
|
+convert_logical_to_integer (gfc_expr *e)
|
||
|
|
+{
|
||
|
|
+ if (e->ts.type == BT_LOGICAL)
|
||
|
|
+ {
|
||
|
|
+ /* Convert to INTEGER */
|
||
|
|
+ gfc_typespec t;
|
||
|
|
+ t.type = BT_INTEGER;
|
||
|
|
+ t.kind = 1;
|
||
|
|
+ gfc_convert_type_warn (e, &t, 2, 1);
|
||
|
|
+ }
|
||
|
|
+}
|
||
|
|
+
|
||
|
|
/* Resolve an operator expression node. This can involve replacing the
|
||
|
|
operation with a user defined function call. */
|
||
|
|
|
||
|
|
@@ -4037,6 +4068,12 @@ resolve_operator (gfc_expr *e)
|
||
|
|
case INTRINSIC_TIMES:
|
||
|
|
case INTRINSIC_DIVIDE:
|
||
|
|
case INTRINSIC_POWER:
|
||
|
|
+ if (flag_logical_as_integer)
|
||
|
|
+ {
|
||
|
|
+ convert_logical_to_integer (op1);
|
||
|
|
+ convert_logical_to_integer (op2);
|
||
|
|
+ }
|
||
|
|
+
|
||
|
|
if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
|
||
|
|
{
|
||
|
|
gfc_type_convert_binary (e, 1);
|
||
|
|
@@ -4073,6 +4110,13 @@ resolve_operator (gfc_expr *e)
|
||
|
|
case INTRINSIC_OR:
|
||
|
|
case INTRINSIC_EQV:
|
||
|
|
case INTRINSIC_NEQV:
|
||
|
|
+
|
||
|
|
+ if (flag_logical_as_integer)
|
||
|
|
+ {
|
||
|
|
+ convert_integer_to_logical (op1);
|
||
|
|
+ convert_integer_to_logical (op2);
|
||
|
|
+ }
|
||
|
|
+
|
||
|
|
if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
|
||
|
|
{
|
||
|
|
e->ts.type = BT_LOGICAL;
|
||
|
|
@@ -4123,6 +4167,9 @@ resolve_operator (gfc_expr *e)
|
||
|
|
goto simplify_op;
|
||
|
|
}
|
||
|
|
|
||
|
|
+ if (flag_logical_as_integer)
|
||
|
|
+ convert_integer_to_logical (op1);
|
||
|
|
+
|
||
|
|
if (op1->ts.type == BT_LOGICAL)
|
||
|
|
{
|
||
|
|
e->ts.type = BT_LOGICAL;
|
||
|
|
@@ -4163,6 +4210,12 @@ resolve_operator (gfc_expr *e)
|
||
|
|
convert_hollerith_to_character (op2);
|
||
|
|
}
|
||
|
|
|
||
|
|
+ if (flag_logical_as_integer)
|
||
|
|
+ {
|
||
|
|
+ convert_logical_to_integer (op1);
|
||
|
|
+ convert_logical_to_integer (op2);
|
||
|
|
+ }
|
||
|
|
+
|
||
|
|
if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
|
||
|
|
&& op1->ts.kind == op2->ts.kind)
|
||
|
|
{
|
||
|
|
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
|
||
|
|
new file mode 100644
|
||
|
|
index 00000000000..938a91d9e9a
|
||
|
|
--- /dev/null
|
||
|
|
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
|
||
|
|
@@ -0,0 +1,31 @@
|
||
|
|
+! { dg-do run }
|
||
|
|
+! { dg-options "-std=legacy -flogical-as-integer" }
|
||
|
|
+!
|
||
|
|
+! Test conversion between logical and integer for logical operators
|
||
|
|
+!
|
||
|
|
+! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
||
|
|
+! Modified for -flogical-as-integer by Mark Eggleston
|
||
|
|
+! <mark.eggleston@codethink.com>
|
||
|
|
+!
|
||
|
|
+ PROGRAM logical_integer_conversion
|
||
|
|
+ LOGICAL lpos /.true./
|
||
|
|
+ INTEGER ineg/0/
|
||
|
|
+ INTEGER ires
|
||
|
|
+ LOGICAL lres
|
||
|
|
+
|
||
|
|
+ ! Test Logicals converted to Integers
|
||
|
|
+ if ((lpos.AND.ineg).EQ.1) STOP 3
|
||
|
|
+ if ((ineg.AND.lpos).NE.0) STOP 4
|
||
|
|
+ ires = (.true..AND.0)
|
||
|
|
+ if (ires.NE.0) STOP 5
|
||
|
|
+ ires = (1.AND..false.)
|
||
|
|
+ if (ires.EQ.1) STOP 6
|
||
|
|
+
|
||
|
|
+ ! Test Integers converted to Logicals
|
||
|
|
+ if (lpos.EQ.ineg) STOP 7
|
||
|
|
+ if (ineg.EQ.lpos) STOP 8
|
||
|
|
+ lres = (.true..EQ.0)
|
||
|
|
+ if (lres) STOP 9
|
||
|
|
+ lres = (1.EQ..false.)
|
||
|
|
+ if (lres) STOP 10
|
||
|
|
+ END
|
||
|
|
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
|
||
|
|
new file mode 100644
|
||
|
|
index 00000000000..9f146202ba5
|
||
|
|
--- /dev/null
|
||
|
|
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
|
||
|
|
@@ -0,0 +1,31 @@
|
||
|
|
+! { dg-do compile }
|
||
|
|
+! { dg-options "-std=legacy -flogical-as-integer -fno-logical-as-integer" }
|
||
|
|
+!
|
||
|
|
+! Based on logical_to_integer_and_vice_versa_1.f but with option disabled
|
||
|
|
+! to test for error messages.
|
||
|
|
+!
|
||
|
|
+! Test case contributed by by Mark Eggleston <mark.eggleston@codethink.com>
|
||
|
|
+!
|
||
|
|
+!
|
||
|
|
+ PROGRAM logical_integer_conversion
|
||
|
|
+ LOGICAL lpos /.true./
|
||
|
|
+ INTEGER ineg/0/
|
||
|
|
+ INTEGER ires
|
||
|
|
+ LOGICAL lres
|
||
|
|
+
|
||
|
|
+ ! Test Logicals converted to Integers
|
||
|
|
+ if ((lpos.AND.ineg).EQ.1) STOP 3 ! { dg-error "Operands of logical operator" }
|
||
|
|
+ if ((ineg.AND.lpos).NE.0) STOP 4 ! { dg-error "Operands of logical operator" }
|
||
|
|
+ ires = (.true..AND.0) ! { dg-error "Operands of logical operator" }
|
||
|
|
+ if (ires.NE.0) STOP 5
|
||
|
|
+ ires = (1.AND..false.) ! { dg-error "Operands of logical operator" }
|
||
|
|
+ if (ires.EQ.1) STOP 6
|
||
|
|
+
|
||
|
|
+ ! Test Integers converted to Logicals
|
||
|
|
+ if (lpos.EQ.ineg) STOP 7 ! { dg-error "Operands of comparison operator" }
|
||
|
|
+ if (ineg.EQ.lpos) STOP 8 ! { dg-error "Operands of comparison operator" }
|
||
|
|
+ lres = (.true..EQ.0) ! { dg-error "Operands of comparison operator" }
|
||
|
|
+ if (lres) STOP 9
|
||
|
|
+ lres = (1.EQ..false.) ! { dg-error "Operands of comparison operator" }
|
||
|
|
+ if (lres) STOP 10
|
||
|
|
+ END
|
||
|
|
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
|
||
|
|
new file mode 100644
|
||
|
|
index 00000000000..446873eb2dc
|
||
|
|
--- /dev/null
|
||
|
|
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
|
||
|
|
@@ -0,0 +1,33 @@
|
||
|
|
+! { dg-do compile }
|
||
|
|
+! { dg-options "-std=legacy -flogical-as-integer" }
|
||
|
|
+!
|
||
|
|
+! Test conversion between logical and integer for logical operators
|
||
|
|
+!
|
||
|
|
+ program test
|
||
|
|
+ logical f /.false./
|
||
|
|
+ logical t /.true./
|
||
|
|
+ real x
|
||
|
|
+
|
||
|
|
+ x = 7.7
|
||
|
|
+ x = x + t*3.0
|
||
|
|
+ if (abs(x - 10.7).gt.0.00001) stop 1
|
||
|
|
+ x = x + .false.*5.0
|
||
|
|
+ if (abs(x - 10.7).gt.0.00001) stop 2
|
||
|
|
+ x = x - .true.*5.0
|
||
|
|
+ if (abs(x - 5.7).gt.0.00001) stop 3
|
||
|
|
+ x = x + t
|
||
|
|
+ if (abs(x - 6.7).gt.0.00001) stop 4
|
||
|
|
+ x = x + f
|
||
|
|
+ if (abs(x - 6.7).gt.0.00001) stop 5
|
||
|
|
+ x = x - t
|
||
|
|
+ if (abs(x - 5.7).gt.0.00001) stop 6
|
||
|
|
+ x = x - f
|
||
|
|
+ if (abs(x - 5.7).gt.0.00001) stop 7
|
||
|
|
+ x = x**.true.
|
||
|
|
+ if (abs(x - 5.7).gt.0.00001) stop 8
|
||
|
|
+ x = x**.false.
|
||
|
|
+ if (abs(x - 1.0).gt.0.00001) stop 9
|
||
|
|
+ x = x/t
|
||
|
|
+ if (abs(x - 1.0).gt.0.00001) stop 10
|
||
|
|
+ if ((x/.false.).le.huge(x)) stop 11
|
||
|
|
+ end
|
||
|
|
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
|
||
|
|
new file mode 100644
|
||
|
|
index 00000000000..4301a4988d8
|
||
|
|
--- /dev/null
|
||
|
|
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
|
||
|
|
@@ -0,0 +1,33 @@
|
||
|
|
+! { dg-do compile }
|
||
|
|
+! { dg-options "-std=legacy -flogical-as-integer -fno-logical-as-integer" }
|
||
|
|
+!
|
||
|
|
+! Test conversion between logical and integer for logical operators
|
||
|
|
+!
|
||
|
|
+ program test
|
||
|
|
+ logical f /.false./
|
||
|
|
+ logical t /.true./
|
||
|
|
+ real x
|
||
|
|
+
|
||
|
|
+ x = 7.7
|
||
|
|
+ x = x + t*3.0 ! { dg-error "Operands of binary numeric" }
|
||
|
|
+ if (abs(x - 10.7).gt.0.00001) stop 1
|
||
|
|
+ x = x + .false.*5.0 ! { dg-error "Operands of binary numeric" }
|
||
|
|
+ if (abs(x - 10.7).gt.0.00001) stop 2
|
||
|
|
+ x = x - .true.*5.0 ! { dg-error "Operands of binary numeric" }
|
||
|
|
+ if (abs(x - 5.7).gt.0.00001) stop 3
|
||
|
|
+ x = x + t ! { dg-error "Operands of binary numeric" }
|
||
|
|
+ if (abs(x - 6.7).gt.0.00001) stop 4
|
||
|
|
+ x = x + f ! { dg-error "Operands of binary numeric" }
|
||
|
|
+ if (abs(x - 6.7).gt.0.00001) stop 5
|
||
|
|
+ x = x - t ! { dg-error "Operands of binary numeric" }
|
||
|
|
+ if (abs(x - 5.7).gt.0.00001) stop 6
|
||
|
|
+ x = x - f ! { dg-error "Operands of binary numeric" }
|
||
|
|
+ if (abs(x - 5.7).gt.0.00001) stop 7
|
||
|
|
+ x = x**.true. ! { dg-error "Operands of binary numeric" }
|
||
|
|
+ if (abs(x - 5.7).gt.0.00001) stop 8
|
||
|
|
+ x = x**.false. ! { dg-error "Operands of binary numeric" }
|
||
|
|
+ if (abs(x - 1.0).gt.0.00001) stop 9
|
||
|
|
+ x = x/t ! { dg-error "Operands of binary numeric" }
|
||
|
|
+ if (abs(x - 1.0).gt.0.00001) stop 10
|
||
|
|
+ if ((x/.false.).le.huge(x)) stop 11 ! { dg-error "Operands of binary numeric" }
|
||
|
|
+ end
|
||
|
|
--
|
||
|
|
2.11.0
|
||
|
|
|