Hello,
these patches fix the handling of the following (invalid) code:
I=5
print *,(/(i,i=1,I)/)
end
The first patch adds a diagnostic as ifort and Nag do.
There was a concern in the PR whether we should accept it or not.
I followed Tobias' suggestion: warning by default, error with std>=95.
If we allow it, we have to support it: the second patch changes the
generated code so that the bounds are evaluated before the inner i
replaces the outer I. As a result, the small program above prints 1 2 3
4 5 as could be expected (even if it is invalid) instead of just 1.
I have started a regression test.
OK for trunk if it passes?
Mikael
2012-07-20 Mikael Morin <mik...@gcc.gnu.org>
PR fortran/44354
* resolve.c (sought_symbol): New variable.
(expr_is_sought_symbol_ref, find_symbol_in_expr): New functions.
(gfc_resolve_iterator): Check for references to the induction
variable in 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/resolve.c b/resolve.c
index ab79460..1357a6a 100644
--- a/resolve.c
+++ b/resolve.c
@@ -6439,12 +6439,58 @@ gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok,
}
+/* 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;
+}
+
+
/* Resolve the expressions in an iterator structure. If REAL_OK is
false allow only INTEGER type iterators, otherwise allow REAL types. */
gfc_try
gfc_resolve_iterator (gfc_iterator *iter, bool real_ok)
{
+ gfc_symbol *iter_var;
+ locus iter_var_expr_loc;
+
if (gfc_resolve_iterator_expr (iter->var, real_ok, "Loop variable")
== FAILURE)
return FAILURE;
@@ -6465,6 +6511,31 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok)
"Step expression in DO loop") == FAILURE)
return 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_expr_loc))
+ {
+ if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO initial expression "
+ "references control variable at %L",
+ &iter_var_expr_loc) == FAILURE)
+ return FAILURE;
+ }
+ if (find_symbol_in_expr (iter_var, iter->end, &iter_var_expr_loc))
+ {
+ if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO final expression "
+ "references control variable at %L",
+ &iter_var_expr_loc) == FAILURE)
+ return FAILURE;
+ }
+ if (find_symbol_in_expr (iter_var, iter->step, &iter_var_expr_loc))
+ {
+ if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO step expression "
+ "references control variable at %L",
+ &iter_var_expr_loc) == FAILURE)
+ return FAILURE;
+ }
+
if (iter->step->expr_type == EXPR_CONSTANT)
{
if ((iter->step->ts.type == BT_INTEGER
! { 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
