Blame SOURCES/gcc12-fortran-flogical-as-integer.patch

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