From 99c791361468b61976d6054e1ec1c81fe43e6559 Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Wed, 11 Nov 2015 15:37:00 +0000
Subject: [PATCH 14/23] Allow non-logical expressions in IF statements
This feature is enabled by the `-std=extra-legacy` compiler flag.
---
0014-Allow-non-logical-expressions-in-IF-statements.patch
Allow non-logical expressions in IF statements
This feature is enabled by the `-std=extra-legacy` compiler flag.
Signed-off-by: Ben Brewer <ben.brewer@codethink.co.uk>
Signed-off-by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 33b441aa1bc..f979915e856 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9919,10 +9919,23 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
switch (b->op)
{
case EXEC_IF:
- if (t && b->expr1 != NULL
- && (b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0))
- gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
- &b->expr1->where);
+ if (t && b->expr1 != NULL)
+ {
+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY && b->expr1->ts.type != BT_LOGICAL)
+ {
+ gfc_expr* cast;
+ cast = gfc_ne (b->expr1, gfc_get_int_expr (1, &gfc_current_locus, 0), INTRINSIC_NE);
+ if (cast == NULL)
+ gfc_internal_error ("gfc_resolve_blocks(): Failed to cast to LOGICAL in IF");
+ b->expr1 = cast;
+ gfc_warning (0, "Non-LOGICAL type in IF statement condition %L"
+ " will be true if it evaluates to nonzero", &b->expr1->where);
+ }
+
+ if ((b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0))
+ gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
+ &b->expr1->where);
+ }
break;
case EXEC_WHERE:
@@ -11182,11 +11195,23 @@ start:
break;
case EXEC_IF:
- if (t && code->expr1 != NULL
- && (code->expr1->ts.type != BT_LOGICAL
- || code->expr1->rank != 0))
- gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
- &code->expr1->where);
+ if (t && code->expr1 != NULL)
+ {
+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY && code->expr1->ts.type != BT_LOGICAL)
+ {
+ gfc_expr* cast;
+ cast = gfc_ne (code->expr1, gfc_get_int_expr (1, &gfc_current_locus, 0), INTRINSIC_NE);
+ if (cast == NULL)
+ gfc_internal_error ("gfc_resolve_code(): Failed to cast to LOGICAL in IF");
+ code->expr1 = cast;
+ gfc_warning (0, "Non-LOGICAL type in IF statement condition %L"
+ " will be true if it evaluates to nonzero", &code->expr1->where);
+ }
+
+ if ((code->expr1->ts.type != BT_LOGICAL || code->expr1->rank != 0))
+ gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
+ &code->expr1->where);
+ }
break;
case EXEC_CALL:
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f
new file mode 100644
index 00000000000..ad23fcfc9af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+!
+! Allow logical expressions in if statements and blocks
+!
+ PROGRAM logical_exp_if_st_bl
+ INTEGER ipos/1/
+ INTEGER ineg/0/
+
+ ! Test non logical variables
+ if (ineg) STOP 1 ! { dg-warning "if it evaluates to nonzero" }
+ if (0) STOP 2 ! { dg-warning "if it evaluates to nonzero" }
+
+ ! Test non logical expressions in if statements
+ if (MOD(ipos, 1)) STOP 3 ! { dg-warning "if it evaluates to nonzero" }
+
+ ! Test non logical expressions in if blocks
+ if (MOD(2 * ipos, 2)) then ! { dg-warning "if it evaluates to nonzero" }
+ STOP 4
+ endif
+ END
commit cf72338b9468fad669b60600bcce7918a8d4591e
Author: Jeff Law <law@redhat.com>
Date: Tue Jun 5 15:45:41 2018 -0600
Additional test for
0014-Allow-non-logical-expressions-in-IF-statements.patch
"Allow non-logical expressions in IF statements"
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f
new file mode 100644
index 00000000000..7da6aaceec7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+
+ function othersub1()
+ integer*4 othersub1
+ othersub1 = 1
+ end
+ function othersub2()
+ integer*4 othersub2
+ othersub2 = 2
+ end
+ program MAIN
+ integer*4 othersub1
+ integer*4 othersub2
+c the if (integer) works here
+ if (othersub2()) then ! { dg-warning "" }
+ write (*,*), 'othersub2 is true'
+c but fails in the "else if"
+ else if (othersub1()) then ! { dg-warning "" }
+ write (*,*), 'othersub2 is false, othersub1 is true'
+ endif
+ end
+