gcc/gcc13-fortran-fdec-non-logical-if.patch

From cc87ddb841017bb0976b05091733609ee17d7f05 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Fri, 22 Jan 2021 13:15:17 +0000
Subject: [PATCH 07/10] Allow non-logical expressions in IF statements

Use -fdec-non-logical-if to enable feature. Also enabled using -fdec.
---
 gcc/fortran/lang.opt                          |  4 ++
 gcc/fortran/options.cc                        |  1 +
 gcc/fortran/resolve.cc                        | 60 ++++++++++++++++---
 ...gical_expressions_if_statements_blocks_1.f | 25 ++++++++
 ...gical_expressions_if_statements_blocks_2.f | 25 ++++++++
 ...gical_expressions_if_statements_blocks_3.f | 25 ++++++++
 ...gical_expressions_if_statements_blocks_4.f | 45 ++++++++++++++
 ...gical_expressions_if_statements_blocks_5.f | 45 ++++++++++++++
 ...gical_expressions_if_statements_blocks_6.f | 45 ++++++++++++++
 9 files changed, 266 insertions(+), 9 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_2.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f

diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 4a269ebb22d..d886c2f33ed 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -506,6 +506,10 @@ fdec-override-kind
 Fortran Var(flag_dec_override_kind)
 Enable support for per variable kind specification.
 
+fdec-non-logical-if
+Fortran Var(flag_dec_non_logical_if)
+Enable support for non-logical expressions in if statements.
+
 fdec-structure
 Fortran Var(flag_dec_structure)
 Enable support for DEC STRUCTURE/RECORD.
diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
index edbab483b36..a946c86790a 100644
--- a/gcc/fortran/options.cc
+++ b/gcc/fortran/options.cc
@@ -79,6 +79,7 @@ set_dec_flags (int value)
   SET_BITFLAG (flag_dec_char_conversions, value, value);
   SET_BITFLAG (flag_dec_duplicates, value, value);
   SET_BITFLAG (flag_dec_override_kind, value, value);
+  SET_BITFLAG (flag_dec_non_logical_if, value, value);
 }
 
 /* Finalize DEC flags.  */
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index bc0df0fdb99..07dd039f3bf 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10789,10 +10789,31 @@ 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 (flag_dec_non_logical_if && 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;
+		  if (warn_conversion_extra)
+		    {
+		      gfc_warning (OPT_Wconversion_extra, "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:
@@ -12093,11 +12114,32 @@ 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 (flag_dec_non_logical_if
+		  && 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;
+		  if (warn_conversion_extra)
+		    {
+		      gfc_warning (OPT_Wconversion_extra, "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_1.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f
new file mode 100644
index 00000000000..0101db893ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fdec -Wconversion-extra" }
+!
+! Allow logical expressions in if statements and blocks
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+        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
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..876f4e09508
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_2.f
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fdec-non-logical-if -Wconversion-extra" }
+!
+! Allow logical expressions in if statements and blocks
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+        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
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f
new file mode 100644
index 00000000000..35cb4c51b8d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-non-logical-if" }
+!
+! Allow logical expressions in if statements and blocks
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+        PROGRAM logical_exp_if_st_bl
+          INTEGER ipos/1/
+          INTEGER ineg/0/
+
+          ! Test non logical variables
+          if (ineg) STOP 1 ! { dg-error "IF clause at" }
+          if (0) STOP 2 ! { dg-error "IF clause at" }
+
+          ! Test non logical expressions in if statements
+          if (MOD(ipos, 1)) STOP 3 ! { dg-error "IF clause at" }
+
+          ! Test non logical expressions in if blocks
+          if (MOD(2 * ipos, 2)) then ! { dg-error "IF clause at" }
+            STOP 4
+          endif
+        END
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f
new file mode 100644
index 00000000000..7b60b60827f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f
@@ -0,0 +1,45 @@
+! { dg-do run }
+! { dg-options "-fdec -Wconversion-extra" }
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+       function othersub1()
+        integer*4 othersub1
+        othersub1 = 9
+       end
+
+       function othersub2()
+        integer*4 othersub2
+        othersub2 = 0
+       end
+
+       program MAIN
+        integer*4 othersub1
+        integer*4 othersub2
+        integer a /1/
+        integer b /2/        
+ 
+        if (othersub1()) then ! { dg-warning "if it evaluates to nonzero" }
+           write(*,*) "OK"
+        else
+           stop 1
+        end if
+        if (othersub2()) then ! { dg-warning "if it evaluates to nonzero" }
+           stop 2
+        else
+           write(*,*) "OK"
+        end if
+        if (a-b) then ! { dg-warning "if it evaluates to nonzero" }
+           write(*,*) "OK"
+        else
+           stop 3
+        end if
+        if (b-(a+1)) then ! { dg-warning "if it evaluates to nonzero" }
+           stop 3
+        else
+           write(*,*) "OK"
+        end if
+       end
+
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f
new file mode 100644
index 00000000000..80336f48ca1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f
@@ -0,0 +1,45 @@
+! { dg-do run }
+! { dg-options "-fdec-non-logical-if -Wconversion-extra" }
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+       function othersub1()
+        integer*4 othersub1
+        othersub1 = 9
+       end
+
+       function othersub2()
+        integer*4 othersub2
+        othersub2 = 0
+       end
+
+       program MAIN
+        integer*4 othersub1
+        integer*4 othersub2
+        integer a /1/
+        integer b /2/        
+ 
+        if (othersub1()) then ! { dg-warning "Non-LOGICAL type in IF statement" }
+           write(*,*) "OK"
+        else
+           stop 1
+        end if
+        if (othersub2()) then ! { dg-warning "Non-LOGICAL type in IF statement" }
+           stop 2
+        else
+           write(*,*) "OK"
+        end if
+        if (a-b) then ! { dg-warning "Non-LOGICAL type in IF statement" }
+           write(*,*) "OK"
+        else
+           stop 3
+        end if
+        if (b-(a+1)) then ! { dg-warning "Non-LOGICAL type in IF statement" }
+           stop 3
+        else
+           write(*,*) "OK"
+        end if
+       end
+
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f
new file mode 100644
index 00000000000..e1125ca717a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-non-logical-if" }
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+       function othersub1()
+        integer*4 othersub1
+        othersub1 = 9
+       end
+
+       function othersub2()
+        integer*4 othersub2
+        othersub2 = 0
+       end
+
+       program MAIN
+        integer*4 othersub1
+        integer*4 othersub2
+        integer a /1/
+        integer b /2/        
+ 
+        if (othersub1()) then ! { dg-error "IF clause at" }
+           write(*,*) "OK"
+        else
+           stop 1
+        end if
+        if (othersub2()) then ! { dg-error "IF clause at" }
+           stop 2
+        else
+           write(*,*) "OK"
+        end if
+        if (a-b) then ! { dg-error "IF clause at" }
+           write(*,*) "OK"
+        else
+           stop 3
+        end if
+        if (b-(a+1)) then ! { dg-error "IF clause at" }
+           stop 3
+        else
+           write(*,*) "OK"
+        end if
+       end
+
-- 
2.27.0