diff mbox

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

Message ID 5009A06F.20905@sfr.fr
State New
Headers show

Commit Message

Mikael Morin July 20, 2012, 6:16 p.m. UTC
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

Comments

Mikael Morin July 20, 2012, 8:03 p.m. UTC | #1
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)
diff mbox

Patch

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