re PR fortran/31204 (wrong host association of implied loop variable)

2007-04-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31204
	* primary.c (check_for_implicit_index): New function to check
	that a host associated variable is not an undeclared implied
	do loop index.
	(gfc_match_rvalue, match_variable): Use it and reset the
	implied_index attribute.
	* gfortran.h : Add the implied_index field to symbol_attribute.
	* match.c (gfc_match_iterator): Mark the iterator variable
	with the new attribute.
	* decl.c (build_sym): Reset the new attribute.

2007-04-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31204
	* gfortran.dg/array_constructor_16.f90: New test.

From-SVN: r123849

gcc/fortran/ChangeLog

@@ -1,3 +1,16 @@
+2007-04-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31204
+	* primary.c (check_for_implicit_index): New function to check
+	that a host associated variable is not an undeclared implied
+	do loop index.
+	(gfc_match_rvalue, match_variable): Use it and reset the
+	implied_index attribute.
+	* gfortran.h : Add the implied_index field to symbol_attribute.
+	* match.c (gfc_match_iterator): Mark the iterator variable
+	with the new attribute.
+	* decl.c (build_sym): Reset the new attribute.
+
 2007-04-15  Kazu Hirata  <kazu@codesourcery.com>
 
 	* gfc-internals.texi: Fix typos.

gcc/fortran/decl.c

@@ -769,6 +769,8 @@ build_sym (const char *name, gfc_charlen *cl,
   if (gfc_copy_attr (&sym->attr, &attr, var_locus) == FAILURE)
     return FAILURE;
 
+  sym->attr.implied_index = 0;
+
   return SUCCESS;
 }
 

gcc/fortran/match.c

@@ -536,6 +536,8 @@ gfc_match_iterator (gfc_iterator *iter, int init_flag)
       goto cleanup;
     }
 
+  var->symtree->n.sym->attr.implied_index = 1;
+
   m = init_flag ? gfc_match_init_expr (&e1) : gfc_match_expr (&e1);
   if (m == MATCH_NO)
     goto syntax;

gcc/fortran/primary.c

@@ -1989,6 +1989,28 @@ cleanup:
 }
 
 
+/* If the symbol is an implicit do loop index and implicitly typed,
+   it should not be host associated.  Provide a symtree from the
+   current namespace.  */
+static match
+check_for_implicit_index (gfc_symtree **st, gfc_symbol **sym)
+{
+  if ((*sym)->attr.flavor == FL_VARIABLE
+      && (*sym)->ns != gfc_current_ns
+      && (*sym)->attr.implied_index
+      && (*sym)->attr.implicit_type
+      && !(*sym)->attr.use_assoc)
+    {
+      int i;
+      i = gfc_get_sym_tree ((*sym)->name, NULL, st);
+      if (i)
+	return MATCH_ERROR;
+      *sym = (*st)->n.sym;
+    }
+  return MATCH_YES;
+}
+
+
 /* Matches a variable name followed by anything that might follow it--
    array reference, argument list of a function, etc.  */
 
@@ -2024,7 +2046,14 @@ gfc_match_rvalue (gfc_expr **result)
   e = NULL;
   where = gfc_current_locus;
 
+  /* If this is an implicit do loop index and implicitly typed,
+     it should not be host associated.  */
+  m = check_for_implicit_index (&symtree, &sym);
+  if (m != MATCH_YES)
+    return m;
+
   gfc_set_sym_referenced (sym);
+  sym->attr.implied_index = 0;
 
   if (sym->attr.function && sym->result == sym)
     {
@@ -2394,6 +2423,15 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
   where = gfc_current_locus;
 
   sym = st->n.sym;
+
+  /* If this is an implicit do loop index and implicitly typed,
+     it should not be host associated.  */
+  m = check_for_implicit_index (&st, &sym);
+  if (m != MATCH_YES)
+    return m;
+
+  sym->attr.implied_index = 0;
+
   gfc_set_sym_referenced (sym);
   switch (sym->attr.flavor)
     {

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2007-04-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31204
+	* gfortran.dg/array_constructor_16.f90: New test.
+
 2007-04-15  Kazu Hirata  <kazu@codesourcery.com>
 
 	* gcc.dg/pr19340.c, gcc.dg/tree-ssa/loop-1.c,

gcc/testsuite/gfortran.dg/array_constructor_16.f90

@@ -0,0 +1,34 @@
+! { dg-do run }
+! Tests the fix for PR31204, in which 'i' below would be incorrectly
+! host associated by the contained subroutines.  The checks for 'ii'
+! and 'iii' have been added, since they can be host associated because
+! of the explicit declarations in the main program.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+  integer ii
+  INTEGER, PARAMETER :: jmin(1:10) = (/ (i, i = 1, 10) /)
+  INTEGER, PARAMETER :: kmin(1:10) = (/ (ii, ii = 1, 10) /)
+  INTEGER, PARAMETER :: lmin(1:10) = (/ (iii, iii = 1, 10) /)
+  integer iii
+  CALL two
+
+CONTAINS
+
+  SUBROUTINE one
+    i = 99
+    ii = 99
+    iii = 999
+  END SUBROUTINE
+
+  SUBROUTINE two
+    i = 0
+    ii = 0
+    iii = 0
+    CALL one
+    IF (i .NE. 0) CALL ABORT ()
+    IF (ii .NE. 99) CALL ABORT ()
+    IF (iii .NE. 999) CALL ABORT ()
+  END SUBROUTINE
+END
+