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
-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.
#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. */
/* 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;
}
/* 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;
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
static gfc_symbol *changed_syms = NULL;
+gfc_dt_list *gfc_derived_types;
+
/*********** IMPLICIT NONE and IMPLICIT statement handlers ***********/
}
-/* 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;
}
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]);
gfc_free_namespace (gfc_current_ns);
gfc_current_ns = NULL;
+ gfc_free_dt_list ();
}
tree typenode, field, field_type, fieldlist;
gfc_component *c;
gfc_dt_list *dt;
- gfc_namespace * ns;
gcc_assert (derived && derived->attr.flavor == FL_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);
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;
+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.
--- /dev/null
+! { 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" } }
--- /dev/null
+! { 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" } }
projects / thirdparty / gcc.git / commitdiff
