[flang] DTIO: Failed to read based on component order when using generic interface

[DanielCChen]

Consider the following code:

module m
    type A
        integer id
    end type

    type B
        character(20) :: name
    end type

    type base
        type (A) a1
        type (B) b1
    end type
end module


program fdtio511
use m
    interface read(formatted)
        subroutine formattedReadA (dtv, unit, iotype, v_list, iostat, iomsg)
         import
            class (A), intent(inout) :: dtv
            integer, intent(in) :: unit
            character(*), intent(in) :: iotype
            integer, intent(in) :: v_list(:)
            integer, intent(out) :: iostat
            character(*), intent(inout) :: iomsg
        end subroutine

        subroutine formattedReadB (dtv, unit, iotype, v_list, iostat, iomsg)
          import
            class (B), intent(inout) :: 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

    interface write(formatted)
        subroutine formattedWriteA (dtv, unit, iotype, v_list, iostat, iomsg)
          import
            class (A), 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

        subroutine formattedWriteB (dtv, unit, iotype, v_list, iostat, iomsg)
           import
            class (B), 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

    type (base) b1

    print *,  base(A(100), B('xlftest'))

    write (1, *) base (b1=B('xlftest 101'), a1 = A(200))

    close (1)

    read (1, *) b1

    print *, b1

    close(1, status='delete')
end


subroutine formattedReadA (dtv, unit, iotype, v_list, iostat, iomsg)
use m
    class (A), intent(inout) :: dtv
    integer, intent(in) :: unit
    character(*), intent(in) :: iotype
    integer, intent(in) :: v_list(:)
    integer, intent(out) :: iostat
    character(*), intent(inout) :: iomsg

    read (unit, *, iostat=iostat, iomsg=iomsg) dtv%id
end subroutine


subroutine formattedReadB (dtv, unit, iotype, v_list, iostat, iomsg)
use m
    class (B), intent(inout) :: dtv
    integer, intent(in) :: unit
    character(*), intent(in) :: iotype
    integer, intent(in) :: v_list(:)
    integer, intent(out) :: iostat
    character(*), intent(inout) :: iomsg

    read (unit, '(a20)', iostat=iostat, iomsg=iomsg) dtv%name
end subroutine

subroutine formattedWriteA (dtv, unit, iotype, v_list, iostat, iomsg)
use m
    class (A), 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, '(i5)', iostat=iostat, iomsg=iomsg) dtv%id
end subroutine


subroutine formattedWriteB (dtv, unit, iotype, v_list, iostat, iomsg)
use m
    class (B), 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, '(a20)', iostat=iostat, iomsg=iomsg)  dtv%name
end subroutine

Flang failed as:

> a.out
  100xlftest

fatal Fortran runtime error(t.f:71): Bad character 'x' in INTEGER input field
IOT/Abort trap(coredump)

If I change all the external DTIO procedures to be module procedures, Flang works as expected.

[llvmbot]

@llvm/issue-subscribers-flang-runtime

Author: Daniel Chen (DanielCChen)

Consider the following code: ``` module m type A integer id end type

type B
    character(20) :: name
end type

type base
    type (A) a1
    type (B) b1
end type

end module

program fdtio511
use m
interface read(formatted)
subroutine formattedReadA (dtv, unit, iotype, v_list, iostat, iomsg)
import
class (A), intent(inout) :: dtv
integer, intent(in) :: unit
character(), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(), intent(inout) :: iomsg
end subroutine

    subroutine formattedReadB (dtv, unit, iotype, v_list, iostat, iomsg)
      import
        class (B), intent(inout) :: 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

interface write(formatted)
    subroutine formattedWriteA (dtv, unit, iotype, v_list, iostat, iomsg)
      import
        class (A), 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

    subroutine formattedWriteB (dtv, unit, iotype, v_list, iostat, iomsg)
       import
        class (B), 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

type (base) b1

print *,  base(A(100), B('xlftest'))

write (1, *) base (b1=B('xlftest 101'), a1 = A(200))

close (1)

read (1, *) b1

print *, b1

close(1, status='delete')

end

subroutine formattedReadA (dtv, unit, iotype, v_list, iostat, iomsg)
use m
class (A), intent(inout) :: dtv
integer, intent(in) :: unit
character(), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(), intent(inout) :: iomsg

read (unit, *, iostat=iostat, iomsg=iomsg) dtv%id

end subroutine

subroutine formattedReadB (dtv, unit, iotype, v_list, iostat, iomsg)
use m
class (B), intent(inout) :: dtv
integer, intent(in) :: unit
character(), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(), intent(inout) :: iomsg

read (unit, '(a20)', iostat=iostat, iomsg=iomsg) dtv%name

end subroutine

subroutine formattedWriteA (dtv, unit, iotype, v_list, iostat, iomsg)
use m
class (A), 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, '(i5)', iostat=iostat, iomsg=iomsg) dtv%id

end subroutine

subroutine formattedWriteB (dtv, unit, iotype, v_list, iostat, iomsg)
use m
class (B), 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, '(a20)', iostat=iostat, iomsg=iomsg)  dtv%name

end subroutine

Flang failed as:

> a.out
100xlftest

fatal Fortran runtime error(t.f:71): Bad character 'x' in INTEGER input field
IOT/Abort trap(coredump)

If I change all the external DTIO procedures to be module procedures, Flang works as expected.

</details>

[DanielCChen]

This version works:

module m
    type A
        integer id
    end type

    type B
        character(20) :: name
    end type

    type base
        type (A) a1
        type (B) b1
    end type
contains
subroutine formattedReadA (dtv, unit, iotype, v_list, iostat, iomsg)
    class (A), intent(inout) :: dtv
    integer, intent(in) :: unit
    character(*), intent(in) :: iotype
    integer, intent(in) :: v_list(:)
    integer, intent(out) :: iostat
    character(*), intent(inout) :: iomsg

    read (unit, *, iostat=iostat, iomsg=iomsg) dtv%id
end subroutine


subroutine formattedReadB (dtv, unit, iotype, v_list, iostat, iomsg)
    class (B), intent(inout) :: dtv
    integer, intent(in) :: unit
    character(*), intent(in) :: iotype
    integer, intent(in) :: v_list(:)
    integer, intent(out) :: iostat
    character(*), intent(inout) :: iomsg

    read (unit, '(a20)', iostat=iostat, iomsg=iomsg) dtv%name
end subroutine

subroutine formattedWriteA (dtv, unit, iotype, v_list, iostat, iomsg)
    class (A), 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, '(i5)', iostat=iostat, iomsg=iomsg) dtv%id
end subroutine


subroutine formattedWriteB (dtv, unit, iotype, v_list, iostat, iomsg)
    class (B), 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, '(a20)', iostat=iostat, iomsg=iomsg)  dtv%name
end subroutine
end module

program fdtio511
use m
    type (base) b1

    print *,  base(A(100), B('xlftest'))
    write (1, *) base (b1=B('xlftest 101'), a1 = A(200))
    close (1)
    read (1, *) b1
    print *, b1
    close(1, status='delete')
end

[klausler]

The first version is behaving as expected. The main program's write statement emits the components of the base structure constructor in component order, and the defined output procedure for the type of the a1 component emits the decimal integer 200, immediately followed the output of the defined output procedure for the type of the b1 component, which emits a character value beginning with x. On input, the defined input procedure for the type of the component a1 encounters a list-directed integer input item that is not followed by a separator or end of record.

This first version of the program "works" because XLF incorrectly advances to a new record after performing the write statement in the defined output procedure for the type of the component a1. This is wrong, but it does separate that integer value from the characters that follow, and that keeps XLF from noticing the lack of a separator when doing the list-directed input later.

The second version "works" with flang-new because none of the defined I/O subroutines is part of a generic interface, so none of them are called. Instead, default formatted I/O operations take place, and there's a record advancement after the integer value is written.