From: Paul Thomas Date: Thu, 23 Aug 2018 06:27:54 +0000 (+0000) Subject: re PR fortran/86863 ([OOP][F2008] type-bound module procedure name not recognized) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=6ab6c0c3bb09707f993a748c67087838f6b7d5f9;p=gcc.git re PR fortran/86863 ([OOP][F2008] type-bound module procedure name not recognized) 2017-08-23 Paul Thomas PR fortran/86863 * resolve.c (resolve_typebound_call): If the TBP is not marked as a subroutine, check the specific symbol. 2017-08-23 Paul Thomas PR fortran/86863 * gfortran.dg/submodule_32.f08: New test. From-SVN: r263799 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 56e9c952795..4cbdc68289a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2017-08-23 Paul Thomas + + PR fortran/86863 + * resolve.c (resolve_typebound_call): If the TBP is not marked + as a subroutine, check the specific symbol. + 2018-08-22 Thomas Koenig * gfortran.texi: Mention that asynchronous I/O does diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 4ad4dcf780d..43a8470e748 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6266,9 +6266,17 @@ resolve_typebound_call (gfc_code* c, const char **name, bool *overridable) /* 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 (!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)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8e70d0564ec..d011aa73e38 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-08-23 Paul Thomas + + PR fortran/86863 + * gfortran.dg/submodule_32.f08: New test. + 2018-08-22 Janus Weil PR fortran/86935 diff --git a/gcc/testsuite/gfortran.dg/submodule_32.f08 b/gcc/testsuite/gfortran.dg/submodule_32.f08 new file mode 100644 index 00000000000..529015b86ec --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_32.f08 @@ -0,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