Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 158958) +++ gcc/fortran/resolve.c (working copy) @@ -5123,6 +5123,43 @@ } +/* Get the ultimate declared type from an expression. In addition, + return the last class/derived type reference and the copy of the + reference list. */ +static gfc_symbol* +get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref, + gfc_expr *e) +{ + gfc_symbol *declared; + gfc_ref *ref; + + declared = NULL; + if (class_ref) + *class_ref = NULL; + if (new_ref) + *new_ref = gfc_copy_ref (e->ref); + + for (ref = e->ref; ref; ref = ref->next) + { + if (ref->type != REF_COMPONENT) + continue; + + if (ref->u.c.component->ts.type == BT_CLASS + || ref->u.c.component->ts.type == BT_DERIVED) + { + declared = ref->u.c.component->ts.u.derived; + if (class_ref) + *class_ref = ref; + } + } + + if (declared == NULL) + declared = e->symtree->n.sym->ts.u.derived; + + return declared; +} + + /* Given an EXPR_COMPCALL calling a GENERIC typebound procedure, figure out which of the specific bindings (if any) matches the arglist and transform the expression into a call of that binding. */ @@ -5132,6 +5169,8 @@ { gfc_typebound_proc* genproc; const char* genname; + gfc_symtree *st; + gfc_symbol *derived; gcc_assert (e->expr_type == EXPR_COMPCALL); genname = e->value.compcall.name; @@ -5199,6 +5238,19 @@ return FAILURE; success: + /* Make sure that we have the right specific instance for the name. */ + genname = e->value.compcall.tbp->u.specific->name; + + /* Is the symtree name a "unique name". */ + if (*genname == '@') + genname = e->value.compcall.tbp->u.specific->n.sym->name; + + derived = get_declared_from_expr (NULL, NULL, e); + + st = gfc_find_typebound_proc (derived, NULL, genname, false, &e->where); + if (st) + e->value.compcall.tbp = st->n.tb; + return SUCCESS; } @@ -5306,39 +5358,7 @@ } -/* Get the ultimate declared type from an expression. In addition, - return the last class/derived type reference and the copy of the - reference list. */ -static gfc_symbol* -get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref, - gfc_expr *e) -{ - gfc_symbol *declared; - gfc_ref *ref; - declared = NULL; - *class_ref = NULL; - *new_ref = gfc_copy_ref (e->ref); - for (ref = *new_ref; ref; ref = ref->next) - { - if (ref->type != REF_COMPONENT) - continue; - - if (ref->u.c.component->ts.type == BT_CLASS - || ref->u.c.component->ts.type == BT_DERIVED) - { - declared = ref->u.c.component->ts.u.derived; - *class_ref = ref; - } - } - - if (declared == NULL) - declared = e->symtree->n.sym->ts.u.derived; - - return declared; -} - - /* Resolve a typebound function, or 'method'. First separate all the non-CLASS references by calling resolve_compcall directly. */ Index: gcc/testsuite/gfortran.dg/generic_23.f03 =================================================================== --- gcc/testsuite/gfortran.dg/generic_23.f03 (revision 0) +++ gcc/testsuite/gfortran.dg/generic_23.f03 (revision 0) @@ -0,0 +1,67 @@ +! { dg-do run } +! Test the fix for PR43945 in which the over-ridding of 'doit' and +! 'getit' in type 'foo2' was missed in the specific binding to 'do' and 'get'. +! +! Contributed by Tobias Burnus +! and reported to clf by Salvatore Filippone +! +module foo_mod + type foo + integer :: i + contains + procedure, pass(a) :: doit + procedure, pass(a) :: getit + generic, public :: do => doit + generic, public :: get => getit + end type foo + private doit,getit +contains + subroutine doit(a) + class(foo) :: a + a%i = 1 + write(*,*) 'FOO%DOIT base version' + end subroutine doit + function getit(a) result(res) + class(foo) :: a + integer :: res + res = a%i + end function getit +end module foo_mod + +module foo2_mod + use foo_mod + type, extends(foo) :: foo2 + integer :: j + contains + procedure, pass(a) :: doit => doit2 + procedure, pass(a) :: getit => getit2 +!!$ generic, public :: do => doit +!!$ generic, public :: get => getit + end type foo2 + private doit2, getit2 + +contains + + subroutine doit2(a) + class(foo2) :: a + a%i = 2 + a%j = 3 + end subroutine doit2 + function getit2(a) result(res) + class(foo2) :: a + integer :: res + res = a%j + end function getit2 +end module foo2_mod + +program testd15 + use foo2_mod + type(foo2) :: af2 + + call af2%do() + if (af2%i .ne. 2) call abort + if (af2%get() .ne. 3) call abort + +end program testd15 + +! { dg-final { cleanup-modules "foo_mod foo2_mod" } }