[flang][runtime] DTIO read output incorrect value.

[DanielCChen]

Consider the following code:

module m
   type :: mydata
      integer(4) ::  i
   end type

   type :: base
      class(mydata), pointer :: b(:)
      character(3) :: c
   end type

   interface write(unformatted)
      subroutine writeunformatted(dtv, unit,iostat, iomsg )
         import base
         class(base), intent(in) :: dtv
         integer,  intent(in) :: unit
         integer,  intent(out) :: iostat
         character(*),  intent(inout) :: iomsg
      end subroutine

      subroutine writeunformatteddata(dtv, unit, iostat, iomsg )
         import mydata
         class(mydata), intent(in) :: dtv
         integer,  intent(in) :: unit
         integer,  intent(out) :: iostat
         character(*),  intent(inout) :: iomsg
      end subroutine
   end interface

end module

program array002a
   use m

   integer :: stat

   integer :: i1(2), i2(2), i3(3), i4(3), i5(3), i6(3), i7(4), i8(4)
   character(3) :: c1, c2, c3, c4

   character(200) :: msg = ''
   class(base), allocatable :: b1(:)
   type(base), pointer      :: b2(:)

   type(mydata), allocatable :: d1
   type(mydata) :: d2
   type(mydata), allocatable :: d3(:)

   open (1, file = 'array002a.1', form='unformatted', access='sequential' )

   allocate (d1, source = mydata(111) )
   d2 = mydata(222)
   allocate (d3(2), source = (/d1, d2/) )

   allocate(b1(2), source = (/ base(b=null() , c='abc') , base(b=null() , c='def') /))
   allocate(b2(3), source = (/ b1 , base(b=null() , c='ghi') /) )

   allocate( b1(1)%b(1), source = (/ d1 /) )
   allocate( b1(2)%b(1), source = (/ d1 /) )

   allocate( b2(1)%b(2), source = (/ d1, d2 /) )
   allocate( b2(2)%b(2), source = (/ d1, d2 /) )
   allocate( b2(3)%b(2), source = (/ d1, d2 /) )

   write (1, iostat=stat, iomsg=msg)       b1(2:1:-1)
   write (1, iostat=stat, iomsg=msg)       b2((/3,1,2/))

   rewind 1

      read (1, iostat=stat, iomsg = msg)      c1, i1(1), c2, i2(1)
   if ( ( c1 /= 'def' ) .or. ( i1(1) /= 111 ) .or. &
        ( c2 /= 'abc' ) .or. ( i2(1) /= 111 ) )     ERROR STOP 5

   read (1, iostat=stat, iomsg = msg)      c1, i1, c2, i2, c3, i3
print*, i3
   if ( i3(1) /= 111 .or.  i3(2) /= 222) ERROR STOP 6

   close (1, status = 'delete' )

end program


subroutine writeunformatted ( dtv, unit, iostat, iomsg )
   use m, only: base, mydata

   interface write(unformatted)
      subroutine writeunformatteddata(dtv, unit, iostat, iomsg )
         import mydata
        class(mydata), intent(in) :: dtv
         integer,  intent(in) :: unit
         integer,  intent(out) :: iostat
         character(*),  intent(inout) :: iomsg
      end subroutine
   end interface

   class(base), intent(in) :: dtv
   integer, intent(in) :: unit
   integer, intent(out) :: iostat
   character(*), intent(inout) :: iomsg

   write (unit, iostat=iostat )                  dtv%c

   write (unit, iostat=iostat, iomsg = iomsg )   dtv%b

   if ( iostat /= 0 ) ERROR STOP 9

   iomsg = 'dtiowrite'

end subroutine

subroutine writeunformatteddata (dtv, unit, iostat, iomsg)
   use m, only: mydata

   class(mydata), intent(in) :: dtv
   integer, intent(in) :: unit
   integer, intent(out) :: iostat
   character(*), intent(inout) :: iomsg

   write (unit, iostat=iostat )                   dtv%i

   iomsg = 'dtiowrite1'

end subroutine

Flang outputs

> a.out
 0 0 0
Fortran ERROR STOP: code 6

Both gfortran and XLF outputs

> a.out
         111         222           0

[llvmbot]

@llvm/issue-subscribers-flang-runtime

Author: Daniel Chen (DanielCChen)

Consider the following code: ``` module m type :: mydata integer(4) :: i end type

type :: base
class(mydata), pointer :: b(:)
character(3) :: c
end type

interface write(unformatted)
subroutine writeunformatted(dtv, unit,iostat, iomsg )
import base
class(base), intent(in) :: dtv
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
end subroutine

  subroutine writeunformatteddata(dtv, unit, iostat, iomsg )
     import mydata
     class(mydata), intent(in) :: dtv
     integer,  intent(in) :: unit
     integer,  intent(out) :: iostat
     character(*),  intent(inout) :: iomsg
  end subroutine

end interface

end module

program array002a
use m

integer :: stat

integer :: i1(2), i2(2), i3(3), i4(3), i5(3), i6(3), i7(4), i8(4)
character(3) :: c1, c2, c3, c4

character(200) :: msg = ''
class(base), allocatable :: b1(:)
type(base), pointer :: b2(:)

type(mydata), allocatable :: d1
type(mydata) :: d2
type(mydata), allocatable :: d3(:)

open (1, file = 'array002a.1', form='unformatted', access='sequential' )

allocate (d1, source = mydata(111) )
d2 = mydata(222)
allocate (d3(2), source = (/d1, d2/) )

allocate(b1(2), source = (/ base(b=null() , c='abc') , base(b=null() , c='def') /))
allocate(b2(3), source = (/ b1 , base(b=null() , c='ghi') /) )

allocate( b1(1)%b(1), source = (/ d1 /) )
allocate( b1(2)%b(1), source = (/ d1 /) )

allocate( b2(1)%b(2), source = (/ d1, d2 /) )
allocate( b2(2)%b(2), source = (/ d1, d2 /) )
allocate( b2(3)%b(2), source = (/ d1, d2 /) )

write (1, iostat=stat, iomsg=msg) b1(2:1:-1)
write (1, iostat=stat, iomsg=msg) b2((/3,1,2/))

rewind 1

  read (1, iostat=stat, iomsg = msg)      c1, i1(1), c2, i2(1)

if ( ( c1 /= 'def' ) .or. ( i1(1) /= 111 ) .or. &
( c2 /= 'abc' ) .or. ( i2(1) /= 111 ) ) ERROR STOP 5

read (1, iostat=stat, iomsg = msg) c1, i1, c2, i2, c3, i3
print*, i3
if ( i3(1) /= 111 .or. i3(2) /= 222) ERROR STOP 6

close (1, status = 'delete' )

end program

subroutine writeunformatted ( dtv, unit, iostat, iomsg )
use m, only: base, mydata

interface write(unformatted)
subroutine writeunformatteddata(dtv, unit, iostat, iomsg )
import mydata
class(mydata), intent(in) :: dtv
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
end subroutine
end interface

class(base), intent(in) :: dtv
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg

write (unit, iostat=iostat ) dtv%c

write (unit, iostat=iostat, iomsg = iomsg ) dtv%b

if ( iostat /= 0 ) ERROR STOP 9

iomsg = 'dtiowrite'

end subroutine

subroutine writeunformatteddata (dtv, unit, iostat, iomsg)
use m, only: mydata

class(mydata), intent(in) :: dtv
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg

write (unit, iostat=iostat ) dtv%i

iomsg = 'dtiowrite1'

end subroutine

Flang outputs

> a.out
0 0 0
Fortran ERROR STOP: code 6

Both gfortran and XLF outputs 

> a.out
111 222 0

</details>

[klausler]

The read (read (1, iostat=stat, iomsg = msg) c1, i1, c2, i2, c3, i3) into i3 fails because it require 3 integers and there are only two remaining. The failure is properly reported via iostat=.

See 12.6.4.5.2 p5: "On input from a file connected for sequential or direct access, the number of file storage units required by the input list shall be less than or equal to the number of file storage units in the record."

[DanielCChen]

Right. It is intended to test if the runtime would read the first two and leave the last one undefined, which both gfortran and XLF do.
It seems Flang doesn't do "partical" reading?

[klausler]

Right. It is intended to test if the runtime would read the first two and leave the last one undefined, which both gfortran and XLF do. It seems Flang doesn't do "partical" reading?

I don't do partial reads into arrays. If the program needs that, the portable and informative method is to use an implied DO loop.