Hi Harald,
Thanks for giving the patch a whirl.
> the parent components as an array. I strongly suspect that, from reading
> > 7.5.6.2 paragraphs 2 and 3 closely, that ifort has it right. However,
> this
> > is another issue to come back to in the future.
>
> Could you specify which version of Intel you tried?
>
ifort (IFORT) 2021.1 Beta 20201112
>
> Testcase finalize_38.f90 fails for me with ifort 2021.5.0 with:
>
> 131
>
That's the point where the interpretation of the standard diverges. Ifort
uses the scalar finalization for the parent component, whereas gfortran
uses the rank 1. Thus the final count is different by one. I have a version
of the patch, where gfortran behaves in the same way as ifort.
> This test also fails with crayftn 11 & 12 and nagfor 7.0,
> but in a different place.
>
>
> (Also finalize_45.f90 fails with that version with something that
> looks like memory corruption, but that might be just a compiler bug.)
>
I take it 'that version' is of ifort? Mine does the same. I suspect that it
is one of the perils of using pointer components in such circumstances! You
will notice that I had to nullify pointer components when doing the copy.
>
> Thanks,
> Harald
>
Could you use the attached version of finalize_38.f90 with crayftn and NAG?
All the stop statements are replaced with prints. Ifort gives:
131 3 2
132 0 4
133 5 6 | 0 0
141 4 3
151 7 5
152 3 0
153 0 0 | 1 3
161 13 9
162 20 0
163 0 0 | 10 20
171 14 11
Best regards
Paul
! { dg-do run }
!
! Test finalization on intrinsic assignment (F2018 (7.5.6.3))
!
module testmode
implicit none
type :: simple
integer :: ind
contains
final :: destructor1, destructor2
end type simple
type, extends(simple) :: complicated
real :: rind
contains
final :: destructor3, destructor4
end type complicated
integer :: check_scalar
integer :: check_array(4)
real :: check_real
real :: check_rarray(4)
integer :: final_count = 0
contains
subroutine destructor1(self)
type(simple), intent(inout) :: self
check_scalar = self%ind
check_array = 0
final_count = final_count + 1
end subroutine destructor1
subroutine destructor2(self)
type(simple), intent(inout) :: self(:)
check_scalar = 0
check_array(1:size(self, 1)) = self%ind
final_count = final_count + 1
end subroutine destructor2
subroutine destructor3(self)
type(complicated), intent(inout) :: self
check_real = self%rind
check_array = 0.0
final_count = final_count + 1
end subroutine destructor3
subroutine destructor4(self)
type(complicated), intent(inout) :: self(:)
check_real = 0.0
check_rarray(1:size(self, 1)) = self%rind
final_count = final_count + 1
end subroutine destructor4
function constructor1(ind) result(res)
type(simple), allocatable :: res
integer, intent(in) :: ind
allocate (res, source = simple (ind))
end function constructor1
function constructor2(ind, rind) result(res)
class(simple), allocatable :: res(:)
integer, intent(in) :: ind(:)
real, intent(in), optional :: rind(:)
type(complicated), allocatable :: src(:)
integer :: sz
integer :: i
if (present (rind)) then
sz = min (size (ind, 1), size (rind, 1))
src = [(complicated (ind(i), rind(i)), i = 1, sz)]
allocate (res, source = src)
else
sz = size (ind, 1)
allocate (res, source = [(simple (ind(i)), i = 1, sz)])
end if
end function constructor2
subroutine test (cnt, scalar, array, off, rind, rarray)
integer :: cnt
integer :: scalar
integer :: array(:)
integer :: off
real, optional :: rind
real, optional :: rarray(:)
if (final_count .ne. cnt) print *, 1 + off, final_count, cnt
if (check_scalar .ne. scalar) print *, 2 + off, check_scalar, scalar
if (any (check_array(1:size (array, 1)) .ne. array)) print *, 3 + off, &
check_array(1:size (array, 1)), "|", array
if (present (rind)) then
if (check_real .ne. rind) print *, 4+off, check_real, rind
end if
if (present (rarray)) then
if (any (check_rarray(1:size (rarray, 1)) .ne. rarray)) print *, 5 + off, &
check_rarray(1:size (rarray, 1)), "|", rarray
end if
end subroutine test
end module testmode
program test_final
use testmode
implicit none
type(simple), allocatable :: MyType, MyType2
type(simple), allocatable :: MyTypeArray(:)
type(simple) :: ThyType = simple(21), ThyType2 = simple(22)
class(simple), allocatable :: MyClass
class(simple), allocatable :: MyClassArray(:)
! ************************
! Derived type assignments
! ************************
! The original PR - one finalization of 'var' before (re)allocation.
MyType = ThyType
call test(1, 0, [0,0], 0)
if (.not. allocated(MyType)) allocate(MyType)
allocate(MyType2)
MyType%ind = 1
MyType2%ind = 2
! This should result in a final call with self = simple(1).
MyType = MyType2
call test(2, 1, [0,0], 10)
allocate(MyTypeArray(2))
MyTypeArray%ind = [42, 43]
! This should result in a final call with self = [simple(42),simple(43)].
MyTypeArray = [ThyType, ThyType2]
call test(3, 0, [42,43], 20)
! This should result in a final call with self = initialization = simple(22).
ThyType2 = simple(99)
call test(4, 22, [0,0], 30)
! This should result in a final call with self = simple(22).
ThyType = ThyType2
call test(5, 21, [0,0], 40)
! This should result in two final calls; the last is for self2 = simple(2).
deallocate (MyType, MyType2)
call test(7, 2, [0,0], 50)
! This should result in one final call; MyTypeArray = [simple(21),simple(22)].
deallocate (MyTypeArray)
call test(8, 0, [21,22], 60)
! Check that rhs function expressions do not interfere with finalization.
! The lhs is finalized before assignment.
! The function result is finalized after the assignment.
allocate (MyType, source = simple (11))
MyType = constructor1 (99)
call test(10, 99, [0,0], 70)
deallocate (MyType)
! *****************
! Class assignments
! *****************
final_count = 0
allocate (MyClass, source = simple (3))
! This should result in a final call with the allocated value.
MyClass = simple (4)
call test(1, 3, [0,0], 100)
! This should result in a final call with the assigned value.
deallocate (MyClass)
call test(2, 4, [0,0], 110)
allocate (MyClassArray, source = [simple (5), simple (6)])
! Make sure that there is no final call.
call test(2, 4, [0,0], 120)
MyClassArray = [simple (7), simple (8)]
! The final call should return the value before the assignment.
call test(2, 4, [0,0], 130)
! This should result in a final call with the assigned value.
deallocate (MyClassArray)
call test(3, 0, [7,8], 140)
! This should produce no final calls.
allocate (MyClassArray, source = [complicated(1, 2.0),complicated(3, 4.0)])
! This should produce calls to destructor4 then destructor2.
deallocate (MyClassArray)
! F2018 7.5.6.3: "If the entity is of extended type and the parent type is
! finalizable, the parent component is finalized.
call test(5, 0, [1, 3], 150, rarray = [2.0, 4.0])
! Since 'constructor2; must finalize 'src' after the finalization of
! 'MyClassArray', the result in 'check_array' should be [10,20].
MyClassArray = constructor2 ([10,20], [10.0,20.0])
call test(9, 0, [10,20], 160, rarray = [10.0,20.0])
deallocate (MyClassArray)
call test(11, 0, [10, 20], 170, rarray = [10.0,20.0])
end program test_final
