re PR fortran/31399 (Wrong code for do loop with large interation count)
PR fortran/31399 * trans-stmt.c (gfc_trans_do): Handle large loop counts. * gfortran.dg/do_3.F90: New test. From-SVN: r124496
This commit is contained in:
Francois-Xavier Coudert
François-Xavier Coudert
parent
2f8e3bd7bd
commit
5d148c0881
|
|
@ -1,3 +1,8 @@
|
|||
2007-05-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||
|
||||
PR fortran/31399
|
||||
* trans-stmt.c (gfc_trans_do): Handle large loop counts.
|
||||
|
||||
2007-05-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||
|
||||
PR fortran/31764
|
||||
|
|
|
|||
|
|
@ -809,22 +809,22 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
|
|||
to:
|
||||
|
||||
[evaluate loop bounds and step]
|
||||
count = (to + step - from) / step;
|
||||
empty = (step > 0 ? to < from : to > from);
|
||||
countm1 = (to - from) / step;
|
||||
dovar = from;
|
||||
if (empty) goto exit_label;
|
||||
for (;;)
|
||||
{
|
||||
body;
|
||||
cycle_label:
|
||||
dovar += step
|
||||
count--;
|
||||
if (count <=0) goto exit_label;
|
||||
countm1--;
|
||||
if (countm1 ==0) goto exit_label;
|
||||
}
|
||||
exit_label:
|
||||
|
||||
TODO: Large loop counts
|
||||
The code above assumes the loop count fits into a signed integer kind,
|
||||
i.e. Does not work for loop counts > 2^31 for integer(kind=4) variables
|
||||
We must support the full range. */
|
||||
countm1 is an unsigned integer. It is equal to the loop count minus one,
|
||||
because the loop count itself can overflow. */
|
||||
|
||||
tree
|
||||
gfc_trans_do (gfc_code * code)
|
||||
|
|
@ -834,13 +834,15 @@ gfc_trans_do (gfc_code * code)
|
|||
tree from;
|
||||
tree to;
|
||||
tree step;
|
||||
tree count;
|
||||
tree count_one;
|
||||
tree empty;
|
||||
tree countm1;
|
||||
tree type;
|
||||
tree utype;
|
||||
tree cond;
|
||||
tree cycle_label;
|
||||
tree exit_label;
|
||||
tree tmp;
|
||||
tree pos_step;
|
||||
stmtblock_t block;
|
||||
stmtblock_t body;
|
||||
|
||||
|
|
@ -874,47 +876,58 @@ gfc_trans_do (gfc_code * code)
|
|||
|| tree_int_cst_equal (step, integer_minus_one_node)))
|
||||
return gfc_trans_simple_do (code, &block, dovar, from, to, step);
|
||||
|
||||
/* Initialize loop count. This code is executed before we enter the
|
||||
loop body. We generate: count = (to + step - from) / step. */
|
||||
/* We need a special check for empty loops:
|
||||
empty = (step > 0 ? to < from : to > from); */
|
||||
pos_step = fold_build2 (GT_EXPR, boolean_type_node, step,
|
||||
fold_convert (type, integer_zero_node));
|
||||
empty = fold_build3 (COND_EXPR, boolean_type_node, pos_step,
|
||||
fold_build2 (LT_EXPR, boolean_type_node, to, from),
|
||||
fold_build2 (GT_EXPR, boolean_type_node, to, from));
|
||||
|
||||
tmp = fold_build2 (MINUS_EXPR, type, step, from);
|
||||
tmp = fold_build2 (PLUS_EXPR, type, to, tmp);
|
||||
/* Initialize loop count. This code is executed before we enter the
|
||||
loop body. We generate: countm1 = abs(to - from) / abs(step). */
|
||||
if (TREE_CODE (type) == INTEGER_TYPE)
|
||||
{
|
||||
tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step);
|
||||
count = gfc_create_var (type, "count");
|
||||
tree ustep;
|
||||
|
||||
utype = gfc_unsigned_type (type);
|
||||
|
||||
/* tmp = abs(to - from) / abs(step) */
|
||||
ustep = fold_convert (utype, fold_build1 (ABS_EXPR, type, step));
|
||||
tmp = fold_build3 (COND_EXPR, type, pos_step,
|
||||
fold_build2 (MINUS_EXPR, type, to, from),
|
||||
fold_build2 (MINUS_EXPR, type, from, to));
|
||||
tmp = fold_build2 (TRUNC_DIV_EXPR, utype, fold_convert (utype, tmp),
|
||||
ustep);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* TODO: We could use the same width as the real type.
|
||||
This would probably cause more problems that it solves
|
||||
when we implement "long double" types. */
|
||||
utype = gfc_unsigned_type (gfc_array_index_type);
|
||||
tmp = fold_build2 (MINUS_EXPR, type, to, from);
|
||||
tmp = fold_build2 (RDIV_EXPR, type, tmp, step);
|
||||
tmp = fold_build1 (FIX_TRUNC_EXPR, gfc_array_index_type, tmp);
|
||||
count = gfc_create_var (gfc_array_index_type, "count");
|
||||
tmp = fold_build1 (FIX_TRUNC_EXPR, utype, tmp);
|
||||
}
|
||||
gfc_add_modify_expr (&block, count, tmp);
|
||||
|
||||
count_one = build_int_cst (TREE_TYPE (count), 1);
|
||||
|
||||
/* Initialize the DO variable: dovar = from. */
|
||||
gfc_add_modify_expr (&block, dovar, from);
|
||||
|
||||
/* Loop body. */
|
||||
gfc_start_block (&body);
|
||||
countm1 = gfc_create_var (utype, "countm1");
|
||||
gfc_add_modify_expr (&block, countm1, tmp);
|
||||
|
||||
/* Cycle and exit statements are implemented with gotos. */
|
||||
cycle_label = gfc_build_label_decl (NULL_TREE);
|
||||
exit_label = gfc_build_label_decl (NULL_TREE);
|
||||
|
||||
/* Start with the loop condition. Loop until count <= 0. */
|
||||
cond = fold_build2 (LE_EXPR, boolean_type_node, count,
|
||||
build_int_cst (TREE_TYPE (count), 0));
|
||||
tmp = build1_v (GOTO_EXPR, exit_label);
|
||||
TREE_USED (exit_label) = 1;
|
||||
tmp = fold_build3 (COND_EXPR, void_type_node,
|
||||
cond, tmp, build_empty_stmt ());
|
||||
gfc_add_expr_to_block (&body, tmp);
|
||||
|
||||
/* Initialize the DO variable: dovar = from. */
|
||||
gfc_add_modify_expr (&block, dovar, from);
|
||||
|
||||
/* If the loop is empty, go directly to the exit label. */
|
||||
tmp = fold_build3 (COND_EXPR, void_type_node, empty,
|
||||
build1_v (GOTO_EXPR, exit_label), build_empty_stmt ());
|
||||
gfc_add_expr_to_block (&block, tmp);
|
||||
|
||||
/* Loop body. */
|
||||
gfc_start_block (&body);
|
||||
|
||||
/* Put these labels where they can be found later. We put the
|
||||
labels in a TREE_LIST node (because TREE_CHAIN is already
|
||||
|
|
@ -934,13 +947,21 @@ gfc_trans_do (gfc_code * code)
|
|||
gfc_add_expr_to_block (&body, tmp);
|
||||
}
|
||||
|
||||
/* End with the loop condition. Loop until countm1 == 0. */
|
||||
cond = fold_build2 (EQ_EXPR, boolean_type_node, countm1,
|
||||
build_int_cst (utype, 0));
|
||||
tmp = build1_v (GOTO_EXPR, exit_label);
|
||||
tmp = fold_build3 (COND_EXPR, void_type_node,
|
||||
cond, tmp, build_empty_stmt ());
|
||||
gfc_add_expr_to_block (&body, tmp);
|
||||
|
||||
/* Increment the loop variable. */
|
||||
tmp = build2 (PLUS_EXPR, type, dovar, step);
|
||||
gfc_add_modify_expr (&body, dovar, tmp);
|
||||
|
||||
/* Decrement the loop count. */
|
||||
tmp = build2 (MINUS_EXPR, TREE_TYPE (count), count, count_one);
|
||||
gfc_add_modify_expr (&body, count, tmp);
|
||||
tmp = build2 (MINUS_EXPR, utype, countm1, build_int_cst (utype, 1));
|
||||
gfc_add_modify_expr (&body, countm1, tmp);
|
||||
|
||||
/* End of loop body. */
|
||||
tmp = gfc_finish_block (&body);
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
2007-05-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||
|
||||
PR fortran/31399
|
||||
* gfortran.dg/do_3.F90: New test.
|
||||
|
||||
2007-05-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||
|
||||
PR fortran/31764
|
||||
|
|
|
|||
|
|
@ -0,0 +1,110 @@
|
|||
! { dg-do run }
|
||||
! { dg-options "-std=legacy -ffree-line-length-none" }
|
||||
program test
|
||||
integer :: count
|
||||
integer :: i
|
||||
integer(kind=1) :: i1
|
||||
real :: r
|
||||
|
||||
#define TEST_LOOP(var,from,to,step,total,test) \
|
||||
count = 0 ; do var = from, to, step ; count = count + 1 ; end do ; \
|
||||
if (count /= total) call abort ; \
|
||||
if (test (from, to, step) /= total) call abort
|
||||
|
||||
! Integer loops
|
||||
TEST_LOOP(i, 0, 0, 1, 1, test_i)
|
||||
TEST_LOOP(i, 0, 0, 2, 1, test_i)
|
||||
TEST_LOOP(i, 0, 0, -1, 1, test_i)
|
||||
TEST_LOOP(i, 0, 0, -2, 1, test_i)
|
||||
|
||||
TEST_LOOP(i, 0, 1, 1, 2, test_i)
|
||||
TEST_LOOP(i, 0, 1, 2, 1, test_i)
|
||||
TEST_LOOP(i, 0, 1, 3, 1, test_i)
|
||||
TEST_LOOP(i, 0, 1, huge(0), 1, test_i)
|
||||
TEST_LOOP(i, 0, 1, -1, 0, test_i)
|
||||
TEST_LOOP(i, 0, 1, -2, 0, test_i)
|
||||
TEST_LOOP(i, 0, 1, -3, 0, test_i)
|
||||
TEST_LOOP(i, 0, 1, -huge(0), 0, test_i)
|
||||
TEST_LOOP(i, 0, 1, -huge(0)-1, 0, test_i)
|
||||
|
||||
TEST_LOOP(i, 1, 0, 1, 0, test_i)
|
||||
TEST_LOOP(i, 1, 0, 2, 0, test_i)
|
||||
TEST_LOOP(i, 1, 0, 3, 0, test_i)
|
||||
TEST_LOOP(i, 1, 0, huge(0), 0, test_i)
|
||||
TEST_LOOP(i, 1, 0, -1, 2, test_i)
|
||||
TEST_LOOP(i, 1, 0, -2, 1, test_i)
|
||||
TEST_LOOP(i, 1, 0, -3, 1, test_i)
|
||||
TEST_LOOP(i, 1, 0, -huge(0), 1, test_i)
|
||||
TEST_LOOP(i, 1, 0, -huge(0)-1, 1, test_i)
|
||||
|
||||
TEST_LOOP(i, 0, 17, 1, 18, test_i)
|
||||
TEST_LOOP(i, 0, 17, 2, 9, test_i)
|
||||
TEST_LOOP(i, 0, 17, 3, 6, test_i)
|
||||
TEST_LOOP(i, 0, 17, 4, 5, test_i)
|
||||
TEST_LOOP(i, 0, 17, 5, 4, test_i)
|
||||
TEST_LOOP(i, 17, 0, -1, 18, test_i)
|
||||
TEST_LOOP(i, 17, 0, -2, 9, test_i)
|
||||
TEST_LOOP(i, 17, 0, -3, 6, test_i)
|
||||
TEST_LOOP(i, 17, 0, -4, 5, test_i)
|
||||
TEST_LOOP(i, 17, 0, -5, 4, test_i)
|
||||
|
||||
TEST_LOOP(i1, -huge(i1)-1_1, huge(i1), 1_1, int(huge(i1))*2+2, test_i1)
|
||||
TEST_LOOP(i1, -huge(i1)-1_1, huge(i1), 2_1, int(huge(i1))+1, test_i1)
|
||||
TEST_LOOP(i1, -huge(i1)-1_1, huge(i1), huge(i1), 3, test_i1)
|
||||
|
||||
TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -1_1, int(huge(i1))*2+2, test_i1)
|
||||
TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -2_1, int(huge(i1))+1, test_i1)
|
||||
TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -huge(i1), 3, test_i1)
|
||||
TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -huge(i1)-1_1, 2, test_i1)
|
||||
|
||||
TEST_LOOP(i1, -2_1, 3_1, huge(i1), 1, test_i1)
|
||||
TEST_LOOP(i1, -2_1, 3_1, -huge(i1), 0, test_i1)
|
||||
TEST_LOOP(i1, 2_1, -3_1, -huge(i1), 1, test_i1)
|
||||
TEST_LOOP(i1, 2_1, -3_1, huge(i1), 0, test_i1)
|
||||
|
||||
! Real loops
|
||||
TEST_LOOP(r, 0.0, 1.0, 0.11, 1 + int(1.0/0.11), test_r)
|
||||
TEST_LOOP(r, 0.0, 1.0, -0.11, 0, test_r)
|
||||
TEST_LOOP(r, 0.0, -1.0, 0.11, 0, test_r)
|
||||
TEST_LOOP(r, 0.0, -1.0, -0.11, 1 + int(1.0/0.11), test_r)
|
||||
TEST_LOOP(r, 0.0, 0.0, 0.11, 1, test_r)
|
||||
TEST_LOOP(r, 0.0, 0.0, -0.11, 1, test_r)
|
||||
|
||||
#undef TEST_LOOP
|
||||
|
||||
contains
|
||||
|
||||
function test_i1 (from, to, step) result(res)
|
||||
integer(kind=1), intent(in) :: from, to, step
|
||||
integer(kind=1) :: i
|
||||
integer :: res
|
||||
|
||||
res = 0
|
||||
do i = from, to, step
|
||||
res = res + 1
|
||||
end do
|
||||
end function test_i1
|
||||
|
||||
function test_i (from, to, step) result(res)
|
||||
integer, intent(in) :: from, to, step
|
||||
integer :: i
|
||||
integer :: res
|
||||
|
||||
res = 0
|
||||
do i = from, to, step
|
||||
res = res + 1
|
||||
end do
|
||||
end function test_i
|
||||
|
||||
function test_r (from, to, step) result(res)
|
||||
real, intent(in) :: from, to, step
|
||||
real :: i
|
||||
integer :: res
|
||||
|
||||
res = 0
|
||||
do i = from, to, step
|
||||
res = res + 1
|
||||
end do
|
||||
end function test_r
|
||||
|
||||
end program test
|
||||
Loading…
Reference in New Issue