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