From 1c122092dcf48801c638abdf070f18c6fe025ad6 Mon Sep 17 00:00:00 2001 From: Martin Liska Date: Thu, 7 Jul 2016 15:15:39 +0200 Subject: [PATCH] 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 | 8 ++ gcc/fortran/invoke.texi | 9 +- gcc/fortran/lang.opt | 4 + gcc/fortran/resolve.c | 23 ++++ gcc/fortran/trans-stmt.c | 117 ++++++++++--------- gcc/testsuite/ChangeLog | 9 ++ gcc/testsuite/gfortran.dg/do_1.f90 | 6 - gcc/testsuite/gfortran.dg/do_3.F90 | 2 - gcc/testsuite/gfortran.dg/do_check_11.f90 | 12 ++ gcc/testsuite/gfortran.dg/do_check_12.f90 | 12 ++ gcc/testsuite/gfortran.dg/do_corner_warn.f90 | 22 ++++ gcc/testsuite/gfortran.dg/ldist-1.f90 | 2 +- gcc/testsuite/gfortran.dg/pr48636.f90 | 2 +- 13 files changed, 161 insertions(+), 67 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/do_check_11.f90 create mode 100644 gcc/testsuite/gfortran.dg/do_check_12.f90 create mode 100644 gcc/testsuite/gfortran.dg/do_corner_warn.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 983e75f5f6d..f4d84e85557 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2016-07-07 Martin Liska + + * 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 * trans-stmt.c (gfc_trans_do): Add expect builtin for DO diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index e8b8409319e..c0be1abf21f 100644 --- a/gcc/fortran/invoke.texi +++ b/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 diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index bdf5fa5fb4a..8f8b299bf1f 100644 --- a/gcc/fortran/lang.opt +++ b/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. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 43783139752..1fc540a1f0e 100644 --- a/gcc/fortran/resolve.c +++ b/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; } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index ad88273c876..6e4e2a79029 100644 --- a/gcc/fortran/trans-stmt.c +++ b/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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index cdc7c06ecbe..d0575d9a3b3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2016-07-07 Martin Liska + + * 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 * gfortran.dg/predict-1.f90: Ammend the test. diff --git a/gcc/testsuite/gfortran.dg/do_1.f90 b/gcc/testsuite/gfortran.dg/do_1.f90 index b041279f6d9..b1db8c6fe27 100644 --- a/gcc/testsuite/gfortran.dg/do_1.f90 +++ b/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 diff --git a/gcc/testsuite/gfortran.dg/do_3.F90 b/gcc/testsuite/gfortran.dg/do_3.F90 index eb4751d6b06..0f2c315f874 100644 --- a/gcc/testsuite/gfortran.dg/do_3.F90 +++ b/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) diff --git a/gcc/testsuite/gfortran.dg/do_check_11.f90 b/gcc/testsuite/gfortran.dg/do_check_11.f90 new file mode 100644 index 00000000000..87850cf40eb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_check_11.f90 @@ -0,0 +1,12 @@ +! { 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" } diff --git a/gcc/testsuite/gfortran.dg/do_check_12.f90 b/gcc/testsuite/gfortran.dg/do_check_12.f90 new file mode 100644 index 00000000000..71edace0fd8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_check_12.f90 @@ -0,0 +1,12 @@ +! { 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" } diff --git a/gcc/testsuite/gfortran.dg/do_corner_warn.f90 b/gcc/testsuite/gfortran.dg/do_corner_warn.f90 new file mode 100644 index 00000000000..07484d3ca7b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_corner_warn.f90 @@ -0,0 +1,22 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/ldist-1.f90 b/gcc/testsuite/gfortran.dg/ldist-1.f90 index ea3990d12b4..203032859b5 100644 --- a/gcc/testsuite/gfortran.dg/ldist-1.f90 +++ b/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" } } diff --git a/gcc/testsuite/gfortran.dg/pr48636.f90 b/gcc/testsuite/gfortran.dg/pr48636.f90 index 94826fa4790..926d8f3fc5a 100644 --- a/gcc/testsuite/gfortran.dg/pr48636.f90 +++ b/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" } } -- 2.30.2