[Patch, fortran] PR44354 implied-do-loop array constructors using the induction variable in the bounds

[Mikael Morin <mikael dot morin at sfr dot fr>]

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  <mikael@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  <mikael@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 <zeccav@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  <mikael@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  <mikael@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 <zeccav@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