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.
305 lines
11 KiB
305 lines
11 KiB
From 9b45f3063dfd2b893e7963a4828c1b0afecdc68a Mon Sep 17 00:00:00 2001 |
|
From: Mark Eggleston <markeggleston@gcc.gnu.org> |
|
Date: Fri, 22 Jan 2021 12:41:46 +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 52bd522051e..c4da248f07c 100644 |
|
--- a/gcc/fortran/lang.opt |
|
+++ b/gcc/fortran/lang.opt |
|
@@ -497,6 +497,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 c075d0fa0c4..4b90cb59902 100644 |
|
--- a/gcc/fortran/resolve.c |
|
+++ b/gcc/fortran/resolve.c |
|
@@ -3915,7 +3915,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. */ |
|
@@ -3975,6 +3974,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 |
|
@@ -3987,6 +4002,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. */ |
|
|
|
@@ -4072,6 +4103,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); |
|
@@ -4108,6 +4145,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; |
|
@@ -4158,6 +4202,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; |
|
@@ -4198,6 +4245,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.27.0 |
|
|
|
|