re PR fortran/86863 ([OOP][F2008] type-bound module procedure name not recognized)
2017-08-23 Paul Thomas <pault@gcc.gnu.org> 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 <pault@gcc.gnu.org> PR fortran/86863 * gfortran.dg/submodule_32.f08: New test. From-SVN: r263799
This commit is contained in:
parent
ba7a2ad8bd
commit
6ab6c0c3bb
|
@ -1,3 +1,9 @@
|
|||
2017-08-23 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
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 <tkoenig@gcc.gnu.org>
|
||||
|
||||
* gfortran.texi: Mention that asynchronous I/O does
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2017-08-23 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/86863
|
||||
* gfortran.dg/submodule_32.f08: New test.
|
||||
|
||||
2018-08-22 Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
PR fortran/86935
|
||||
|
|
|
@ -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 <damian@sourceryinstitute.org>
|
||||
!
|
||||
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
|
Loading…
Reference in New Issue