[Bug fortran/64290] [F03] No finalization at deallocation of LHS

["pault at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=64290

Paul Thomas <pault at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |pault at gcc dot gnu.org
           Assignee|unassigned at gcc dot gnu.org      |pault at gcc dot gnu.org

--- Comment #2 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 49936
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=49936&action=edit
Initial fix for the PR

Triggered by a recent thread on clf, I have made a first stab at this PR. This
patch is thus far perfect and has the following regressions:

FAIL: gfortran.dg/class_optional_1.f90   -O0  execution test
FAIL: gfortran.dg/dynamic_dispatch_6.f03   -O1  execution test
FAIL: gfortran.dg/finalize_15.f90   -O0  (internal compiler error)
FAIL: gfortran.dg/finalize_25.f90   -O0  execution test
FAIL: gfortran.dg/finalize_29.f08   -O0  execution test
plus
FAIL: gfortran.dg/prof/dynamic_dispatch_6.f03 execution,    -fprofile-generate
-D_PROFILE_GENERATE

which is not too bad for a first attempt. Note that for arrays, finalization is
occurring before reallocation of the lhs contrary to the requirements of the
standard.

This test, based on the reporter's testcase, works as intended:
module testmode
  implicit none

  type :: simple
    integer :: ind
  contains
    final :: destruct1, destruct2
  end type simple

  integer :: check_scalar
  integer :: check_array(2)
  integer :: final_count = 0

contains

  subroutine destruct1(self)
    type(simple), intent(inout) :: self

!    print *, "DESTRUCTING SCALAR", self%ind
    check_scalar = self%ind
    check_array = 0
    final_count = final_count + 1

  end subroutine destruct1

  subroutine destruct2(self)
    type(simple), intent(inout) :: self(:)

!    print *, "DESTRUCTING ARRAY", self%ind
    check_scalar = 0
    check_array = self%ind
    final_count = final_count + 1

  end subroutine destruct2

  subroutine test (cnt, scalar, array, off)
    integer :: cnt
    integer :: scalar
    integer :: array(:)
    integer :: off
    if (final_count .ne. cnt) stop 1 + off
    if (check_scalar .ne. scalar) stop 2 + off
    if (any (check_array .ne. array)) stop 3 + off
  end subroutine test

end module testmode

program test_final
  use testmode
  implicit none

  type(simple), allocatable :: myres, myres2
  type(simple), allocatable :: myarray(:)
  type(simple) :: thyres = simple(21), thyres2 = simple(22)

  allocate(myres)
  allocate(myres2)
  myres%ind = 1
  myres2%ind = 2
  myres = myres2
  call test(1, 1, [0,0], 10)

  allocate(myarray(2))
  myarray%ind = [42, 43]
  myarray = [thyres, thyres2]
  call test(2, 0, [42,43], 20)

  thyres2 = simple(99)
  call test(3, 22, [0,0], 30)

  thyres = thyres2
  call test(4, 21, [0,0], 40)

  deallocate (myres, myres2)
  call test(6, 2, [0,0], 100)

  deallocate (myarray)
  call test(7, 0, [21,22], 200)

end program test_final

Paul