From 221061a76024a0014c26bd5c82069f4167e79468 Mon Sep 17 00:00:00 2001 From: marxin Date: Tue, 28 Jun 2016 15:11:13 +0200 Subject: [PATCH 2/2] Optimize fortran loops with +-1 step. gcc/testsuite/ChangeLog: 2016-07-01 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. gcc/fortran/ChangeLog: 2016-07-01 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. --- gcc/fortran/lang.opt | 4 + gcc/fortran/resolve.c | 23 ++++++ gcc/fortran/trans-stmt.c | 117 ++++++++++++++------------- 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 +- 10 files changed, 136 insertions(+), 66 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/lang.opt b/gcc/fortran/lang.opt index bdf5fa5..8f8b299 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 4378313..1fc540a 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 389fa5e..d6fb620 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/gfortran.dg/do_1.f90 b/gcc/testsuite/gfortran.dg/do_1.f90 index b041279..b1db8c6 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 eb4751d..0f2c315 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 0000000..87850cf --- /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 0000000..71edace --- /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 0000000..07484d3 --- /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 ea3990d..2030328 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 94826fa..926d8f3 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.8.4