On 20/07/2012 22:03, Mikael Morin wrote:
> On 20/07/2012 20:16, Mikael Morin wrote:
>> I have started a regression test.
>> OK for trunk if it passes?
>>
> Unfortunately, it fails with errors like:
>
> /home/mik/gcc4x/src/gcc/testsuite/gfortran.dg/char_pack_1.f90:55.10:
>
> do i = i + 1, nv
> 1
> Warning: AC-IMPLIED-DO initial expression references control variable at
> (1)
>
> FAIL: gfortran.dg/char_pack_1.f90 -O3 -fomit-frame-pointer (test for
> excess errors)
Here is another attempt.
I moved the diagnostic code from gfc_resolve_iterator to
resolve_array_list, so that it doesn't trigger for do loops.
Regression test in progress. OK?
Mikael
2012-07-20 Mikael Morin <mik...@gcc.gnu.org>
PR fortran/44354
* array.c (sought_symbol): New variable.
(expr_is_sought_symbol_ref, find_symbol_in_expr): New functions.
(resolve_array_list): Check for references to the induction
variable in the iteration bounds and issue a diagnostic if some
are found.
2012-07-20 Mikael Morin <mik...@gcc.gnu.org>
PR fortran/44354
* gfortran.dg/array_constructor_38.f90: New test.
diff --git a/array.c b/array.c
index 51528b4..fc34f92 100644
--- a/array.c
+++ b/array.c
@@ -1718,6 +1718,50 @@ gfc_expanded_ac (gfc_expr *e)
/*************** Type resolution of array constructors ***************/
+
+/* The symbol expr_is_sought_symbol_ref will try to find. */
+static const gfc_symbol *sought_symbol = NULL;
+
+
+/* Tells whether the expression E is a variable reference to the symbol
+ in the static variable SOUGHT_SYMBOL, and sets the locus pointer WHERE
+ accordingly.
+ To be used with gfc_expr_walker: if a reference is found we don't need
+ to look further so we return 1 to skip any further walk. */
+
+static int
+expr_is_sought_symbol_ref (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *where)
+{
+ gfc_expr *expr = *e;
+ locus *sym_loc = (locus *)where;
+
+ if (expr->expr_type == EXPR_VARIABLE
+ && expr->symtree->n.sym == sought_symbol)
+ {
+ *sym_loc = expr->where;
+ return 1;
+ }
+
+ return 0;
+}
+
+
+/* Tells whether the expression EXPR contains a reference to the symbol
+ SYM and in that case sets the position SYM_LOC where the reference is. */
+
+static bool
+find_symbol_in_expr (gfc_symbol *sym, gfc_expr *expr, locus *sym_loc)
+{
+ int ret;
+
+ sought_symbol = sym;
+ ret = gfc_expr_walker (&expr, &expr_is_sought_symbol_ref, sym_loc);
+ sought_symbol = NULL;
+ return ret;
+}
+
+
/* Recursive array list resolution function. All of the elements must
be of the same type. */
@@ -1726,14 +1770,46 @@ resolve_array_list (gfc_constructor_base base)
{
gfc_try t;
gfc_constructor *c;
+ gfc_iterator *iter;
t = SUCCESS;
for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
{
- if (c->iterator != NULL
- && gfc_resolve_iterator (c->iterator, false) == FAILURE)
- t = FAILURE;
+ iter = c->iterator;
+ if (iter != NULL)
+ {
+ gfc_symbol *iter_var;
+ locus iter_var_loc;
+
+ if (gfc_resolve_iterator (iter, false) == FAILURE)
+ t = FAILURE;
+
+ /* Check for bounds referencing the iterator variable. */
+ gcc_assert (iter->var->expr_type == EXPR_VARIABLE);
+ iter_var = iter->var->symtree->n.sym;
+ if (find_symbol_in_expr (iter_var, iter->start, &iter_var_loc))
+ {
+ if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO initial "
+ "expression references control variable "
+ "at %L", &iter_var_loc) == FAILURE)
+ t = FAILURE;
+ }
+ if (find_symbol_in_expr (iter_var, iter->end, &iter_var_loc))
+ {
+ if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO final "
+ "expression references control variable "
+ "at %L", &iter_var_loc) == FAILURE)
+ t = FAILURE;
+ }
+ if (find_symbol_in_expr (iter_var, iter->step, &iter_var_loc))
+ {
+ if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO step "
+ "expression references control variable "
+ "at %L", &iter_var_loc) == FAILURE)
+ t = FAILURE;
+ }
+ }
if (gfc_resolve_expr (c->expr) == FAILURE)
t = FAILURE;
! { dg-do compile }
! { dg-options "-std=f95" }
!
! PR fortran/44354
! array constructors were giving unexpected results when the ac-implied-do
! variable was used in one of the ac-implied-do bounds.
!
! Original testcase by Vittorio Zecca <zec...@gmail.com>
!
I=5
print *,(/(i,i=I,8)/) ! { dg-error "initial expression references control variable" }
print *,(/(i,i=1,I)/) ! { dg-error "final expression references control variable" }
print *,(/(i,i=1,50,I)/) ! { dg-error "step expression references control variable" }
end
2012-07-20 Mikael Morin <mik...@gcc.gnu.org>
PR fortran/44354
* trans-array.c (gfc_trans_array_constructor_value):
Evaluate the iteration bounds before the inner variable shadows
the outer.
2012-07-20 Mikael Morin <mik...@gcc.gnu.org>
PR fortran/44354
* gfortran.dg/array_constructor_39.f90: New test.
diff --git a/trans-array.c b/trans-array.c
index d289ac3..4aaed15 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -1511,6 +1511,9 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
bool dynamic)
{
tree tmp;
+ tree start = NULL_TREE;
+ tree end = NULL_TREE;
+ tree step = NULL_TREE;
stmtblock_t body;
gfc_se se;
mpz_t size;
@@ -1533,8 +1536,30 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
expression in an interface mapping. */
if (c->iterator)
{
- gfc_symbol *sym = c->iterator->var->symtree->n.sym;
- tree type = gfc_typenode_for_spec (&sym->ts);
+ gfc_symbol *sym;
+ tree type;
+
+ /* Evaluate loop bounds before substituting the loop variable
+ in case they depend on it. Such a case is invalid, but it is
+ not more expensive to do the right thing here.
+ See PR 44354. */
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr_val (&se, c->iterator->start);
+ gfc_add_block_to_block (pblock, &se.pre);
+ start = gfc_evaluate_now (se.expr, pblock);
+
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr_val (&se, c->iterator->end);
+ gfc_add_block_to_block (pblock, &se.pre);
+ end = gfc_evaluate_now (se.expr, pblock);
+
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr_val (&se, c->iterator->step);
+ gfc_add_block_to_block (pblock, &se.pre);
+ step = gfc_evaluate_now (se.expr, pblock);
+
+ sym = c->iterator->var->symtree->n.sym;
+ type = gfc_typenode_for_spec (&sym->ts);
shadow_loopvar = gfc_create_var (type, "shadow_loopvar");
gfc_shadow_sym (sym, shadow_loopvar, &saved_loopvar);
@@ -1669,8 +1694,6 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
/* Build the implied do-loop. */
stmtblock_t implied_do_block;
tree cond;
- tree end;
- tree step;
tree exit_label;
tree loopbody;
tree tmp2;
@@ -1682,20 +1705,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
gfc_start_block(&implied_do_block);
/* Initialize the loop. */
- gfc_init_se (&se, NULL);
- gfc_conv_expr_val (&se, c->iterator->start);
- gfc_add_block_to_block (&implied_do_block, &se.pre);
- gfc_add_modify (&implied_do_block, shadow_loopvar, se.expr);
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr_val (&se, c->iterator->end);
- gfc_add_block_to_block (&implied_do_block, &se.pre);
- end = gfc_evaluate_now (se.expr, &implied_do_block);
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr_val (&se, c->iterator->step);
- gfc_add_block_to_block (&implied_do_block, &se.pre);
- step = gfc_evaluate_now (se.expr, &implied_do_block);
+ gfc_add_modify (&implied_do_block, shadow_loopvar, start);
/* If this array expands dynamically, and the number of iterations
is not constant, we won't have allocated space for the static
! { dg-do run }
!
! PR fortran/44354
! array constructors were giving unexpected results when the ac-implied-do
! variable was used in one of the ac-implied-do bounds.
!
! Original testcase by Vittorio Zecca <zec...@gmail.com>
!
I=5
if (any((/(i,i=1,I)/) /= (/1,2,3,4,5/))) call abort ! { dg-warning "final expression references control variable" }
if (I /= 5) call abort
end
