Hello world,

here is an update for the fix for PR 92961, which also takes care
of the second test case in the PR (included in the first one).

The patch itself should be clear enough - make sure that there
is a MATCH_ERROR on matching an array spec which contains 0/(0).
Rather than pass around information several calls deep, I chose
to use a global variable.

Regression-tested. OK for trunk?

(Only a few bugs to fix to be at least below 900 bugs at the end
of the year, by the way - we are at 389 submitted bugs vs. 461 closed,
which is not bad).

Regards

        Thomas

2019-12-22  Thomas Koenig  <tkoe...@gcc.gnu.org>

        PR fortran/92961
        * gfortran.h (gfc_seen_div0): Add declaration.
        * arith.h (gfc_seen_div0): Add definition.
        (eval_intrinsic): For integer division by zero, set gfc_seen_div0.
        * decl.c (variable_decl):  If resolution resp. simplification
        fails for array spec and a division of zero error has been
        seen, return MATCH_ERROR.

2019-12-22  Thomas Koenig  <tkoe...@gcc.gnu.org>

        PR fortran/92961
        * gfortran.dg/arith_divide_2.f90: New test.
Index: gfortran.h
===================================================================
--- gfortran.h	(Revision 279639)
+++ gfortran.h	(Arbeitskopie)
@@ -2995,6 +2995,8 @@ void gfc_arith_done_1 (void);
 arith gfc_check_integer_range (mpz_t p, int kind);
 bool gfc_check_character_range (gfc_char_t, int);
 
+extern bool gfc_seen_div0;
+
 /* trans-types.c */
 bool gfc_check_any_c_kind (gfc_typespec *);
 int gfc_validate_kind (bt, int, bool);
Index: arith.c
===================================================================
--- arith.c	(Revision 279639)
+++ arith.c	(Arbeitskopie)
@@ -32,6 +32,8 @@ along with GCC; see the file COPYING3.  If not see
 #include "target-memory.h"
 #include "constructor.h"
 
+bool gfc_seen_div0;
+
 /* MPFR does not have a direct replacement for mpz_set_f() from GMP.
    It's easily implemented with a few calls though.  */
 
@@ -1620,6 +1622,10 @@ eval_intrinsic (gfc_intrinsic_op op,
       gfc_error (gfc_arith_error (rc), &op1->where);
       if (rc == ARITH_OVERFLOW)
 	goto done;
+
+      if (rc == ARITH_DIV0 && op2->ts.type == BT_INTEGER)
+	gfc_seen_div0 = true;
+
       return NULL;
     }
 
Index: decl.c
===================================================================
--- decl.c	(Revision 279639)
+++ decl.c	(Arbeitskopie)
@@ -2551,7 +2551,12 @@ variable_decl (int elem)
 	  for (int i = 0; i < as->rank; i++)
 	    {
 	      e = gfc_copy_expr (as->lower[i]);
-	      gfc_resolve_expr (e);
+	      if (!gfc_resolve_expr (e) && gfc_seen_div0)
+		{
+		  m = MATCH_ERROR;
+		  goto cleanup;
+		}
+
 	      gfc_simplify_expr (e, 0);
 	      if (e && (e->expr_type != EXPR_CONSTANT))
 		{
@@ -2561,7 +2566,12 @@ variable_decl (int elem)
 	      gfc_free_expr (e);
 
 	      e = gfc_copy_expr (as->upper[i]);
-	      gfc_resolve_expr (e);
+	      if (!gfc_resolve_expr (e)  && gfc_seen_div0)
+		{
+		  m = MATCH_ERROR;
+		  goto cleanup;
+		}
+
 	      gfc_simplify_expr (e, 0);
 	      if (e && (e->expr_type != EXPR_CONSTANT))
 		{
@@ -2587,7 +2597,12 @@ variable_decl (int elem)
 	      if (e->expr_type != EXPR_CONSTANT)
 		{
 		  n = gfc_copy_expr (e);
-		  gfc_simplify_expr (n, 1);
+		  if (!gfc_simplify_expr (n, 1)  && gfc_seen_div0) 
+		    {
+		      m = MATCH_ERROR;
+		      goto cleanup;
+		    }
+
 		  if (n->expr_type == EXPR_CONSTANT)
 		    gfc_replace_expr (e, n);
 		  else
@@ -2597,7 +2612,12 @@ variable_decl (int elem)
 	      if (e->expr_type != EXPR_CONSTANT)
 		{
 		  n = gfc_copy_expr (e);
-		  gfc_simplify_expr (n, 1);
+		  if (!gfc_simplify_expr (n, 1)  && gfc_seen_div0) 
+		    {
+		      m = MATCH_ERROR;
+		      goto cleanup;
+		    }
+		  
 		  if (n->expr_type == EXPR_CONSTANT)
 		    gfc_replace_expr (e, n);
 		  else
@@ -2934,6 +2954,7 @@ variable_decl (int elem)
 
 cleanup:
   /* Free stuff up and return.  */
+  gfc_seen_div0 = false;
   gfc_free_expr (initializer);
   gfc_free_array_spec (as);
 
! { dg-do compile }
! This used to ICE. Original test case by Gerhard Steinmetz.
program p
   integer :: a((0)/0)    ! { dg-error "Division by zero" }
   integer :: b(0/(0))    ! { dg-error "Division by zero" }
   integer :: c((0)/(0))  ! { dg-error "Division by zero" }
   integer :: d(0/0)      ! { dg-error "Division by zero" }
   integer :: x = ubound(a,1) ! { dg-error "must be an array" }
end

Reply via email to