-
Notifications
You must be signed in to change notification settings - Fork 15.2k
Closed
Labels
Description
Flang flags the code as error if the type-bound-generic-stmt is omitted in the child type.
Reproducer:
module m
type base
character(3) :: c = 'xxx'
contains
procedure, pass :: write => writebase
generic :: write(formatted) => write
end type
type, extends(base) :: child
integer(4) :: i = -999
contains
procedure, pass :: write => writechild
! generic :: write(formatted) => write
end type
contains
subroutine writebase(dtv, unit, iotype, v_list, iostat, iomsg)
class(base), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
write(unit, *, iostat=iostat, iomsg=iomsg) dtv%c
iomsg = 'dtiobasewrite'
end subroutine
subroutine writechild(dtv, unit, iotype, v_list, iostat, iomsg)
class(child), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
write(unit, *, iostat=iostat, iomsg=iomsg) dtv%c, dtv%i
iomsg = 'dtiochildwrite'
end subroutine
end module
program main
use m
class(child), pointer :: c1
character(40) :: msg
allocate(c1, source=child('abc', 2024))
write(*, "(DT)") c1
end programCompile output:
$ flang-new d.f90
error: Semantic errors in d.f90
./d.f90:42:20: error: Derived type 'child' in I/O may not be polymorphic unless using defined I/O
write(*, "(DT)") c1
^^
A similar case that no error is flagged.
module m
type base
contains
procedure, nopass :: f => f1
generic :: g => f
end type
type, extends(base) :: child
contains
procedure, nopass :: f => f2
! generic :: g => f
end type
contains
subroutine f1()
print *, 'f1 ...'
end subroutine
subroutine f2()
print *, 'f2 ...'
end subroutine
end module
program specific004
use m
class(child), pointer :: c1
allocate(c1)
call c1%g()
end programOutput:
f2 ...