[Bug 106731] ICE on automatic array of derived type with DTIO: need help

[Bug 106731] ICE on automatic array of derived type with DTIO: need help

[Federico Perini]

[-- Attachment #1.1: Type: text/plain, Size: 2513 bytes --]

Hello,

I’m stil trying to fix this
<https://gcc.gnu.org/bugzilla/show_bug.cgi?id=106731> ICE bug for an
automatic array of a derived type with DTIO:

   63 |         type(t) :: automatic(n)

      |                               1

internal compiler error: in gfc_trans_auto_array_allocation, at
fortran/trans-array.cc:6617


Still digging for the first time in the gfortran code, I need help to move
further.

So far I’ve found:



   1. ICE is triggered in trans-array line 6617 by  gcc_assert
   (!TREE_STATIC (decl)); Makes sense, an automatic array is not SAVEd.
   2. Elsewhere, in trans-decl.cc, I found this chunk and commented it out.
   This fixed the ICE issue, but crashes some test cases i.e. dtio_4.f90 and
   dtio_14.f90, when built with full optimization (-O3)


  /* If derived-type variables with DTIO procedures are not made static
     some bits of code referencing them get optimized away.
     TODO Understand why this is so and fix it.  */
//  if (!sym->attr.use_assoc
//      && ((sym->ts.type == BT_DERIVED
//           && sym->ts.u.derived->attr.has_dtio_procs)
//        || (sym->ts.type == BT_CLASS
//            && CLASS_DATA (sym)->ts.u.derived->attr.has_dtio_procs)))
//    TREE_STATIC (decl) = 1;3.

3. Of the optimization flags "-fpeel-loops" is the one that triggers the
failing tests

3. in dtio_4.f90, the first test fails for 1) non-extended class; 2)
derived-type READ. Write works; extended type (BT_CLASS) works. It appears
that the optimizer thinks the derived type is not modified by the read
statement.

4. If i replace the READ statement with a direct call to the udt routine
(`call user_defined_read`) the test succeeds, so I've looked how the tree
dumps compare:

federico@Federicos-MacBook-Pro dtio % diff callsub withdtio

498c498,500

<   CALL user_defined_read ((test1:udt1) (10) ('dt') ((/ 1 /)) (iostat =
test1:ios) (iomsg = test1:iomsg))

---

>   READ UNIT=10 FMT='(dt)' IOMSG=test1:iomsg IOSTAT=test1:ios ADVANCE='no'

>   TRANSFER test1:udt1

>   DT_END

federico@Federicos-MacBook-Pro dtio %

while -fdump-tree-original returns exactly identical dumps:

federico@Federicos-MacBook-Pro dtio % diff callsub withdtio

federico@Federicos-MacBook-Pro dtio %

Now I'm a bit stuck because I have no experience in gfortran coding, more
so with the gcc optimizer.
I hope some of you can help! But at least, I'm starting to understand how
the code structure works.

Best,
Federico

[-- Attachment #2: dtio_4.f90 --]
[-- Type: application/octet-stream, Size: 4003 bytes --]

! { dg-do run }
!
! Functional test of User Defined Derived Type IO.
!
! This tests a combination of module procedure and generic procedure
! and performs reading and writing an array with a pseudo user defined
! tag at the beginning of the file.
!
module usertypes
  type udt
     integer :: myarray(15)
   contains
 !    procedure :: user_defined_read
 !    generic :: read (formatted) => user_defined_read
  end type udt
  type, extends(udt) :: more
    integer :: someinteger = -25
  end type

  interface read(formatted)
    module procedure user_defined_read
  end interface

  interface write(formatted)
    module procedure user_defined_write
  end interface

  integer :: result_array(15)
contains
  subroutine user_defined_read (dtv, unit, iotype, v_list, iostat, iomsg)
    class(udt), intent(inout)   :: dtv
    integer, intent(in)         :: unit
    character(*), intent(in)    :: iotype
    integer, intent(in)         :: v_list (:)
    integer, intent(out)        :: iostat
    character(*), intent(inout) :: iomsg
    character(10)               :: typestring

    if (iotype=='LISTDIRECTED') then 
          read (unit, fmt=*,  iostat=iostat, iomsg=iomsg) dtv%myarray
    else

    iomsg = 'SUCCESS'
    read (unit, '(a6)',  iostat=iostat, iomsg=iomsg) typestring
    typestring = trim(typestring)
    select type (this=>dtv)
      type is (udt)
        if (typestring.eq.' UDT:     ') then
          read (unit, fmt=*,  iostat=iostat, iomsg=iomsg) this%myarray
        else
          iostat = 6000
          iomsg = 'FAILURE'
        end if
      type is (more)
        if (typestring.eq.' MORE:    ') then
          read (unit, fmt=*,  iostat=iostat, iomsg=iomsg) this%myarray,this%someinteger
        else
          iostat = 6000
          iomsg = 'FAILUREwhat'
        end if
    end select
    endif
  end subroutine user_defined_read

  subroutine user_defined_write (dtv, unit, iotype, v_list, iostat, iomsg)
    class(udt), intent(in)      :: dtv
    integer, intent(in)         :: unit
    character(*), intent(in)    :: iotype
    integer, intent(in)         :: v_list (:)
    integer, intent(out)        :: iostat
    character(*), intent(inout) :: iomsg
    character(10)               :: typestring
    select type (dtv)
      type is (udt)
        write (unit, fmt=*, iostat=iostat, iomsg=iomsg)  "UDT:  "
        write (unit, fmt=*, iostat=iostat, iomsg=iomsg)  dtv%myarray
      type is (more)
        write (unit, fmt=*, iostat=iostat, iomsg=iomsg)  "MORE: "
        write (unit, fmt=*, iostat=iostat, iomsg=iomsg)  dtv%myarray,dtv%someinteger
    end select
    write (unit,*)
  end subroutine user_defined_write
end  module usertypes

program test1
  use usertypes
  type (udt) :: udt1
  type (more), save :: more1
  class (more), allocatable :: somemore
  integer  :: thesize, i, ios
  character(25):: iomsg

! Create a file that contains some data for testing.
  open (10, form='formatted', status='scratch', action='readwrite')
  write(10, '(a)') ' UDT: '
  do i = 1, 15
    write(10,'(i5)', advance='no') i
  end do
  write(10,*)
  rewind(10)
  udt1%myarray = 99
  result_array = (/ (i, i = 1, 15) /)
  more1%myarray = result_array
!  read (10, fmt='(dt)', advance='no', iomsg=iomsg, iostat=ios) udt1
  call user_defined_read(udt1,10,'dt',[1],iomsg=iomsg,iostat=ios)
  if (iomsg.ne.'SUCCESS') then 
          print *, 'iomsg=',trim(iomsg)
          print *, 'ios=',ios
          STOP 1
  elseif (any(.not.udt1%myarray==result_array)) then 
       print *, udt1%myarray.ne.result_array
       print *, 'myarray=',udt1%myarray
       print *, 'result =',result_array
       print *, 'sizes=',size(udt1%myarray),size(result_array),' iostat=',ios   
       STOP 2
  endif
  close(10)
  open (10, form='formatted', status='scratch')
  write (10, '(dt)') more1
  rewind(10)
  more1%myarray = 99
  read (10, '(dt)', iostat=ios, iomsg=iomsg) more1
  if (iomsg.ne.'SUCCESS') STOP 3
  if (any(more1%myarray.ne.result_array)) STOP 4
  close (10)
  stop 0
end program test1

Re: [Bug 106731] ICE on automatic array of derived type with DTIO: need help

[Steve Kargl]

On Thu, Dec 15, 2022 at 01:51:26PM +0100, Federico Perini via Fortran wrote:
> 
> 3. Of the optimization flags "-fpeel-loops" is the one that triggers the
> failing tests
> 
> 3. in dtio_4.f90, the first test fails for 1) non-extended class; 2)
> derived-type READ. Write works; extended type (BT_CLASS) works. It appears
> that the optimizer thinks the derived type is not modified by the read
> statement.

Federico, thanks for following up here.  As I indicated before,
you're in an area of the compiler that I do not normally hack. But,
the above description sounds like a tree is not marked as used.
There is code of the form "TREE_USED (decl) = 1;" in the trans-*.cc
files.  Setting this might inhibit the -fpeel-loops optimization,
but this is just a guess.

-- 
Steve