This is the mail archive of the
gcc-bugs@gcc.gnu.org
mailing list for the GCC project.
[Bug fortran/78737] [OOP] linking error with deferred, undefined user-defined derived-type I/O
- From: "pault at gcc dot gnu.org" <gcc-bugzilla at gcc dot gnu dot org>
- To: gcc-bugs at gcc dot gnu dot org
- Date: Sun, 11 Dec 2016 13:11:31 +0000
- Subject: [Bug fortran/78737] [OOP] linking error with deferred, undefined user-defined derived-type I/O
- Auto-submitted: auto-generated
- References: <bug-78737-4@http.gcc.gnu.org/bugzilla/>
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=78737
--- Comment #9 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 40302
--> https://gcc.gnu.org/bugzilla/attachment.cgi?id=40302&action=edit
A workaround for the PR (even a patch?)
The attached allows this testcase to run as intended:
! { dg-do run }
!
! Test the fix for PR78737. This is a development of the testscase
! in comment #6, which runs as intended.
!
! Contributed by Damian Rouson <damian@sourceryinstitute.org>
!
module object_interface
type, abstract :: object
contains
procedure(write_formatted), deferred :: write_formatted
generic :: write(formatted) => write_formatted
end type
! First extended type
type, extends(object) :: non_abstract_child1
integer :: i
contains
! Point write_formatted to a specific procedure
procedure :: write_formatted => write_formatted1
end type
! Second extended type
type, extends(object) :: non_abstract_child2
real :: r
contains
! Use the instantiation of the generic name
procedure :: write_formatted
end type
! Third extended type
type, extends(object) :: non_abstract_child3
character(3) :: c
contains
! Use the instantiation of the generic name
procedure :: write_formatted
end type
contains
subroutine write_formatted1(this,unit,iotype,vlist,iostat,iomsg)
class(non_abstract_child1), intent(in) :: this
integer, intent(in) :: unit
character (len=*), intent(in) :: iotype
integer, intent(in) :: vlist(:)
integer, intent(out) :: iostat
character (len=*), intent(inout) :: iomsg
if (this%i .ne. 99) call abort
end subroutine
subroutine write_formatted(this,unit,iotype,vlist,iostat,iomsg)
class(object), intent(in) :: this
integer, intent(in) :: unit
character (len=*), intent(in) :: iotype
integer, intent(in) :: vlist(:)
integer, intent(out) :: iostat
character (len=*), intent(inout) :: iomsg
select type (this)
class is (non_abstract_child1)
if (this%i .ne. 99) call abort
class is (non_abstract_child2)
if (abs (this%r - 3.14159274) .gt. 1.0e-6) call abort
class is (non_abstract_child3)
if (this%c .ne. "abc") call abort
end select
end subroutine
subroutine assert(a)
class(object):: a
select type (a)
class is (non_abstract_child1)
write(*,*) a
class default
write(*,*) a
end select
end subroutine
end module
use object_interface
class(object), allocatable :: z
allocate (z, source = non_abstract_child1 (99))
call assert (z)
write (*,*) z
deallocate (z)
allocate (z, source = non_abstract_child2 (2.0*acos(0.0)))
call assert (z)
write (*,*) z
deallocate (z)
allocate (z, source = non_abstract_child3 ("abc"))
call assert (z)
write (*,*) z
end
Boostraps and regtests OK.
Paul