Index: gcc/fortran/resolve.c =================================================================== *** gcc/fortran/resolve.c (revision 263494) --- gcc/fortran/resolve.c (working copy) *************** resolve_typebound_call (gfc_code* c, con *** 6266,6274 **** /* Check that's really a SUBROUTINE. */ if (!c->expr1->value.compcall.tbp->subroutine) { ! gfc_error ("%qs at %L should be a SUBROUTINE", ! c->expr1->value.compcall.name, &c->loc); ! return false; } if (!check_typebound_baseobject (c->expr1)) --- 6266,6282 ---- /* Check that's really a SUBROUTINE. */ if (!c->expr1->value.compcall.tbp->subroutine) { ! if (!c->expr1->value.compcall.tbp->is_generic ! && c->expr1->value.compcall.tbp->u.specific ! && c->expr1->value.compcall.tbp->u.specific->n.sym ! && c->expr1->value.compcall.tbp->u.specific->n.sym->attr.subroutine) ! c->expr1->value.compcall.tbp->subroutine = 1; ! else ! { ! gfc_error ("%qs at %L should be a SUBROUTINE", ! c->expr1->value.compcall.name, &c->loc); ! return false; ! } } if (!check_typebound_baseobject (c->expr1)) Index: gcc/testsuite/gfortran.dg/submodule_32.f08 =================================================================== *** gcc/testsuite/gfortran.dg/submodule_32.f08 (nonexistent) --- gcc/testsuite/gfortran.dg/submodule_32.f08 (working copy) *************** *** 0 **** --- 1,62 ---- + ! { dg-do run } + ! + ! Test the fix for PR86863, where the Type Bound Procedures were + ! not flagged as subroutines thereby causing an error at the call + ! statements. + ! + ! Contributed by Damian Rouson + ! + module foo + implicit none + integer :: flag = 0 + type bar + contains + procedure, nopass :: foobar + procedure, nopass :: barfoo + end type + contains + subroutine foobar + flag = 1 + end subroutine + subroutine barfoo + flag = 0 + end subroutine + end module + + module foobartoo + implicit none + interface + module subroutine set(object) + use foo + implicit none + type(bar) object + end subroutine + module subroutine unset(object) + use foo + implicit none + type(bar) object + end subroutine + end interface + contains + module procedure unset + use foo, only : bar + call object%barfoo + end procedure + end module + + submodule(foobartoo) subfoobar + contains + module procedure set + use foo, only : bar + call object%foobar + end procedure + end submodule + + use foo + use foobartoo + type(bar) :: obj + call set(obj) + if (flag .ne. 1) stop 1 + call unset(obj) + if (flag .ne. 0) stop 2 + end