Skip to content

[flang] incorrect diagnostic of type-bound-generic-stmt in defined I/O #111021

@kkwli

Description

@kkwli

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 program

Compile 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 program

Output:

f2 ...

Metadata

Metadata

Assignees

Type

No type

Projects

No projects

Milestone

No milestone

Relationships

None yet

Development

No branches or pull requests

Issue actions