Blob Blame History Raw
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
+