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