re PR fortran/30531 ([4.2 only] allocatable component and intent(out) yield ICE in fold_convert)

2007-03-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30531
	PR fortran/31086
	* symbo.c : Add gfc_derived_types.
	(gfc_free_dt_list): Free derived type list gfc_derived_types.
	(gfc_free_namespace): Remove call to gfc_free_dt_list.
	(gfc_symbol_done_2): Call  gfc_free_dt_list.
	* gfortran.h : Declare gfc_derived_types to be external. Remove
	derived types field from gfc_namespace.
	* resolve.c (resolve_fl_derived): Refer to gfc_derived types
	rather than namespace derived_types.
	(resolve_fntype): Remove special treatment for module
	derived type functions.
	* trans-types.c (gfc_get_derived_type): Remove search for like
	derived types.  Finish by copying back end declaration to like
	derived types in the derived type list gfc_derived_types.

2007-03-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30531
	* gfortran.dg/used_types_14.f90: New test.

	PR fortran/31086
	* gfortran.dg/used_types_15.f90: New test.

From-SVN: r123037

gcc/fortran/ChangeLog

-2007-03-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+2007-03-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30531
+	PR fortran/31086
+	* symbo.c : Add gfc_derived_types.
+	(gfc_free_dt_list): Free derived type list gfc_derived_types.
+	(gfc_free_namespace): Remove call to gfc_free_dt_list.
+	(gfc_symbol_done_2): Call  gfc_free_dt_list.
+	* gfortran.h : Declare gfc_derived_types to be external. Remove
+	derived types field from gfc_namespace.
+	* resolve.c (resolve_fl_derived): Refer to gfc_derived types
+	rather than namespace derived_types.
+	(resolve_fntype): Remove special treatment for module
+	derived type functions.
+	* trans-types.c (gfc_get_derived_type): Remove search for like
+	derived types.  Finish by copying back end declaration to like
+	derived types in the derived type list gfc_derived_types.
+
+	2007-03-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	PR fortran/31120
 	* trans-expr.c (gfc_conv_powi): Make n argument unsigned hwi.

gcc/fortran/gfortran.h

@@ -950,6 +950,8 @@ gfc_dt_list;
 
 #define gfc_get_dt_list() gfc_getmem(sizeof(gfc_dt_list))
 
+  /* A list of all derived types.  */
+  extern gfc_dt_list *gfc_derived_types;
 
 /* A namespace describes the contents of procedure, module or
    interface block.  */
@@ -1013,9 +1015,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;
 

gcc/fortran/resolve.c

@@ -5932,16 +5932,16 @@ resolve_fl_derived (gfc_symbol *sym)
     }
 
   /* Add derived type to the derived type list.  */
-  for (dt_list = sym->ns->derived_types; dt_list; dt_list = dt_list->next)
+  for (dt_list = gfc_derived_types; dt_list; dt_list = dt_list->next)
     if (sym == dt_list->derived)
       break;
 
   if (dt_list == NULL)
     {
       dt_list = gfc_get_dt_list ();
-      dt_list->next = sym->ns->derived_types;
+      dt_list->next = gfc_derived_types;
       dt_list->derived = sym;
-      sym->ns->derived_types = dt_list;
+      gfc_derived_types = dt_list;
     }
 
   return SUCCESS;
@@ -7154,22 +7154,7 @@ resolve_fntype (gfc_namespace *ns)
 		 sym->name, &sym->declared_at, sym->ts.derived->name);
     }
 
-  /* Make sure that the type of a module derived type function is in the
-     module namespace, by copying it from the namespace's derived type
-     list, if necessary.  */
-  if (sym->ts.type == BT_DERIVED
-      && sym->ns->proc_name->attr.flavor == FL_MODULE
-      && sym->ts.derived->ns
-      && sym->ns != sym->ts.derived->ns)
-    {
-      gfc_dt_list *dt = sym->ns->derived_types;
-
-      for (; dt; dt = dt->next)
-	if (gfc_compare_derived_types (sym->ts.derived, dt->derived))
-	  sym->ts.derived = dt->derived;
-    }
-
-  if (ns->entries)
+    if (ns->entries)
     for (el = ns->entries->next; el; el = el->next)
       {
 	if (el->sym->result == el->sym

gcc/fortran/symbol.c

@@ -91,6 +91,8 @@ gfc_gsymbol *gfc_gsym_root = NULL;
 
 static gfc_symbol *changed_syms = NULL;
 
+gfc_dt_list *gfc_derived_types;
+
 
 /*********** IMPLICIT NONE and IMPLICIT statement handlers ***********/
 
@@ -2528,18 +2530,20 @@ free_sym_tree (gfc_symtree * sym_tree)
 }
 
 
-/* Free a derived type list.  */
+/* Free the derived type list.  */
 
 static void
-gfc_free_dt_list (gfc_dt_list * dt)
+gfc_free_dt_list (void)
 {
-  gfc_dt_list *n;
+  gfc_dt_list *dt, *n;
 
-  for (; dt; dt = n)
+  for (dt = gfc_derived_types; dt; dt = n)
     {
       n = dt->next;
       gfc_free (dt);
     }
+
+  gfc_derived_types = NULL;
 }
 
 
@@ -2605,8 +2609,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]);
 
@@ -2639,6 +2641,7 @@ gfc_symbol_done_2 (void)
 
   gfc_free_namespace (gfc_current_ns);
   gfc_current_ns = NULL;
+  gfc_free_dt_list ();
 }
 
 

gcc/fortran/trans-types.c

@@ -1463,7 +1463,6 @@ 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);
 
@@ -1479,39 +1478,6 @@ gfc_get_derived_type (gfc_symbol * derived)
     }
   else
     {
-      /* If an equal derived type is already available in the parent namespace,
-	 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.  If an equal type is found without a backend_decl,
-	 build the parent version and use it in the current namespace.  */
-      if (derived->ns->parent)
-	ns = derived->ns->parent;
-      else if (derived->ns->proc_name
-		 && derived->ns->proc_name->ns != derived->ns)
-	/* Derived types in an interface body obtain their parent reference
-	   through the proc_name symbol.  */
-	ns = derived->ns->proc_name->ns;
-      else
-	/* Sometimes there isn't a parent reference!  */
-	ns = NULL;
-
-      for (; ns; ns = ns->parent)
-	{
-	  for (dt = ns->derived_types; dt; dt = dt->next)
-	    {
-	      if (dt->derived == derived)
-		continue;
-
-	      if (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);
@@ -1591,12 +1557,8 @@ 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 and sibling namespaces.  */
-  ns = derived->ns->parent ? derived->ns->parent->contained : derived->ns;
-  for (; ns; ns = ns->sibling)
-    for (dt = ns->derived_types; dt; dt = dt->next)
+    /* Add this backend_decl to all the other, equal derived types.  */
+    for (dt = gfc_derived_types; dt; dt = dt->next)
       copy_dt_decls_ifequal (derived, dt->derived);
 
   return derived->backend_decl;

gcc/testsuite/ChangeLog

+2007-03-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30531
+	* gfortran.dg/used_types_14.f90: New test.
+
+	PR fortran/31086
+	* gfortran.dg/used_types_15.f90: New test.
+
 2007-03-18  Dorit Nuzman  <dorit@il.ibm.com>
 
 	* gcc.dg/vect/no-tree-dom-vect-bug.c: New test.

gcc/testsuite/gfortran.dg/used_types_14.f90

+! { dg-do compile }
+! Tests the fix for PR30531 in which the interface derived types
+! was not being associated.
+!
+! Contributed by Salvatore Filippone  <sfilippone@uniroma2.it>
+!
+module foo_type_mod
+  type foo_type
+     integer, allocatable :: md(:)
+  end type foo_type
+end module foo_type_mod
+
+module foo_mod
+
+  interface
+    subroutine foo_initvg(foo_a)
+      use foo_type_mod
+      Type(foo_type), intent(out) :: foo_a
+    end subroutine foo_initvg
+  end interface
+
+contains
+
+  subroutine foo_ext(foo_a)
+    use foo_type_mod
+    Type(foo_type) :: foo_a
+
+    call foo_initvg(foo_a)
+  end subroutine foo_ext
+
+end module foo_mod
+! { dg-final { cleanup-modules "foo_type_mod foo_mod" } }

gcc/testsuite/gfortran.dg/used_types_15.f90

+! { dg-do compile }
+! Tests the fix for PR31086 in which the chained derived types
+! was not being associated.
+!
+! Contributed by Daniel Franke <dfranke@gcc.gnu.org>
+!
+MODULE class_dummy_atom_types
+TYPE :: dummy_atom_list
+  TYPE(dummy_atom), DIMENSION(:), POINTER :: table
+END TYPE
+
+TYPE :: dummy_atom
+  TYPE(dummy_atom_list) :: neighbours
+END TYPE
+
+TYPE :: dummy_atom_model
+  TYPE(dummy_atom_list) :: atoms
+END TYPE
+END MODULE
+
+MODULE test_class_intensity_private
+CONTAINS
+  SUBROUTINE change_phase(atom)
+    USE class_dummy_atom_types
+    TYPE(dummy_atom), INTENT(inout) :: atom
+  END SUBROUTINE
+
+  SUBROUTINE simulate_cube()
+    USE class_dummy_atom_types
+    TYPE(dummy_atom)       :: atom
+    TYPE(dummy_atom_model) :: dam
+    atom = dam%atoms%table(1)
+  END SUBROUTINE
+END MODULE
+! { dg-final { cleanup-modules "class_dummy_atom_types test_class_intensity_private" } }