https://gcc.gnu.org/bugzilla/show_bug.cgi?id=78737
--- Comment #15 from Paul Thomas <pault at gcc dot gnu.org> ---
(In reply to Damian Rouson from comment #14)
> Hi Paul,
>
> Based on comment #12, I assume you no longer believe that type guarding is
> required. If I misinterpreted comment #12, please let me know. Otherwise,
> please let me know what in the standard indicates that type guarding is
> required. I too would be surprised.
Dear Damian and Janus,
What I meant is that we did not implement dynamic dispatch of the dtio
procedures. In the corrected testcase of comments #12 and #13, where the first
argument of write_formatted has declared type 'object', it is necessary to use
type guarding within write_formatted to obtain the appropriate IO.
I have to confess that this "interpretation" is arrived at by the absence of
any mention of the need for dynamic dispatch and by the implementation by other
vendors.
See this further example, which works with the last version of the patch.
module object_interface
type, abstract :: object
contains
procedure(write_formatted_interface), deferred :: write_formatted
generic :: write(formatted) => write_formatted
end type
abstract interface
subroutine write_formatted_interface(this,unit,iotype,vlist,iostat,iomsg)
import object
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
end subroutine
end interface
type, extends(object) :: non_abstract_child
integer :: i
contains
procedure :: write_formatted => write_formatted2
end type
contains
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_child)
print '(a,i4/)', "write_formatted => ", this%i
print *, this
class default
print *, "Error"
end select
end subroutine
subroutine write_formatted2(this,unit,iotype,vlist,iostat,iomsg)
class(non_abstract_child), 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
print '(a,i4/)', "write_formatted2 => ", this%i
end subroutine
subroutine assert(a)
class(object):: a
write(*,*) a
end subroutine
end module
use object_interface
class (object), allocatable :: z
allocate (z, source = non_abstract_child (99))
call assert (z)
end
Is this now OK?
Paul
