diff options
Diffstat (limited to 'gcc/fortran/decl.c')
| -rw-r--r-- | gcc/fortran/decl.c | 36 |
1 files changed, 20 insertions, 16 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index b99989f..1a2e845 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -7141,8 +7141,8 @@ match_procedure_in_type (void) /* 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); @@ -7150,12 +7150,17 @@ match_procedure_in_type (void) } /* 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; } @@ -7210,10 +7215,13 @@ gfc_match_generic (void) /* 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", @@ -7221,7 +7229,6 @@ gfc_match_generic (void) goto error; } - tb = st->typebound; if (tb->access != tbattr.access) { gfc_error ("Binding at %C must have the same access as already" @@ -7231,10 +7238,10 @@ gfc_match_generic (void) } 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; @@ -7256,20 +7263,17 @@ gfc_match_generic (void) 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; |