diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2012-01-05 21:15:52 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2012-01-05 21:15:52 +0000 |
| commit | 003e0ad60130a4ba700a7b65e58ffcf0f051076c (patch) | |
| tree | 31b9d65f981832104905adc6a62d92f7429f99fe /gcc/fortran/resolve.c | |
| parent | f7d6ad0a5c2b3759f1952aa23bf5941013fec280 (diff) | |
| download | gcc-003e0ad60130a4ba700a7b65e58ffcf0f051076c.zip gcc-003e0ad60130a4ba700a7b65e58ffcf0f051076c.tar.gz gcc-003e0ad60130a4ba700a7b65e58ffcf0f051076c.tar.bz2 | |
PR fortran/PR48946
2012-01-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/PR48946
* resolve.c (resolve_typebound_static): If the typebound
procedure is 'deferred' try to find the correct specific
procedure in the derived type operator space itself.
2012-01-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/PR48946
* gfortran.dg/typebound_operator_9.f03: This is now a copy of
the old typebound_operator_8.f03.
* gfortran.dg/typebound_operator_8.f03: New version of
typebound_operator_7.f03 with 'u' a derived type instead of a
class object.
From-SVN: r182929
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 33 |
1 files changed, 33 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 82045f8..79245ce 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5614,6 +5614,39 @@ resolve_typebound_static (gfc_expr* e, gfc_symtree** target, e->ref = NULL; e->value.compcall.actual = NULL; + /* If we find a deferred typebound procedure, check for derived types + that an over-riding typebound procedure has not been missed. */ + if (e->value.compcall.tbp->deferred + && e->value.compcall.name + && !e->value.compcall.tbp->non_overridable + && e->value.compcall.base_object + && e->value.compcall.base_object->ts.type == BT_DERIVED) + { + gfc_symtree *st; + gfc_symbol *derived; + + /* Use the derived type of the base_object. */ + derived = e->value.compcall.base_object->ts.u.derived; + st = NULL; + + /* If necessary, go throught the inheritance chain. */ + while (!st && derived) + { + /* Look for the typebound procedure 'name'. */ + if (derived->f2k_derived && derived->f2k_derived->tb_sym_root) + st = gfc_find_symtree (derived->f2k_derived->tb_sym_root, + e->value.compcall.name); + if (!st) + derived = gfc_get_derived_super_type (derived); + } + + /* Now find the specific name in the derived type namespace. */ + if (st && st->n.tb && st->n.tb->u.specific) + gfc_find_sym_tree (st->n.tb->u.specific->name, + derived->ns, 1, &st); + if (st) + *target = st; + } return SUCCESS; } |