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
