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

login
register
mail settings
Submitter Mikael Morin
Date July 21, 2012, 10:13 a.m.
Message ID <500A80DD.9050307@sfr.fr>
Download mbox | patch
Permalink /patch/172419/
State New
Headers show

Comments

Mikael Morin - July 21, 2012, 10:13 a.m.
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
Tobias Burnus - July 23, 2012, 5:58 a.m.
Mikael Morin wrote:
> 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?

The patch looks OK:

Though, I wonder why you only get a warning (which is fine); I thought 
that -std=gnu (the default) – and, in particular, in combination with 
-pedantic (test-suite default) – will give an error for 
gfc_notify_standard, not a warning.

Tobi
Mikael Morin - July 23, 2012, 6:53 p.m.
On 23/07/2012 07:58, Tobias Burnus wrote:
> Mikael Morin wrote:
>> 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?
> 
> The patch looks OK:
> 
> Though, I wonder why you only get a warning (which is fine); I thought
> that -std=gnu (the default) – and, in particular, in combination with
> -pedantic (test-suite default) – will give an error for
> gfc_notify_standard, not a warning.
> 
Well, no; it passed the test-suite. :-)

options.c's set_default_std_flags explicitely allows legacy stuff:

static void
set_default_std_flags (void)
{
  gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
    | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77
    | GFC_STD_F2008_OBS | GFC_STD_F2008_TS | GFC_STD_GNU | GFC_STD_LEGACY;
  gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY;
}


and the references to pedantic in options.c only increase warnings (see
gfc_post_options):

  /* If -pedantic, warn about the use of GNU extensions.  */
  if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
    gfc_option.warn_std |= GFC_STD_GNU;
  /* -std=legacy -pedantic is effectively -std=gnu.  */
  if (pedantic && (gfc_option.allow_std & GFC_STD_LEGACY) != 0)
    gfc_option.warn_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL |
GFC_STD_LEGACY;


Thanks for the review.

Mikael

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