From 86403f0f329ea996b6323d4011d5da0111ab80d8 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Tobias=20Schl=C3=BCter?= Date: Sun, 5 Jun 2005 20:03:47 +0200 Subject: [PATCH] re PR fortran/21912 (Wrong implied do-loop) fortran/ PR fortran/21912 * trans-array.c (gfc_trans_array_constructor_value): Slightly reorder. Generate correct exit condition in case of negative steps in implied-do loops. testsuite/ PR fortran/21912 * gfortran.dg/array_constructor_4.f90: New test. From-SVN: r100630 --- gcc/fortran/ChangeLog | 5 +++ gcc/fortran/trans-array.c | 37 ++++++++++++------- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/array_constructor_4.f90 | 23 ++++++++++++ 4 files changed, 57 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 51afe9c2f6b..9ee540598c1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,10 @@ 2005-06-05 Tobias Schl"uter + PR fortran/21912 + * trans-array.c (gfc_trans_array_constructor_value): Slightly reorder. + Generate correct exit condition in case of negative steps in + implied-do loops. + * invoke.texi: Fix description of flags required for compatibility with g77. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index fabbef99dc9..3554107ab83 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -721,7 +721,6 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, { tree tmp; stmtblock_t body; - tree loopbody; gfc_se se; for (; c; c = c->next) @@ -842,13 +841,23 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, } } - /* The frontend should already have done any expansions. */ - if (c->iterator) + /* The frontend should already have done any expansions possible + at compile-time. */ + if (!c->iterator) + { + /* Pass the code as is. */ + tmp = gfc_finish_block (&body); + gfc_add_expr_to_block (pblock, tmp); + } + else { + /* Build the implied do-loop. */ + tree cond; tree end; tree step; tree loopvar; tree exit_label; + tree loopbody; loopbody = gfc_finish_block (&body); @@ -877,17 +886,25 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, exit_label = gfc_build_label_decl (NULL_TREE); gfc_start_block (&body); - /* Generate the exit condition. */ - end = build2 (GT_EXPR, boolean_type_node, loopvar, end); + /* Generate the exit condition. Depending on the sign of + the step variable we have to generate the correct + comparison. */ + tmp = fold_build2 (GT_EXPR, boolean_type_node, step, + build_int_cst (TREE_TYPE (step), 0)); + cond = fold_build3 (COND_EXPR, boolean_type_node, tmp, + build2 (GT_EXPR, boolean_type_node, + loopvar, end), + build2 (LT_EXPR, boolean_type_node, + loopvar, end)); tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; - tmp = build3_v (COND_EXPR, end, tmp, build_empty_stmt ()); + tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ()); gfc_add_expr_to_block (&body, tmp); /* The main loop body. */ gfc_add_expr_to_block (&body, loopbody); - /* Increment the loop variable. */ + /* Increase loop variable by step. */ tmp = build2 (PLUS_EXPR, TREE_TYPE (loopvar), loopvar, step); gfc_add_modify_expr (&body, loopvar, tmp); @@ -900,12 +917,6 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, tmp = build1_v (LABEL_EXPR, exit_label); gfc_add_expr_to_block (pblock, tmp); } - else - { - /* Pass the code as is. */ - tmp = gfc_finish_block (&body); - gfc_add_expr_to_block (pblock, tmp); - } } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0fa5e70056f..96bc58183ab 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-06-05 Tobias Schl"uter + + PR fortran/21912 + * gfortran.dg/array_constructor_4.f90: New test. + 2005-06-05 Mark Mitchell PR c++/21619 diff --git a/gcc/testsuite/gfortran.dg/array_constructor_4.f90 b/gcc/testsuite/gfortran.dg/array_constructor_4.f90 new file mode 100644 index 00000000000..cae65156793 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_4.f90 @@ -0,0 +1,23 @@ +! { dg-do run } +! PR 21912 +! We didn't adapt the exit condition to negative steps in array constructors, +! leaving the resulting arrays uninitialized. +integer :: i(5), n, m, l, k + +n = 5 +i = (/ (m, m = n, 1, -1) /) +if (any (i /= (/ 5, 4, 3, 2, 1 /))) call abort + +k = 1 + +i(5:1:-1) = (/ (m, m = n, k, -1) /) +if (any (i /= (/ 1, 2, 3, 4, 5 /))) call abort + +l = -1 + +i = (/ (m, m = n, 1, l) /) +if (any (i /= (/ 5, 4, 3, 2, 1 /))) call abort + +i(5:1:-1) = (/ (m, m = n, k, l) /) +if (any (i /= (/ 1, 2, 3, 4, 5 /))) call abort +end -- 2.30.2