diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2010-03-08 10:35:04 +0100 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2010-03-08 10:35:04 +0100 |
| commit | b3d286bac21f41e1680e2f364e0733c8ebf2c9ad (patch) | |
| tree | eaa65acb0a14fd9bdf95330dcf09127481313e87 /gcc/fortran/resolve.c | |
| parent | 196c8bc8a319d0be3018c66339e00985857bd627 (diff) | |
| download | gcc-b3d286bac21f41e1680e2f364e0733c8ebf2c9ad.zip gcc-b3d286bac21f41e1680e2f364e0733c8ebf2c9ad.tar.gz gcc-b3d286bac21f41e1680e2f364e0733c8ebf2c9ad.tar.bz2 | |
re PR fortran/43256 ([OOP] TBP with missing optional arg)
2010-03-08 Janus Weil <janus@gcc.gnu.org>
PR fortran/43256
* resolve.c (resolve_compcall): Don't set 'value.function.name' here
for TBPs, otherwise they will not be resolved properly.
(resolve_function): Use 'value.function.esym' instead of
'value.function.name' to check if we're dealing with a TBP.
(check_class_members): Set correct type of passed object for all TBPs,
not only generic ones, except if the type is abstract.
2010-03-08 Janus Weil <janus@gcc.gnu.org>
PR fortran/43256
* gfortran.dg/typebound_call_13.f03: New.
From-SVN: r157272
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 25 |
1 files changed, 12 insertions, 13 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 10d8807..16661fd 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2556,8 +2556,8 @@ resolve_function (gfc_expr *expr) } /* If this ia a deferred TBP with an abstract interface (which may - of course be referenced), expr->value.function.name will be set. */ - if (sym && sym->attr.abstract && !expr->value.function.name) + of course be referenced), expr->value.function.esym will be set. */ + if (sym && sym->attr.abstract && !expr->value.function.esym) { gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L", sym->name, &expr->where); @@ -5124,7 +5124,7 @@ resolve_compcall (gfc_expr* e, bool fcn) return FAILURE; e->value.function.actual = newactual; - e->value.function.name = e->value.compcall.name; + e->value.function.name = NULL; e->value.function.esym = target->n.sym; e->value.function.class_esym = NULL; e->value.function.isym = NULL; @@ -5178,18 +5178,17 @@ check_class_members (gfc_symbol *derived) return; } - if (tbp->n.tb->is_generic) + /* If we have to match a passed class member, force the actual + expression to have the correct type. */ + if (!tbp->n.tb->nopass) { - /* If we have to match a passed class member, force the actual - expression to have the correct type. */ - if (!tbp->n.tb->nopass) - { - if (e->value.compcall.base_object == NULL) - e->value.compcall.base_object = - extract_compcall_passed_object (e); + if (e->value.compcall.base_object == NULL) + e->value.compcall.base_object = extract_compcall_passed_object (e); - e->value.compcall.base_object->ts.type = BT_DERIVED; - e->value.compcall.base_object->ts.u.derived = derived; + if (!derived->attr.abstract) + { + e->value.compcall.base_object->ts.type = BT_DERIVED; + e->value.compcall.base_object->ts.u.derived = derived; } } |