/* See if we already have a binding with this name in the symtree which would
be an error. If a GENERIC already targetted this binding, it may be
already there but then typebound is still NULL. */
- stree = gfc_find_symtree (ns->sym_root, name);
- if (stree && stree->typebound)
+ stree = gfc_find_symtree (ns->tb_sym_root, name);
+ if (stree && stree->n.tb)
{
gfc_error ("There's already a procedure with binding name '%s' for the"
" derived type '%s' at %C", name, block->name);
}
/* Insert it and set attributes. */
- if (gfc_get_sym_tree (name, ns, &stree))
- return MATCH_ERROR;
+
+ if (!stree)
+ {
+ stree = gfc_new_symtree (&ns->tb_sym_root, name);
+ gcc_assert (stree);
+ }
+ stree->n.tb = tb;
+
if (gfc_get_sym_tree (target, gfc_current_ns, &tb->u.specific))
return MATCH_ERROR;
gfc_set_sym_referenced (tb->u.specific->n.sym);
- stree->typebound = tb;
return MATCH_YES;
}
/* If there's already something with this name, check that it is another
GENERIC and then extend that rather than build a new node. */
- st = gfc_find_symtree (ns->sym_root, name);
+ st = gfc_find_symtree (ns->tb_sym_root, name);
if (st)
{
- if (!st->typebound || !st->typebound->is_generic)
+ gcc_assert (st->n.tb);
+ tb = st->n.tb;
+
+ if (!tb->is_generic)
{
gfc_error ("There's already a non-generic procedure with binding name"
" '%s' for the derived type '%s' at %C",
goto error;
}
- tb = st->typebound;
if (tb->access != tbattr.access)
{
gfc_error ("Binding at %C must have the same access as already"
}
else
{
- if (gfc_get_sym_tree (name, ns, &st))
- return MATCH_ERROR;
+ st = gfc_new_symtree (&ns->tb_sym_root, name);
+ gcc_assert (st);
- st->typebound = tb = gfc_get_typebound_proc ();
+ st->n.tb = tb = gfc_get_typebound_proc ();
tb->where = gfc_current_locus;
tb->access = tbattr.access;
tb->is_generic = 1;
goto error;
}
- if (gfc_get_sym_tree (name, ns, &target_st))
- goto error;
+ target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name);
/* See if this is a duplicate specification. */
for (target = tb->u.generic; target; target = target->next)
if (target_st == target->specific_st)
{
gfc_error ("'%s' already defined as specific binding for the"
- " generic '%s' at %C", name, st->n.sym->name);
+ " generic '%s' at %C", name, st->name);
goto error;
}
- gfc_set_sym_referenced (target_st->n.sym);
-
target = gfc_get_tbp_generic ();
target->specific_st = target_st;
target->specific = NULL;