[Bug fortran/53694] [OOP] GENERIC type-bound procs should be available without part-ref syntax
janus at gcc dot gnu.org
gcc-bugzilla@gcc.gnu.org
Tue Jun 19 10:47:00 GMT 2012
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=53694
--- Comment #6 from janus at gcc dot gnu.org 2012-06-19 10:46:56 UTC ---
(In reply to comment #5)
> Btw, I'm not completely convinced yet that the code in comment #0 (and #4) is
> really legal.
In any case, here is a simple draft patch, which makes the code in comment 4
work (at least when the ONLY clause in the USE statement is removed):
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 188334)
+++ gcc/fortran/decl.c (working copy)
@@ -8374,12 +8374,20 @@ gfc_match_generic (void)
{
const bool is_op = (op_type == INTERFACE_USER_OP);
gfc_symtree* st;
+ gfc_symbol *gensym;
st = gfc_new_symtree (is_op ? &ns->tb_uop_root : &ns->tb_sym_root,
name);
gcc_assert (st);
st->n.tb = tb;
+ /* Create non-typebound generic symbol. */
+ if (gfc_get_symbol (name, NULL, &gensym))
+ return MATCH_ERROR;
+ if (!gensym->attr.generic
+ && gfc_add_generic (&gensym->attr, gensym->name, NULL) == FAILURE)
+ return MATCH_ERROR;
+
break;
}
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 188335)
+++ gcc/fortran/resolve.c (working copy)
@@ -11125,6 +11125,26 @@ specific_found:
return FAILURE;
}
+ /* Add target to (non-typebound) generic symbol. */
+ if (!p->u.generic->is_operator)
+ {
+ gfc_symbol *gensym;
+ if (gfc_get_symbol (name, NULL, &gensym))
+ return FAILURE;
+ if (gensym)
+ {
+ gfc_interface *head, *intr;
+ head = gensym->generic;
+ intr = gfc_get_interface ();
+ intr->sym = target->specific->u.specific->n.sym;
+ intr->where = gfc_current_locus;
+ intr->sym->declared_at = gfc_current_locus;
+ intr->next = head;
+ gensym->generic = intr;
+ gfc_commit_symbol (gensym);
+ }
+ }
+
/* Check those already resolved on this type directly. */
for (g = p->u.generic; g; g = g->next)
if (g != target && g->specific
More information about the Gcc-bugs
mailing list