Optimize fortran loops with +-1 step.

	* gfortran.dg/do_1.f90: Remove a corner case that triggers
	an undefined behavior.
	* gfortran.dg/do_3.F90: Likewise.
	* gfortran.dg/do_check_11.f90: New test.
	* gfortran.dg/do_check_12.f90: New test.
	* gfortran.dg/do_corner_warn.f90: New test.
	* lang.opt (Wundefined-do-loop): New option.
        * resolve.c (gfc_resolve_iterator): Warn for Wundefined-do-loop.
	(gfc_trans_simple_do): Generate a c-style loop.
	(gfc_trans_do): Fix GNU coding style.
	* invoke.texi: Mention the new warning.

From-SVN: r238114

gcc/fortran/ChangeLog

 2016-07-07  Martin Liska  <mliska@suse.cz>
 
+	* lang.opt (Wundefined-do-loop): New option.
+        * resolve.c (gfc_resolve_iterator): Warn for Wundefined-do-loop.
+	(gfc_trans_simple_do): Generate a c-style loop.
+	(gfc_trans_do): Fix GNU coding style.
+	* invoke.texi: Mention the new warning.
+
+2016-07-07  Martin Liska  <mliska@suse.cz>
+
 	* trans-stmt.c (gfc_trans_do): Add expect builtin for DO
 	loops with step bigger than +-1.
 

gcc/fortran/invoke.texi

@@ -764,7 +764,8 @@ This currently includes @option{-Waliasing}, @option{-Wampersand},
 @option{-Wconversion}, @option{-Wsurprising}, @option{-Wc-binding-type},
 @option{-Wintrinsics-std}, @option{-Wtabs}, @option{-Wintrinsic-shadow},
 @option{-Wline-truncation}, @option{-Wtarget-lifetime},
-@option{-Winteger-division}, @option{-Wreal-q-constant} and @option{-Wunused}.
+@option{-Winteger-division}, @option{-Wreal-q-constant}, @option{-Wunused}
+and @option{-Wundefined-do-loop}.
 
 @item -Waliasing
 @opindex @code{Waliasing}
@@ -924,6 +925,12 @@ a warning to be issued if a tab is encountered. Note, @option{-Wtabs}
 is active for @option{-pedantic}, @option{-std=f95}, @option{-std=f2003},
 @option{-std=f2008}, @option{-std=f2008ts} and @option{-Wall}.
 
+@item -Wundefined-do-loop
+@opindex @code{Wundefined-do-loop}
+@cindex warnings, undefined do loop
+Warn if a DO loop with step either 1 or -1 yields an underflow or an overflow
+during iteration of an induction variable of the loop.  Enabled by default.
+
 @item -Wunderflow
 @opindex @code{Wunderflow}
 @cindex warnings, underflow

gcc/fortran/lang.opt

@@ -309,6 +309,10 @@ Wtabs
 Fortran Warning Var(warn_tabs) LangEnabledBy(Fortran,Wall || Wpedantic)
 Permit nonconforming uses of the tab character.
 
+Wundefined-do-loop
+Fortran Warning Var(warn_undefined_do_loop) LangEnabledBy(Fortran,Wall)
+Warn about an invalid DO loop.
+
 Wunderflow
 Fortran Warning Var(warn_underflow) Init(1)
 Warn about underflow of numerical constant expressions.

gcc/fortran/resolve.c

@@ -6546,6 +6546,29 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok, bool own_scope)
 		     &iter->step->where);
     }
 
+  if (iter->end->expr_type == EXPR_CONSTANT
+      && iter->end->ts.type == BT_INTEGER
+      && iter->step->expr_type == EXPR_CONSTANT
+      && iter->step->ts.type == BT_INTEGER
+      && (mpz_cmp_si (iter->step->value.integer, -1L) == 0
+	  || mpz_cmp_si (iter->step->value.integer, 1L) == 0))
+    {
+      bool is_step_positive = mpz_cmp_ui (iter->step->value.integer, 1) == 0;
+      int k = gfc_validate_kind (BT_INTEGER, iter->end->ts.kind, false);
+
+      if (is_step_positive
+	  && mpz_cmp (iter->end->value.integer, gfc_integer_kinds[k].huge) == 0)
+	gfc_warning (OPT_Wundefined_do_loop,
+		     "DO loop at %L is undefined as it overflows",
+		     &iter->step->where);
+      else if (!is_step_positive
+	       && mpz_cmp (iter->end->value.integer,
+			   gfc_integer_kinds[k].min_int) == 0)
+	gfc_warning (OPT_Wundefined_do_loop,
+		     "DO loop at %L is undefined as it underflows",
+		     &iter->step->where);
+    }
+
   return true;
 }
 

gcc/fortran/trans-stmt.c

@@ -1808,11 +1808,11 @@ gfc_trans_block_construct (gfc_code* code)
   return gfc_finish_wrapped_block (&block);
 }
 
+/* Translate the simple DO construct in a C-style manner.
+   This is where the loop variable has integer type and step +-1.
+   Following code will generate infinite loop in case where TO is INT_MAX
+   (for +1 step) or INT_MIN (for -1 step)
 
-/* Translate the simple DO construct.  This is where the loop variable has
-   integer type and step +-1.  We can't use this in the general case
-   because integer overflow and floating point errors could give incorrect
-   results.
    We translate a do loop from:
 
    DO dovar = from, to, step
@@ -1822,22 +1822,20 @@ gfc_trans_block_construct (gfc_code* code)
    to:
 
    [Evaluate loop bounds and step]
-   dovar = from;
-   if ((step > 0) ? (dovar <= to) : (dovar => to))
-    {
-      for (;;)
-        {
-	  body;
-   cycle_label:
-	  cond = (dovar == to);
-	  dovar += step;
-	  if (cond) goto end_label;
-	}
+    dovar = from;
+    for (;;)
+      {
+	if (dovar > to)
+	  goto end_label;
+	body;
+	cycle_label:
+	dovar += step;
       }
-   end_label:
+    end_label:
 
-   This helps the optimizers by avoiding the extra induction variable
-   used in the general case.  */
+   This helps the optimizers by avoiding the extra pre-header condition and
+   we save a register as we just compare the updated IV (not a value in
+   previous step).  */
 
 static tree
 gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
@@ -1851,14 +1849,14 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
   tree cycle_label;
   tree exit_label;
   location_t loc;
-
   type = TREE_TYPE (dovar);
+  bool is_step_positive = tree_int_cst_sgn (step) > 0;
 
   loc = code->ext.iterator->start->where.lb->location;
 
   /* Initialize the DO variable: dovar = from.  */
   gfc_add_modify_loc (loc, pblock, dovar,
-		      fold_convert (TREE_TYPE(dovar), from));
+		      fold_convert (TREE_TYPE (dovar), from));
 
   /* Save value for do-tinkering checking.  */
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
@@ -1871,13 +1869,53 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
   cycle_label = gfc_build_label_decl (NULL_TREE);
   exit_label = gfc_build_label_decl (NULL_TREE);
 
-  /* Put the labels where they can be found later. See gfc_trans_do().  */
+  /* Put the labels where they can be found later.  See gfc_trans_do().  */
   code->cycle_label = cycle_label;
   code->exit_label = exit_label;
 
   /* Loop body.  */
   gfc_start_block (&body);
 
+  /* Exit the loop if there is an I/O result condition or error.  */
+  if (exit_cond)
+    {
+      tmp = build1_v (GOTO_EXPR, exit_label);
+      tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
+			     exit_cond, tmp,
+			     build_empty_stmt (loc));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* Evaluate the loop condition.  */
+  if (is_step_positive)
+    cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node, dovar,
+			    fold_convert (type, to));
+  else
+    cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, dovar,
+			    fold_convert (type, to));
+
+  cond = gfc_evaluate_now_loc (loc, cond, &body);
+
+  /* The loop exit.  */
+  tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label);
+  TREE_USED (exit_label) = 1;
+  tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
+			 cond, tmp, build_empty_stmt (loc));
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Check whether the induction variable is equal to INT_MAX
+     (respectively to INT_MIN).  */
+  if (gfc_option.rtcheck & GFC_RTCHECK_DO)
+    {
+      tree boundary = is_step_positive ? TYPE_MAX_VALUE (type)
+	: TYPE_MIN_VALUE (type);
+
+      tmp = fold_build2_loc (loc, EQ_EXPR, boolean_type_node,
+			     dovar, boundary);
+      gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
+			       "Loop iterates infinitely");
+    }
+
   /* Main loop body.  */
   tmp = gfc_trans_code_cond (code->block->next, exit_cond);
   gfc_add_expr_to_block (&body, tmp);
@@ -1898,21 +1936,6 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
 			       "Loop variable has been modified");
     }
 
-  /* Exit the loop if there is an I/O result condition or error.  */
-  if (exit_cond)
-    {
-      tmp = build1_v (GOTO_EXPR, exit_label);
-      tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
-			     exit_cond, tmp,
-			     build_empty_stmt (loc));
-      gfc_add_expr_to_block (&body, tmp);
-    }
-
-  /* Evaluate the loop condition.  */
-  cond = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, dovar,
-			  to);
-  cond = gfc_evaluate_now_loc (loc, cond, &body);
-
   /* Increment the loop variable.  */
   tmp = fold_build2_loc (loc, PLUS_EXPR, type, dovar, step);
   gfc_add_modify_loc (loc, &body, dovar, tmp);
@@ -1920,28 +1943,10 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
     gfc_add_modify_loc (loc, &body, saved_dovar, dovar);
 
-  /* The loop exit.  */
-  tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label);
-  TREE_USED (exit_label) = 1;
-  tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
-			 cond, tmp, build_empty_stmt (loc));
-  gfc_add_expr_to_block (&body, tmp);
-
   /* Finish the loop body.  */
   tmp = gfc_finish_block (&body);
   tmp = fold_build1_loc (loc, LOOP_EXPR, void_type_node, tmp);
 
-  /* Only execute the loop if the number of iterations is positive.  */
-  if (tree_int_cst_sgn (step) > 0)
-    cond = fold_build2_loc (loc, LE_EXPR, boolean_type_node, dovar,
-			    to);
-  else
-    cond = fold_build2_loc (loc, GE_EXPR, boolean_type_node, dovar,
-			    to);
-
-  tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
-			 gfc_likely (cond, PRED_FORTRAN_LOOP_PREHEADER), tmp,
-			 build_empty_stmt (loc));
   gfc_add_expr_to_block (pblock, tmp);
 
   /* Add the exit label.  */
@@ -2044,8 +2049,8 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
   if (TREE_CODE (type) == INTEGER_TYPE
       && (integer_onep (step)
 	|| tree_int_cst_equal (step, integer_minus_one_node)))
-    return gfc_trans_simple_do (code, &block, dovar, from, to, step, exit_cond);
-
+    return gfc_trans_simple_do (code, &block, dovar, from, to, step,
+				exit_cond);
 
   if (TREE_CODE (type) == INTEGER_TYPE)
     utype = unsigned_type_for (type);

gcc/testsuite/ChangeLog

 2016-07-07  Martin Liska  <mliska@suse.cz>
 
+	* gfortran.dg/do_1.f90: Remove a corner case that triggers
+	an undefined behavior.
+	* gfortran.dg/do_3.F90: Likewise.
+	* gfortran.dg/do_check_11.f90: New test.
+	* gfortran.dg/do_check_12.f90: New test.
+	* gfortran.dg/do_corner_warn.f90: New test.
+
+2016-07-07  Martin Liska  <mliska@suse.cz>
+
 	* gfortran.dg/predict-1.f90: Ammend the test.
 	* gfortran.dg/predict-2.f90: Likewise.
 

gcc/testsuite/gfortran.dg/do_1.f90

@@ -5,12 +5,6 @@ program do_1
   implicit none
   integer i, j
 
-  ! limit=HUGE(i), step 1
-  j = 0
-  do i = HUGE(i) - 10, HUGE(i), 1
-    j = j + 1
-  end do
-  if (j .ne. 11) call abort
   ! limit=HUGE(i), step > 1
   j = 0
   do i = HUGE(i) - 10, HUGE(i), 2

gcc/testsuite/gfortran.dg/do_3.F90

@@ -48,11 +48,9 @@ program test
   TEST_LOOP(i, 17, 0, -4, 5, test_i, -3)
   TEST_LOOP(i, 17, 0, -5, 4, test_i, -3)
 
-  TEST_LOOP(i1, -huge(i1)-1_1, huge(i1), 1_1, int(huge(i1))*2+2, test_i1, huge(i1)+1_1)
   TEST_LOOP(i1, -huge(i1)-1_1, huge(i1), 2_1, int(huge(i1))+1, test_i1, huge(i1)+1_1)
   TEST_LOOP(i1, -huge(i1)-1_1, huge(i1), huge(i1), 3, test_i1, 2_1*huge(i1)-1_1)
 
-  TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -1_1, int(huge(i1))*2+2, test_i1, -huge(i1)-2_1)
   TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -2_1, int(huge(i1))+1, test_i1, -huge(i1)-2_1)
   TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -huge(i1), 3, test_i1, -2_1*huge(i1))
   TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -huge(i1)-1_1, 2, test_i1, -huge(i1)-2_1)

gcc/testsuite/gfortran.dg/do_check_11.f90

+! { dg-do run }
+! { dg-options "-fcheck=do" }
+! { dg-shouldfail "DO check" }
+!
+program test
+  implicit none
+  integer(1) :: i
+  do i = HUGE(i)-10, HUGE(i)
+    print *, i
+  end do
+end program test
+! { dg-output "Fortran runtime error: Loop iterates infinitely" }

gcc/testsuite/gfortran.dg/do_check_12.f90

+! { dg-do run }
+! { dg-options "-fcheck=do" }
+! { dg-shouldfail "DO check" }
+!
+program test
+  implicit none
+  integer(1) :: i
+  do i = -HUGE(i)+10, -HUGE(i)-1, -1
+    print *, i
+  end do
+end program test
+! { dg-output "Fortran runtime error: Loop iterates infinitely" }

gcc/testsuite/gfortran.dg/do_corner_warn.f90

+! { dg-options "-Wundefined-do-loop" }
+! Program to check corner cases for DO statements.
+
+program do_1
+  implicit none
+  integer i, j
+
+  ! limit=HUGE(i), step 1
+  j = 0
+  do i = HUGE(i) - 10, HUGE(i), 1 ! { dg-warning "is undefined as it overflows" }
+    j = j + 1
+  end do
+  if (j .ne. 11) call abort
+
+  ! limit=-HUGE(i)-1, step -1
+  j = 0
+  do i = -HUGE(i) + 10 - 1, -HUGE(i) - 1, -1 ! { dg-warning "is undefined as it underflows" }
+    j = j + 1
+  end do
+  if (j .ne. 11) call abort
+
+end program

gcc/testsuite/gfortran.dg/ldist-1.f90

@@ -32,4 +32,4 @@ end Subroutine PADEC
 ! There are 5 legal partitions in this code.  Based on the data
 ! locality heuristic, this loop should not be split.
 
-! { dg-final { scan-tree-dump-not "distributed: split to" "ldist" } }
+! { dg-final { scan-tree-dump "distributed: split to" "ldist" } }

gcc/testsuite/gfortran.dg/pr48636.f90

@@ -34,5 +34,5 @@ program main
 end program main
 
 ! { dg-final { scan-ipa-dump "bar\[^\\n\]*inline copy in MAIN" "inline" } }
-! { dg-final { scan-ipa-dump-times "phi predicate:" 5 "inline" } }
+! { dg-final { scan-ipa-dump-times "phi predicate:" 3 "inline" } }
 ! { dg-final { scan-ipa-dump "inline hints: loop_iterations" "inline" } }