}
-/* 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 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. */
+/* Recursive function to switch derived types of all symbol in a
+ namespace. */
static void
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);
gfc_symbol *s;
gfc_typespec *t;
gfc_symtree *st;
- gfc_component *c;
- gfc_namespace *ns;
int i;
- if (sym->ns->parent == NULL || sym->ns != gfc_current_ns)
- {
- /* Already defined in highest possible or sibling 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;
+ if (sym->components != NULL)
+ return sym; /* Already defined. */
- /* Derived types must be defined within an interface. */
- if (gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY)
- return sym;
- }
+ if (sym->ns->parent == NULL)
+ goto bad;
- /* 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);
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. */
- s = find_renamed_type (sym, sym->ns->parent->sym_root);
- if (s != NULL)
- goto return_use_assoc;
-
- /* 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)
- goto return_use_assoc;
- }
- }
-
- /* 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;
t->derived = s;
}
- if (sym->attr.use_assoc)
- goto return_use_assoc;
-
st = gfc_find_symtree (sym->ns->sym_root, sym->name);
st->n.sym = s;
return s;
-return_use_assoc:
- /* Use associated types are not freed at this stage because some
- references remain to 'sym'. We retain the symbol and leave it
- to be cleaned up by gfc_free_namespace, at the end of the
- compilation. */
- switch_types (sym->ns->sym_root, sym, s);
- return s;
-
bad:
gfc_error ("Derived type '%s' at %C is being used before it is defined",
sym->name);
}
+/* 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
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]);
OSDN Git Service
