Hello world,

the attached patch fixes an ICE on invalid, where the fact that
the step in do i = 1, 3, .1 is actually zero slipped through.

Regression-tested.  OK for all affected branches (trunk, 9 and 8)?

Regards

        Thomas

2019-09-15  Thomas Koenig  <tkoe...@gcc.gnu.org>

        PR fortran/91550
        * frontend-passes.c (do_subscript): If step equals
        zero, a previuos error has been reported; do nothing
        in this case.
        * resolve.c (gfc_resolve_iterator): Move error checking
        after type conversion.

2019-09-15  Thomas Koenig  <tkoe...@gcc.gnu.org>

        PR fortran/91550
        * gfortran.dg/do_subscript_6.f90: New test.


Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 275719)
+++ frontend-passes.c	(Arbeitskopie)
@@ -2578,6 +2578,7 @@ do_subscript (gfc_expr **e)
 	      bool have_do_start, have_do_end;
 	      bool error_not_proven;
 	      int warn;
+	      int sgn;
 
 	      dl = lp->c;
 	      if (dl == NULL)
@@ -2606,7 +2607,16 @@ do_subscript (gfc_expr **e)
 		 Do not warn in this case.  */
 
 	      if (dl->ext.iterator->step->expr_type == EXPR_CONSTANT)
-		mpz_init_set (do_step, dl->ext.iterator->step->value.integer);
+		{
+		  sgn = mpz_cmp_ui (dl->ext.iterator->step->value.integer, 0);
+		  /* This can happen, but then the error has been
+		     reported previusly.  */
+		  if (sgn == 0)
+		    continue;
+
+		  mpz_init_set (do_step, dl->ext.iterator->step->value.integer);
+		}
+
 	      else
 		continue;
 
@@ -2632,9 +2642,8 @@ do_subscript (gfc_expr **e)
 	      /* No warning inside a zero-trip loop.  */
 	      if (have_do_start && have_do_end)
 		{
-		  int sgn, cmp;
+		  int cmp;
 
-		  sgn = mpz_cmp_ui (do_step, 0);
 		  cmp = mpz_cmp (do_end, do_start);
 		  if ((sgn > 0 && cmp < 0) || (sgn < 0 && cmp > 0))
 		    break;
Index: resolve.c
===================================================================
--- resolve.c	(Revision 275719)
+++ resolve.c	(Arbeitskopie)
@@ -7105,6 +7105,19 @@ gfc_resolve_iterator (gfc_iterator *iter, bool rea
 				  "Step expression in DO loop"))
     return false;
 
+  /* Convert start, end, and step to the same type as var.  */
+  if (iter->start->ts.kind != iter->var->ts.kind
+      || iter->start->ts.type != iter->var->ts.type)
+    gfc_convert_type (iter->start, &iter->var->ts, 1);
+
+  if (iter->end->ts.kind != iter->var->ts.kind
+      || iter->end->ts.type != iter->var->ts.type)
+    gfc_convert_type (iter->end, &iter->var->ts, 1);
+
+  if (iter->step->ts.kind != iter->var->ts.kind
+      || iter->step->ts.type != iter->var->ts.type)
+    gfc_convert_type (iter->step, &iter->var->ts, 1);
+
   if (iter->step->expr_type == EXPR_CONSTANT)
     {
       if ((iter->step->ts.type == BT_INTEGER
@@ -7118,19 +7131,6 @@ gfc_resolve_iterator (gfc_iterator *iter, bool rea
 	}
     }
 
-  /* Convert start, end, and step to the same type as var.  */
-  if (iter->start->ts.kind != iter->var->ts.kind
-      || iter->start->ts.type != iter->var->ts.type)
-    gfc_convert_type (iter->start, &iter->var->ts, 1);
-
-  if (iter->end->ts.kind != iter->var->ts.kind
-      || iter->end->ts.type != iter->var->ts.type)
-    gfc_convert_type (iter->end, &iter->var->ts, 1);
-
-  if (iter->step->ts.kind != iter->var->ts.kind
-      || iter->step->ts.type != iter->var->ts.type)
-    gfc_convert_type (iter->step, &iter->var->ts, 1);
-
   if (iter->start->expr_type == EXPR_CONSTANT
       && iter->end->expr_type == EXPR_CONSTANT
       && iter->step->expr_type == EXPR_CONSTANT)
! { dg-do compile }
! { dg-options "-std=legacy" }
! PR 91550 - this used to cause an ICE
! Test case by Gerhard Steinmetz
program p
   real :: a(3)
   integer :: i
   do i = 1, 3, .1 ! { dg-error "cannot be zero" }
      a(i) = i
   end do
end

Reply via email to