re PR fortran/28601 (ICE on reexport of renamed type)

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

	PR fortran/28601
	PR fortran/28630
	* gfortran.h : Eliminate gfc_dt_list structure and reference
	to it in gfc_namespace.
	* resolve.c (resolve_fl_derived): Remove the building of the
	list of derived types for the current namespace.
	* symbol.c (find_renamed_type): New function to find renamed
	derived types by symbol name rather than symtree name.
	(gfc_use_derived): Search parent namespace for identical
	derived type and use it, even if local version is complete,
	except in interface bodies. Ensure that renamed derived types
	are found by call to find_renamed_type. Recurse for derived
	type components.
	(gfc_free_dt_list): Remove.
	(gfc_free_namespace): Remove call to previous.
	* trans-types.c (copy_dt_decls_ifequal): Remove.
	(gfc_get_derived_type): Remove all the paraphenalia for
	association of derived types, including calls to previous.
	* match.c (gfc_match_allocate): Call gfc_use_derived to
	associate any derived types that are being allocated.

	PR fortran/20886
	* resolve.c (resolve_actual_arglist): The passing of
	a generic procedure name as an actual argument is an
	error.

	PR fortran/28735
	* resolve.c (resolve_variable): Check for a symtree before
	resolving references.

	PR fortran/28762
	* primary.c (match_variable): Return MATCH_NO if the symbol
	is that of the program.

	PR fortran/28425
	* trans-expr.c (gfc_trans_subcomponent_assign): Translate
	derived type component expressions other than another derived
	type constructor.

	PR fortran/28496
	* expr.c (find_array_section): Correct errors in
	the handling of a missing start value for the
	index triplet in an array reference.

	PR fortran/18111
	* trans-decl.c (gfc_build_dummy_array_decl): Before resetting
	reference to backend_decl, set it DECL_ARTIFICIAL.
	(gfc_get_symbol_decl): Likewise for original dummy decl, when
	a copy is made of an array.
	(create_function_arglist): Likewise for the _entry paramter
	in entry_masters.
	(build_entry_thunks): Likewise for dummies in entry thunks.

	PR fortran/28600
	* trans-decl.c (gfc_get_symbol_decl): Ensure that the
	DECL_CONTEXT of the length of a character dummy is the
	same as that of the symbol declaration.

	PR fortran/28771
	* decl.c (add_init_expr_to_sym): Remove setting of charlen for
	an initializer of an assumed charlen variable.

	PR fortran/28660
	* trans-decl.c (generate_expr_decls): New function.
	(generate_dependency_declarations): New function.
	(generate_local_decl): Call previous if not either a dummy or
	a declaration in an entry master.

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

	PR fortran/28630
	* gfortran.dg/used_types_2.f90: New test.

	PR fortran/28601
	* gfortran.dg/used_types_3.f90: New test.

	PR fortran/20886
	* gfortran.dg/generic_actual_arg.f90: New test.

	PR fortran/28735
	* gfortran.dg/module_private_array_refs_1.f90: New test.

	PR fortran/28762
	* gfortran.dg/program_name_1.f90: New test.

	PR fortran/28425
	* gfortran.dg/derived_constructor_comps_1.f90: New test.

	PR fortran/28496
	* gfortran.dg/array_initializer_2.f90: New test.

	PR fortran/18111
	* gfortran.dg/unused_artificial_dummies_1.f90: New test. 

	PR fortran/28600
	* gfortran.dg/assumed_charlen_function_4.f90: New test.

	PR fortran/28771
	* gfortran.dg/assumed_charlen_in_main.f90: New test.

	PR fortran/28660
	* gfortran.dg/dependent_decls_1.f90: New test.

From-SVN: r116268

11 files changed, 320 insertions, 136 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c922b8d..bbcee7a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,73 @@
+2006-08-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28601
+	PR fortran/28630
+	* gfortran.h : Eliminate gfc_dt_list structure and reference
+	to it in gfc_namespace.
+	* resolve.c (resolve_fl_derived): Remove the building of the
+	list of derived types for the current namespace.
+	* symbol.c (find_renamed_type): New function to find renamed
+	derived types by symbol name rather than symtree name.
+	(gfc_use_derived): Search parent namespace for identical
+	derived type and use it, even if local version is complete,
+	except in interface bodies. Ensure that renamed derived types
+	are found by call to find_renamed_type. Recurse for derived
+	type components.
+	(gfc_free_dt_list): Remove.
+	(gfc_free_namespace): Remove call to previous.
+	* trans-types.c (copy_dt_decls_ifequal): Remove.
+	(gfc_get_derived_type): Remove all the paraphenalia for
+	association of derived types, including calls to previous.
+	* match.c (gfc_match_allocate): Call gfc_use_derived to
+	associate any derived types that are being allocated.
+
+	PR fortran/20886
+	* resolve.c (resolve_actual_arglist): The passing of
+	a generic procedure name as an actual argument is an
+	error.
+
+	PR fortran/28735
+	* resolve.c (resolve_variable): Check for a symtree before
+	resolving references.
+
+	PR fortran/28762
+	* primary.c (match_variable): Return MATCH_NO if the symbol
+	is that of the program.
+
+	PR fortran/28425
+	* trans-expr.c (gfc_trans_subcomponent_assign): Translate
+	derived type component expressions other than another derived
+	type constructor.
+
+	PR fortran/28496
+	* expr.c (find_array_section): Correct errors in
+	the handling of a missing start value for the
+	index triplet in an array reference.
+
+	PR fortran/18111
+	* trans-decl.c (gfc_build_dummy_array_decl): Before resetting
+	reference to backend_decl, set it DECL_ARTIFICIAL.
+	(gfc_get_symbol_decl): Likewise for original dummy decl, when
+	a copy is made of an array.
+	(create_function_arglist): Likewise for the _entry paramter
+	in entry_masters.
+	(build_entry_thunks): Likewise for dummies in entry thunks.
+
+	PR fortran/28600
+	* trans-decl.c (gfc_get_symbol_decl): Ensure that the
+	DECL_CONTEXT of the length of a character dummy is the
+	same as that of the symbol declaration.
+
+	PR fortran/28771
+	* decl.c (add_init_expr_to_sym): Remove setting of charlen for
+	an initializer of an assumed charlen variable.
+
+	PR fortran/28660
+	* trans-decl.c (generate_expr_decls): New function.
+	(generate_dependency_declarations): New function.
+	(generate_local_decl): Call previous if not either a dummy or
+	a declaration in an entry master.
+
 2006-08-19  Erik Edelmann  <eedelman@gcc.gnu.org>
 
 	PR fortran/25217
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index fb980d6..79310e9 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -875,12 +875,6 @@ 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 (init->expr_type == EXPR_CONSTANT)
-		sym->ts.cl->length =
-			gfc_int_expr (init->value.character.length);
-	      else if (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/expr.c b/gcc/fortran/expr.c
index 4b03798..b1f064d 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1014,6 +1014,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
   int rank;
   int d;
   long unsigned one = 1;
+  mpz_t start[GFC_MAX_DIMENSIONS];
   mpz_t end[GFC_MAX_DIMENSIONS];
   mpz_t stride[GFC_MAX_DIMENSIONS];
   mpz_t delta[GFC_MAX_DIMENSIONS];
@@ -1052,6 +1053,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
   for (d = 0; d < rank; d++)
     {
       mpz_init (delta[d]);
+      mpz_init (start[d]);
       mpz_init (end[d]);
       mpz_init (ctr[d]);
       mpz_init (stride[d]);
@@ -1085,15 +1087,16 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
 	mpz_set_ui (stride[d], one);
 
       /* Obtain the start value for the index.  */
-      if (begin->value.integer)
-	  mpz_set (ctr[d], begin->value.integer);
+      if (begin)
+	  mpz_set (start[d], begin->value.integer);
       else
 	{
 	  if (mpz_cmp_si (stride[d], 0) < 0)
-	    mpz_set (ctr[d], upper->value.integer);
+	    mpz_set (start[d], upper->value.integer);
 	  else
-	    mpz_set (ctr[d], lower->value.integer);
+	    mpz_set (start[d], lower->value.integer);
 	}
+      mpz_set (ctr[d], start[d]);
 
       /* Obtain the end value for the index.  */
       if (finish)
@@ -1171,7 +1174,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
 	  if (mpz_cmp_ui (stride[d], 0) > 0 ?
 		mpz_cmp (ctr[d], tmp_mpz) > 0 :
 		mpz_cmp (ctr[d], tmp_mpz) < 0)
-	    mpz_set (ctr[d], ref->u.ar.start[d]->value.integer);
+	    mpz_set (ctr[d], start[d]);
 	  else
 	    mpz_set_ui (stop, 0);
 	}
@@ -1205,6 +1208,7 @@ cleanup:
   for (d = 0; d < rank; d++)
     {
       mpz_clear (delta[d]);
+      mpz_clear (start[d]);
       mpz_clear (end[d]);
       mpz_clear (ctr[d]);
       mpz_clear (stride[d]);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 01bcf97..14e2ce6 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -927,17 +927,6 @@ typedef struct gfc_symtree
 }
 gfc_symtree;
 
-/* A linked list of derived types in the namespace.  */
-typedef struct gfc_dt_list
-{
-  struct gfc_symbol *derived;
-  struct gfc_dt_list *next;
-}
-gfc_dt_list;
-
-#define gfc_get_dt_list() gfc_getmem(sizeof(gfc_dt_list))
-
-
 /* A namespace describes the contents of procedure, module or
    interface block.  */
 /* ??? Anything else use these?  */
@@ -1000,9 +989,6 @@ typedef struct gfc_namespace
   /* A list of all alternate entry points to this procedure (or NULL).  */
   gfc_entry_list *entries;
 
-  /* A list of all derived types in this procedure (or NULL).  */
-  gfc_dt_list *derived_types;
-
   /* Set to 1 if namespace is a BLOCK DATA program unit.  */
   int is_block_data;
 }
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 77594cb..e6a7689 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1798,6 +1798,9 @@ gfc_match_allocate (void)
 	  goto cleanup;
 	}
 
+      if (tail->expr->ts.type == BT_DERIVED)
+	tail->expr->ts.derived = gfc_use_derived (tail->expr->ts.derived);
+
       if (gfc_match_char (',') != MATCH_YES)
 	break;
 
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index ad569fc..c0ed364 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2295,6 +2295,10 @@ match_variable (gfc_expr ** result, int equiv_flag, int host_flag)
     case FL_VARIABLE:
       break;
 
+    case FL_PROGRAM:
+      return MATCH_NO;
+      break;
+
     case FL_UNKNOWN:
       if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
 			  sym->name, NULL) == FAILURE)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5c9786b..3924dc6 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -858,6 +858,13 @@ resolve_actual_arglist (gfc_actual_arglist * arg)
 			 &e->where);
 	    }
 
+	  if (sym->attr.generic)
+	    {
+	      gfc_error ("GENERIC non-INTRINSIC procedure '%s' is not "
+		         "allowed as an actual argument at %L", sym->name,
+			 &e->where);
+	    }
+
 	  /* If the symbol is the function that names the current (or
 	     parent) scope, then we really have a variable reference.  */
 
@@ -2883,10 +2890,10 @@ resolve_variable (gfc_expr * e)
 
   t = SUCCESS;
 
-  if (e->ref && resolve_ref (e) == FAILURE)
+  if (e->symtree == NULL)
     return FAILURE;
 
-  if (e->symtree == NULL)
+  if (e->ref && resolve_ref (e) == FAILURE)
     return FAILURE;
 
   sym = e->symtree->n.sym;
@@ -5360,7 +5367,6 @@ static try
 resolve_fl_derived (gfc_symbol *sym)
 {
   gfc_component *c;
-  gfc_dt_list * dt_list;
   int i;
 
   for (c = sym->components; c != NULL; c = c->next)
@@ -5423,12 +5429,6 @@ resolve_fl_derived (gfc_symbol *sym)
 	}
     }
     
-  /* Add derived type to the derived type list.  */
-  dt_list = gfc_get_dt_list ();
-  dt_list->next = sym->ns->derived_types;
-  dt_list->derived = sym;
-  sym->ns->derived_types = dt_list;
-
   return SUCCESS;
 }
 
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 63e45ec..801e85a 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1364,6 +1364,33 @@ gfc_add_component (gfc_symbol * sym, const char *name, gfc_component ** componen
 }
 
 
+/* Recursive search for a renamed derived type.  */
+
+static gfc_symbol *
+find_renamed_type (gfc_symbol * der, gfc_symtree * st)
+{
+  gfc_symbol *sym = NULL;
+
+  if (st == NULL)
+    return NULL;
+
+  sym = find_renamed_type (der, st->left);
+  if (sym != NULL)
+    return sym;
+
+  sym = find_renamed_type (der, st->right);
+  if (sym != NULL)
+    return sym;
+
+  if (strcmp (der->name, st->n.sym->name) == 0
+	&& st->n.sym->attr.use_assoc
+	&& st->n.sym->attr.flavor == FL_DERIVED
+	&& gfc_compare_derived_types (der, st->n.sym))
+    sym = st->n.sym;
+
+  return sym;
+}
+
 /* Recursive function to switch derived types of all symbol in a
    namespace.  */
 
@@ -1408,14 +1435,31 @@ gfc_use_derived (gfc_symbol * sym)
   gfc_symbol *s;
   gfc_typespec *t;
   gfc_symtree *st;
+  gfc_component *c;
   int i;
 
-  if (sym->components != NULL)
-    return sym;               /* Already defined.  */
-
   if (sym->ns->parent == NULL)
-    goto bad;
+    {
+      /* Already defined in highest possible namespace.  */
+      if (sym->components != NULL)
+	return sym;
+
+      /*  There is no scope for finding a definition elsewhere.  */
+      else
+	goto bad;
+    }
+  else
+    {
+      /* This type can only be locally associated.  */
+      if (!(sym->attr.use_assoc || sym->attr.sequence))
+	return sym;
+
+      /* Derived types must be defined within an interface.  */
+      if (gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY)
+	return sym;
+    }
 
+  /* Look in parent namespace for a derived type of the same name.  */
   if (gfc_find_symbol (sym->name, sym->ns->parent, 1, &s))
     {
       gfc_error ("Symbol '%s' at %C is ambiguous", sym->name);
@@ -1423,6 +1467,37 @@ gfc_use_derived (gfc_symbol * sym)
     }
 
   if (s == NULL || s->attr.flavor != FL_DERIVED)
+    {
+      /* Check to see if type has been renamed in parent namespace.
+	 Leave cleanup of local symbols until the end of the
+	 compilation because doing it here is complicated by
+	 multiple association with the same type.  */
+      s = find_renamed_type (sym, sym->ns->parent->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)
+	{
+	  /* Non-pointer derived type components have already been checked
+	     but pointer types need to be correctly associated.  */
+	  for (c = sym->components; c; c = c->next)
+	    if (c->ts.type == BT_DERIVED && c->pointer)
+	      c->ts.derived = gfc_use_derived (c->ts.derived);
+
+	  return sym;
+	}
+    }
+
+  /* Although the parent namespace has a derived type of the same name, it is
+     not an identical derived type and so cannot be used.  */
+  if (s != NULL && sym->components != NULL && !gfc_compare_derived_types (s, sym))
+    return sym;
+
+  if (s == NULL || s->attr.flavor != FL_DERIVED)
     goto bad;
 
   /* Get rid of symbol sym, translating all references to s.  */
@@ -2440,21 +2515,6 @@ free_sym_tree (gfc_symtree * sym_tree)
 }
 
 
-/* Free a derived type list.  */
-
-static void
-gfc_free_dt_list (gfc_dt_list * dt)
-{
-  gfc_dt_list *n;
-
-  for (; dt; dt = n)
-    {
-      n = dt->next;
-      gfc_free (dt);
-    }
-}
-
-
 /* Free the gfc_equiv_info's.  */
 
 static void
@@ -2517,8 +2577,6 @@ gfc_free_namespace (gfc_namespace * ns)
   gfc_free_equiv (ns->equiv);
   gfc_free_equiv_lists (ns->equiv_lists);
 
-  gfc_free_dt_list (ns->derived_types);
-
   for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++)
     gfc_free_interface (ns->operator[i]);
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 7398e16..855c982 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -728,6 +728,7 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
       /* We now have an expression for the element size, so create a fully
 	 qualified type.  Reset sym->backend decl or this will just return the
 	 old type.  */
+      DECL_ARTIFICIAL (sym->backend_decl) = 1;
       sym->backend_decl = NULL_TREE;
       type = gfc_sym_type (sym);
       packed = 2;
@@ -884,7 +885,15 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	  if (TREE_CODE (length) == VAR_DECL
 	      && DECL_CONTEXT (length) == NULL_TREE)
 	    {
-	      gfc_add_decl_to_function (length);
+	      /* Add the string length to the same context as the symbol.  */
+	      if (DECL_CONTEXT (sym->backend_decl) == current_function_decl)
+	        gfc_add_decl_to_function (length);
+	      else
+		gfc_add_decl_to_parent_function (length);
+
+	      gcc_assert (DECL_CONTEXT (sym->backend_decl) ==
+			    DECL_CONTEXT (length));
+
 	      gfc_defer_symbol_init (sym);
 	    }
 	}
@@ -892,8 +901,11 @@ gfc_get_symbol_decl (gfc_symbol * sym)
       /* Use a copy of the descriptor for dummy arrays.  */
       if (sym->attr.dimension && !TREE_USED (sym->backend_decl))
         {
-          sym->backend_decl =
-            gfc_build_dummy_array_decl (sym, sym->backend_decl);
+	  decl = gfc_build_dummy_array_decl (sym, sym->backend_decl);
+	  /* Prevent the dummy from being detected as unused if it is copied.  */
+	  if (sym->backend_decl != NULL && decl != sym->backend_decl)
+	    DECL_ARTIFICIAL (sym->backend_decl) = 1;
+	  sym->backend_decl = decl;
 	}
 
       TREE_USED (sym->backend_decl) = 1;
@@ -1284,6 +1296,7 @@ create_function_arglist (gfc_symbol * sym)
       DECL_ARG_TYPE (parm) = type;
       TREE_READONLY (parm) = 1;
       gfc_finish_decl (parm, NULL_TREE);
+      DECL_ARTIFICIAL (parm) = 1;
 
       arglist = chainon (arglist, parm);
       typelist = TREE_CHAIN (typelist);
@@ -1603,6 +1616,7 @@ build_entry_thunks (gfc_namespace * ns)
 	  if (thunk_formal)
 	    {
 	      /* Pass the argument.  */
+	      DECL_ARTIFICIAL (thunk_formal->sym->backend_decl) = 1;
 	      args = tree_cons (NULL_TREE, thunk_formal->sym->backend_decl,
 				args);
 	      if (formal->sym->ts.type == BT_CHARACTER)
@@ -2743,6 +2757,112 @@ gfc_generate_contained_functions (gfc_namespace * parent)
 }
 
 
+/* Drill down through expressions for the array specification bounds and
+   character length calling generate_local_decl for all those variables
+   that have not already been declared.  */
+
+static void
+generate_local_decl (gfc_symbol *);
+
+static void
+generate_expr_decls (gfc_symbol *sym, gfc_expr *e)
+{
+  gfc_actual_arglist *arg;
+  gfc_ref *ref;
+  int i;
+
+  if (e == NULL)
+    return;
+
+  switch (e->expr_type)
+    {
+    case EXPR_FUNCTION:
+      for (arg = e->value.function.actual; arg; arg = arg->next)
+	generate_expr_decls (sym, arg->expr);
+      break;
+
+    /* If the variable is not the same as the dependent, 'sym', and
+       it is not marked as being declared and it is in the same
+       namespace as 'sym', add it to the local declarations.  */
+    case EXPR_VARIABLE:
+      if (sym == e->symtree->n.sym
+	    || e->symtree->n.sym->mark
+	    || e->symtree->n.sym->ns != sym->ns)
+	return;
+
+      generate_local_decl (e->symtree->n.sym);
+      break;
+
+    case EXPR_OP:
+      generate_expr_decls (sym, e->value.op.op1);
+      generate_expr_decls (sym, e->value.op.op2);
+      break;
+
+    default:
+      break;
+    }
+
+  if (e->ref)
+    {
+      for (ref = e->ref; ref; ref = ref->next)
+	{
+	  switch (ref->type)
+	    {
+	    case REF_ARRAY:
+	      for (i = 0; i < ref->u.ar.dimen; i++)
+		{
+		  generate_expr_decls (sym, ref->u.ar.start[i]);
+		  generate_expr_decls (sym, ref->u.ar.end[i]);
+		  generate_expr_decls (sym, ref->u.ar.stride[i]);
+		}
+	      break;
+
+	    case REF_SUBSTRING:
+	      generate_expr_decls (sym, ref->u.ss.start);
+	      generate_expr_decls (sym, ref->u.ss.end);
+	      break;
+
+	    case REF_COMPONENT:
+	      if (ref->u.c.component->ts.type == BT_CHARACTER
+		    && ref->u.c.component->ts.cl->length->expr_type
+						!= EXPR_CONSTANT)
+		generate_expr_decls (sym, ref->u.c.component->ts.cl->length);
+
+	      if (ref->u.c.component->as)
+	        for (i = 0; i < ref->u.c.component->as->rank; i++)
+		  {
+		    generate_expr_decls (sym, ref->u.c.component->as->lower[i]);
+		    generate_expr_decls (sym, ref->u.c.component->as->upper[i]);
+		  }
+	      break;
+	    }
+	}
+    }
+}
+
+
+/* Check for dependencies in the character length and array spec. */
+
+static void
+generate_dependency_declarations (gfc_symbol *sym)
+{
+  int i;
+
+  if (sym->ts.type == BT_CHARACTER
+	&& sym->ts.cl->length->expr_type != EXPR_CONSTANT)
+    generate_expr_decls (sym, sym->ts.cl->length);
+
+  if (sym->as && sym->as->rank)
+    {
+      for (i = 0; i < sym->as->rank; i++)
+	{
+          generate_expr_decls (sym, sym->as->lower[i]);
+          generate_expr_decls (sym, sym->as->upper[i]);
+	}
+    }
+}
+
+
 /* Generate decls for all local variables.  We do this to ensure correct
    handling of expressions which only appear in the specification of
    other functions.  */
@@ -2752,6 +2872,14 @@ generate_local_decl (gfc_symbol * sym)
 {
   if (sym->attr.flavor == FL_VARIABLE)
     {
+      /* Check for dependencies in the array specification and string
+	length, adding the necessary declarations to the function.  We
+	mark the symbol now, as well as in traverse_ns, to prevent
+	getting stuck in a circular dependency.  */
+      sym->mark = 1;
+      if (!sym->attr.dummy && !sym->ns->proc_name->attr.entry_master)
+        generate_dependency_declarations (sym);
+
       if (sym->attr.referenced)
         gfc_get_symbol_decl (sym);
       else if (sym->attr.dummy && warn_unused_parameter)
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 4225b69..b1bd217 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2669,9 +2669,19 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
     }
   else if (expr->ts.type == BT_DERIVED)
     {
-      /* Nested derived type.  */
-      tmp = gfc_trans_structure_assign (dest, expr);
-      gfc_add_expr_to_block (&block, tmp);
+      if (expr->expr_type != EXPR_STRUCTURE)
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, expr);
+	  gfc_add_modify_expr (&block, dest,
+			       fold_convert (TREE_TYPE (dest), se.expr));
+	}
+      else
+	{
+	  /* Nested constructors.  */
+	  tmp = gfc_trans_structure_assign (dest, expr);
+	  gfc_add_expr_to_block (&block, tmp);
+	}
     }
   else
     {
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index ca93adb..3eb1f2c 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1411,59 +1411,15 @@ gfc_add_field_to_struct (tree *fieldlist, tree context,
 }
 
 
-/* Copy the backend_decl and component backend_decls if
-   the two derived type symbols are "equal", as described
-   in 4.4.2 and resolved by gfc_compare_derived_types.  */
-
-static int
-copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to)
-{
-  gfc_component *to_cm;
-  gfc_component *from_cm;
-
-  if (from->backend_decl == NULL
-	|| !gfc_compare_derived_types (from, to))
-    return 0;
-
-  to->backend_decl = from->backend_decl;
-
-  to_cm = to->components;
-  from_cm = from->components;
-
-  /* Copy the component declarations.  If a component is itself
-     a derived type, we need a copy of its component declarations.
-     This is done by recursing into gfc_get_derived_type and
-     ensures that the component's component declarations have
-     been built.  If it is a character, we need the character 
-     length, as well.  */
-  for (; to_cm; to_cm = to_cm->next, from_cm = from_cm->next)
-    {
-      to_cm->backend_decl = from_cm->backend_decl;
-      if (from_cm->ts.type == BT_DERIVED)
-	gfc_get_derived_type (to_cm->ts.derived);
-
-      else if (from_cm->ts.type == BT_CHARACTER)
-	to_cm->ts.cl->backend_decl = from_cm->ts.cl->backend_decl;
-    }
-
-  return 1;
-}
-
-
-/* Build a tree node for a derived type.  If there are equal
-   derived types, with different local names, these are built
-   at the same time.  If an equal derived type has been built
-   in a parent namespace, this is used.  */
+/* Build a tree node for a derived type.  */
 
 static tree
 gfc_get_derived_type (gfc_symbol * derived)
 {
   tree typenode, field, field_type, fieldlist;
   gfc_component *c;
-  gfc_dt_list *dt;
-  gfc_namespace * ns;
 
-  gcc_assert (derived && derived->attr.flavor == FL_DERIVED);
+  gcc_assert (derived);
 
   /* derived->backend_decl != 0 means we saw it before, but its
      components' backend_decl may have not been built.  */
@@ -1477,29 +1433,6 @@ gfc_get_derived_type (gfc_symbol * derived)
     }
   else
     {
-      /* In a module, if an equal derived type is already available in the
-	 specification block, use its backend declaration and those of its
-	 components, rather than building anew so that potential dummy and
-	 actual arguments use the same TREE_TYPE.  Non-module structures,
-	 need to be built, if found, because the order of visits to the 
-	 namespaces is different.  */
-
-      for (ns = derived->ns->parent; ns; ns = ns->parent)
-	{
-	  for (dt = ns->derived_types; dt; dt = dt->next)
-	    {
-	      if (derived->module == NULL
-		    && dt->derived->backend_decl == NULL
-		    && gfc_compare_derived_types (dt->derived, derived))
-		gfc_get_derived_type (dt->derived);
-
-	      if (copy_dt_decls_ifequal (dt->derived, derived))
-		break;
-	    }
-	  if (derived->backend_decl)
-	    goto other_equal_dts;
-	}
-
       /* We see this derived type first time, so build the type node.  */
       typenode = make_node (RECORD_TYPE);
       TYPE_NAME (typenode) = get_identifier (derived->name);
@@ -1578,12 +1511,6 @@ gfc_get_derived_type (gfc_symbol * derived)
 
   derived->backend_decl = typenode;
 
-other_equal_dts:
-  /* Add this backend_decl to all the other, equal derived types and
-     their components in this namespace.  */
-  for (dt = derived->ns->derived_types; dt; dt = dt->next)
-    copy_dt_decls_ifequal (derived, dt->derived);
-
   return derived->backend_decl;
 }