[flang] DTIO: Polymorphic passed-object does not have the correct dynamic type in DTIO procedure.

[DanielCChen]

Consider the following reducer:

module m
   type base
      character(3) :: c
      contains
         procedure, pass :: write
   end type

   type, extends(base) :: child
      integer(4) :: i
   end type

   interface write(formatted)
      subroutine writeformatted(dtv, unit, iotype, v_list, iostat, iomsg )
         import base
         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
      end subroutine
   end interface

   integer :: unit = 1
   integer :: stat
   character(200) :: msg

contains

   class(base) function write(dtv)
      class(base), intent(in) :: dtv
      allocatable :: write
      namelist /W/ write

      allocate ( write, source = dtv )
      write (unit, W, iostat = stat, iomsg = msg )

   end function

end module

program funcRetrn001a
   use m

   class(base), allocatable :: b1
   type(child)              :: c1 = child ('FTN',123)

   open (1, file = 'funcRetrn001a.1', form='formatted', access='sequential' )

   b1 = c1%write()   !! The passed-object is of type Child.

end program


subroutine writeformatted (dtv, unit, iotype, v_list, iostat, iomsg)
   use m, only: base,child

   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

   select type (dtv)
      type is (base)
print*, "base"
      type is (child)
print*, "child"
   end select
end subroutine

Flang outputs base, while the expected output is child (both gfortran and XLF).

The type of the passed-object of c1%write() call should be child instead of base.

[llvmbot]

@llvm/issue-subscribers-flang-runtime

Author: Daniel Chen (DanielCChen)

Consider the following reducer: ``` module m type base character(3) :: c contains procedure, pass :: write end type

type, extends(base) :: child
integer(4) :: i
end type

interface write(formatted)
subroutine writeformatted(dtv, unit, iotype, v_list, iostat, iomsg )
import base
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
end subroutine
end interface

integer :: unit = 1
integer :: stat
character(200) :: msg

contains

class(base) function write(dtv)
class(base), intent(in) :: dtv
allocatable :: write
namelist /W/ write

  allocate ( write, source = dtv )
  write (unit, W, iostat = stat, iomsg = msg )

end function

end module

program funcRetrn001a
use m

class(base), allocatable :: b1
type(child) :: c1 = child ('FTN',123)

open (1, file = 'funcRetrn001a.1', form='formatted', access='sequential' )

b1 = c1%write() !! The passed-object is of type Child.

end program

subroutine writeformatted (dtv, unit, iotype, v_list, iostat, iomsg)
use m, only: base,child

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

select type (dtv)
type is (base)
print*, "base"
type is (child)
print*, "child"
end select
end subroutine

Flang outputs `base`, while the expected output is `child` (both gfortran and XLF).

The type of the passed-object of `c1%write()` call should be `child` instead of `base`.
</details>

[klausler]

This is a lowering bug. The descriptor to which the entry in the NamelistGroup points (namely the allocatable function result variable write) has the incorrect derived type (base) in its addendum, not its current dynamic type. I confirmed via SELECT TYPE that the polymorphic dummy argument dtv has the extended type child before being used as the source of the allocation of write, and that write has the same type child after the allocation and before the namelist write.

[jeanPerier]

This issue is that IO lowering is creating a temporary descriptor for the namelist entity according to the static type here (it is using the fir::BoxType while fir::ClassType has to be used for polymorphic entities).

TODO:

• Check why a temporary descriptor is needed here (why not using the one from write result directly?).
• If a temporary descriptor is needed, compute the FIR type using getBoxTypeWithNewAttr instead of manually building the type.
• The similar code for global variables may suffer from the same issue here.

[DanielCChen]

1. The temporary descriptor is indeed needed for all cases other than fir::ClassType.
2. However, for the fir::ClassType namelist item, we can directly use its own descriptor.
3. Based on the first 2 items, the non-allocatable, non-pointer case seems OK as it will need a temporary descriptor of the declare type.