From 6a3faecd0b1eed41e865bdab721cc3a60492845d Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Wed, 7 Oct 2015 16:31:18 -0400
Subject: [PATCH 03/16] 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 491d81ccaa5..13a8e9778bb 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -468,6 +468,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 8232deb8170..32b8d504ff6 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3838,7 +3838,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. */
@@ -3873,6 +3872,37 @@ impure_function_callback (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
return 0;
}
+/* 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);
+ }
+}
+
+/* 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. */
@@ -3938,6 +3968,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);
@@ -3974,6 +4010,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;
@@ -4024,6 +4067,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;
@@ -4055,6 +4101,13 @@ resolve_operator (gfc_expr *e)
case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
case INTRINSIC_NE_OS:
+
+ 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