re PR fortran/28788 (ICE on valid code)

2006-08-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28788
	* gfortran.dg/used_types_4.f90: New test.
	* gfortran.dg/derived_init_2.f90: Modify to check sibling
	association of derived types.
	* gfortran.dg/used_types_2.f90: Add module cleanup.
	* gfortran.dg/used_types_3.f90: The same.

	PR fortran/28771
	* gfortran.dg/assumed_charlen_in_main.f90: Modify to check
	fix of regression.

2006-08-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28788
	* gfortran.dg/used_types_4.f90: New test.
	* gfortran.dg/derived_init_2.f90: Modify to check sibling
	association of derived types.
	* gfortran.dg/used_types_2.f90: Add module cleanup.
	* gfortran.dg/used_types_3.f90: The same.

	PR fortran/28771
	* gfortran.dg/assumed_charlen_in_main.f90: Modify to check
	fix of regression.

From-SVN: r116369

3 files changed, 70 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 655c01481fd..dd3ae5fc95e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2006-08-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28788
+	* symbol.c (shift_types): Shift the derived type references in
+	formal namespaces.
+	(gfc_use_derived): Return if the derived type symbol is already
+	in another namspace.  Add searches for the derived type in
+	sibling namespaces.
+
+	PR fortran/28771
+	* decl.c (add_init_expr_to_sym): Restore the original but
+	restricted to parameter arrays to fix a regression.
+
 2006-08-23  Steven G. Kargl  <kargls@comcast.net>
 
 	* gfortran.texi:  Fix last commit where a "no" was deleted and
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 79310e9dfbe..19bf1b0ee76 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -875,6 +875,10 @@ add_init_expr_to_sym (const char *name, gfc_expr ** initp,
 	      sym->ts.cl = gfc_get_charlen ();
 	      sym->ts.cl->next = gfc_current_ns->cl_list;
 	      gfc_current_ns->cl_list = sym->ts.cl;
+
+	      if (sym->attr.flavor == FL_PARAMETER
+		    && init->expr_type == EXPR_ARRAY)
+		sym->ts.cl->length = gfc_copy_expr (init->ts.cl->length);
 	    }
 	  /* Update initializer character length according symbol.  */
 	  else if (sym->ts.cl->length->expr_type == EXPR_CONSTANT)
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 801e85acec0..c36c4567a86 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1391,8 +1391,10 @@ find_renamed_type (gfc_symbol * der, gfc_symtree * st)
   return sym;
 }
 
-/* Recursive function to switch derived types of all symbol in a
-   namespace.  */
+/* Recursive function to switch derived types of all symbols in a
+   namespace.  The formal namespaces contain references to derived
+   types that can be left hanging by gfc_use_derived, so these must
+   be switched too.  */
 
 static void
 switch_types (gfc_symtree * st, gfc_symbol * from, gfc_symbol * to)
@@ -1405,6 +1407,9 @@ switch_types (gfc_symtree * st, gfc_symbol * from, gfc_symbol * to)
   sym = st->n.sym;
   if (sym->ts.type == BT_DERIVED && sym->ts.derived == from)
     sym->ts.derived = to;
+  
+  if (sym->formal_ns && sym->formal_ns->sym_root)
+    switch_types (sym->formal_ns->sym_root, from, to);
 
   switch_types (st->left, from, to);
   switch_types (st->right, from, to);
@@ -1436,11 +1441,12 @@ gfc_use_derived (gfc_symbol * sym)
   gfc_typespec *t;
   gfc_symtree *st;
   gfc_component *c;
+  gfc_namespace *ns;
   int i;
 
-  if (sym->ns->parent == NULL)
+  if (sym->ns->parent == NULL || sym->ns != gfc_current_ns)
     {
-      /* Already defined in highest possible namespace.  */
+      /* Already defined in highest possible or sibling namespace.  */
       if (sym->components != NULL)
 	return sym;
 
@@ -1466,6 +1472,27 @@ gfc_use_derived (gfc_symbol * sym)
       return NULL;
     }
 
+  /* Look in sibling namespaces for a derived type of the same name.  */
+  if (s == NULL && sym->attr.use_assoc && sym->ns->sibling)
+    {
+      ns = sym->ns->sibling;
+      for (; ns; ns = ns->sibling)
+	{
+	  s = NULL;
+	  if (sym->ns == ns)
+	    break;
+
+	  if (gfc_find_symbol (sym->name, ns, 1, &s))
+	    {
+	      gfc_error ("Symbol '%s' at %C is ambiguous", sym->name);
+	      return NULL;
+	    }
+
+	  if (s != NULL && s->attr.flavor == FL_DERIVED)
+	    break;
+	}
+    }
+
   if (s == NULL || s->attr.flavor != FL_DERIVED)
     {
       /* Check to see if type has been renamed in parent namespace.
@@ -1479,6 +1506,28 @@ gfc_use_derived (gfc_symbol * sym)
 	  return s;
 	}
 
+      /* See if sym is identical to renamed, use-associated derived
+	 types in sibling namespaces.  */
+      if (sym->attr.use_assoc
+	    && sym->ns->parent
+	    && sym->ns->parent->contained)
+	{
+	  ns = sym->ns->parent->contained;
+	  for (; ns; ns = ns->sibling)
+	    {
+	      if (sym->ns == ns)
+		break;
+
+	      s = find_renamed_type (sym, ns->sym_root);
+
+	      if (s != NULL)
+		{
+		  switch_types (sym->ns->sym_root, sym, s);
+		  return s;
+		}
+	    }
+	}
+
       /* The local definition is all that there is.  */
       if (sym->components != NULL)
 	{