Re: [Patch, fortran] PR37336 (Finalization) - [F03] Finish derived-type finalization

[Paul Richard Thomas <paul.richard.thomas@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 6489 bytes --]

Hi Harald and Jerry,

I have gone back to the start and have gone through finalizable derived
type assignments with the F2018 in hand. I have had a dreadful time with
direct by reference function calls and still am struggling with assignment
number 6 in the attached. I would be very grateful if you would run this
testcase for the other brands.

As soon as I fix the 6th assignment, I will get on to class assignments.

Best regards

Paul


On Fri, 11 Feb 2022 at 21:59, Paul Richard Thomas <
paul.richard.thomas@gmail.com> wrote:

> Hi Harald and Jerry,
>
> I am reworking my way through, line by line wit F2018 in hand. Up to test
> with offset 70, NAG looks to be right. I introduced an assignment with a
> direct by ref function call, which doesn't finalise at the moment. Class
> entities are yet to come. I'll report back early next week.
>
> Thanks for all the help. I have (re)learned to read the standard very
> carefully.
>
> Best regards
>
> Paul
>
>
> On Fri, 11 Feb 2022, 21:08 Harald Anlauf, <anlauf@gmx.de> wrote:
>
>> Hi Paul,
>>
>> Am 11.02.22 um 10:08 schrieb Paul Richard Thomas via Fortran:
>> > Your "stupid questions" are not at all stupid. The finalization of
>> > 'variable' that occurs in your testcase demonstrates that the
>> finalization
>> > with my patch is occurring at the wrong time. I now see that NAG is
>> correct
>> > on this.
>> >
>> > Please press on with the questions!
>>
>> Jerry's suggestion to add lots of prints turned out to be really
>> enlightening with regard to observable behavior.  I rewrote the
>> testcase again and placed the interesting stuff into a subroutine.
>> This way one can distinguish what actually happens during program
>> start, entering and leaving a subroutine.
>>
>> I encountered the least surprises (= none) with NAG 7.0 here.
>> For reference this is the output:
>>
>>   At start of program : 0
>>
>>   Enter sub           : 0
>>   After 1st allocation: 0
>>   After 2nd allocation: 0
>>   Checking MyType% ind: 21
>>   Checking MyType2%ind: 22
>>   Deallocate MyType   : 0
>>   # Leave desctructor1: 1 21
>>   * MyType deallocated: 1
>>   (kept MyType2 for automatic deallocation on return from sub)
>>   Leave sub           : 1
>>   # Leave desctructor1: 2 22
>>
>>   After sub           : 2
>>
>> To make it short: the destructor is called only when deallocation
>> occurs, either explicitly or automatically.
>>
>>
>> Intel 2021.5.0:
>>
>>   At start of program :           0
>>
>>   Enter sub           :           0
>>   # Leave desctructor1:           1           0
>>   After 1st allocation:           1
>>   # Leave desctructor1:           2           0
>>   After 2nd allocation:           2
>>   Checking MyType% ind:          21
>>   Checking MyType2%ind:          22
>>   Deallocate MyType   :           2
>>   # Leave desctructor1:           3          21
>>   * MyType deallocated:           3
>>   (kept MyType2 for automatic deallocation on return from sub)
>>   Leave sub           :           3
>>   # Leave desctructor1:           4          21
>>   # Leave desctructor1:           5          22
>>   # Leave desctructor1:           6          22
>>
>>   After sub           :           6
>>
>> So after entering the subroutine, the destructor is called twice,
>> but for unknown reasons element ind, which I had expected to be
>> either default-initialized to -1, or explicitly to 21 or 22, is 0.
>> The places where this happens seem to be the assignments of
>> MyType and MyType2.
>>
>> Furthermore, variable MyType is finalized on return from sub,
>> although it is already deallocated, and MyType2 appears to
>> get finalized twice automatically.
>>
>> I have no idea how this can get justified...
>>
>>
>> Crayftn 12.0.2: in order to make the output easier to understand,
>> I chose to reset final_count twice.  This will become clear soon.
>>
>>   # Leave desctructor1: 1,  20
>>
>>   At start of program : 1
>>   +++ Resetting final_count for Cray Fortran : Version 12.0.2
>>
>>   # Leave desctructor1: 1,  21
>>   # Leave desctructor1: 2,  22
>>   Enter sub           : 2
>>   +++ Resetting final_count for Cray Fortran : Version 12.0.2
>>   After 1st allocation: 0
>>   After 2nd allocation: 0
>>   Checking MyType% ind: -21
>>   Checking MyType2%ind: 22
>>   Deallocate MyType   : 0
>>   # Leave desctructor1: 1,  -21
>>   * MyType deallocated: 1
>>   (kept MyType2 for automatic deallocation on return from sub)
>>   Leave sub           : 1
>>   # Leave desctructor1: 2,  22
>>
>>   After sub           : 2
>>
>> So it appears that Cray is calling the destructor for each declaration
>> where a constructor is involved, or the like.  Even if this is a
>> parameter declaration, like in the main.  Resetting the counter for
>> the first time.
>>
>> On entering sub, I see now two finalizations before the first print.
>> Resetting the counter for the second time.
>>
>> But then the assignments do not invoke finalization, where Intel did.
>> So this part appears more like NAG, but...
>>
>> ... something is strange here: component ind is wrong after the
>> first assignment.  Looks clearly like a really bad bug.
>>
>> Explicit and automatic deallocation seems fine.
>>
>>
>> Nvidia 22.2:
>>
>>   At start of program :            0
>>
>>   Enter sub           :            0
>>   After 1st allocation:            0
>>   After 2nd allocation:            0
>>   Checking MyType% ind:           21
>>   Checking MyType2%ind:           22
>>   Deallocate MyType   :            0
>>   # Leave desctructor1:            1           21
>>   * MyType deallocated:            1
>>   (kept MyType2 for automatic deallocation on return from sub)
>>   Leave sub           :            1
>>   # Leave desctructor1:            2   1590094384
>>   # Leave desctructor1:            3           22
>>
>>   After sub           :            3
>>
>> OK, that is really odd.  Although valgrind does not report
>> invalid accesses, there is something really fishy here.
>> I have not investigated further.  Nvidia is out for now.
>>
>>
>> One of the lessons learned is that it might be hard to write a
>> portable testcase that works for all compilers that rightfully(?)
>> can claim to implement finalization correctly...  And I have only
>> scratched the surface so far.
>>
>> Paul: do you think you can enhance your much more comprehensive
>> testcase to ease debugging further?
>>
>> Cheers,
>> Harald
>>
>

-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

[-- Attachment #2: final_38_b.f90 --]
[-- Type: text/x-fortran, Size: 10969 bytes --]

module testmode
  implicit none

  type :: simple
    integer :: ind
    character(12) :: myname
  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
    print '(3A, i4)', " finalize simple - ", trim (self%myname), "%ind = ", self%ind
  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
    print '(3A, 3i4)', " finalize simple(:) - ", trim (self(1)%myname),"%ind= ", self%ind
  end subroutine destructor2

  subroutine destructor3(self)
    type(complicated), intent(inout) :: self
    check_real = self%rind
    check_array = 0.0
    final_count = final_count + 1
    print '(3A, i4, f6.2)', " finalize complicated - ", trim (self%myname)," = ",&
                            self%ind, self%rind
  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
    if (size(self, 1) == 2) then
      print '(3A, 2i4, 2f6.2)', " finalize complicated(2) - ", trim (self(1)%myname),&
                                " = ", self%ind, self%rind
    else if (size(self, 1) == 3) then
      print '(3A, 3i4, 3f6.2)', " finalize complicated(3) - ", trim (self(1)%myname),&
                                " = ", self%ind, self%rind
    else
      print *, " finalize complicated(:) - ", trim (self(1)%myname)," = ", self%ind, self%rind
    endif
  end subroutine destructor4

  function constructor1(ind ,myname) result(res)
    type(simple), allocatable :: res
    integer, intent(in) :: ind
    character(*) :: myname
    allocate (res, source = simple (ind, myname))
  end function constructor1

  function constructor2(ind, myname, rind) result(res)
    class(simple), allocatable :: res(:)
    integer, intent(in) :: ind(:)
    real, intent(in), optional :: rind(:)
    type(complicated), allocatable :: src(:)
    character(*) :: myname
    integer :: sz
    integer :: i
    if (present (rind)) then
      sz = min (size (ind, 1), size (rind, 1))
      src  = [(complicated (ind(i), myname, rind(i)), i = 1, sz)]
      allocate (res, source = src)
    else
      sz = size (ind, 1)
      allocate (res, source = [(simple (ind(i), myname), 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), parameter   :: ThyType   = simple(21, "ThyType")
   type(simple)              :: ThyType2  = simple(22, "ThyType2")
   type(simple), allocatable :: MyType, MyType2
   type(simple), allocatable :: MyTypeArray(:)
   type(complicated), allocatable :: ThyTypeArray(:)

   print '(a,i4)', " At start of program: final_count = ", final_count

!*******************************************************************
! Patch now corrected not to finalize when 'var' is not allocated.
! Mytype not allocated and so no finalization => final_count = 0
!*******************************************************************
   print *, "*******************************************************************"
   print *, ""
   print *, "1st assignment: No finalization because MyType unallocated."
   MyType = ThyType
   print '(a,i4,a)', " After 1st assignment(var not allocated): final_count = ", final_count, "(0)"
   print *, "*******************************************************************"
   print *, ""
!*******************************************************************
! Mytype2 is allocated and so finalization should occur => final_count = 1
!*******************************************************************
   print *, "2nd assignment: MyType(=simple(1,MyType) finalized before assignment"
   final_count = 0
   allocate (Mytype2, source = simple (1, "Mytype2"))
   MyType2 = ThyType2
   print '(a,i4,a)', " After 2nd assignment(var allocated): final_count = ", final_count, "(1)"
   print *, "*******************************************************************"
   print *, ""

!*******************************************************************
! This should result in a final call with self = [simple(42),simple(43)].
! NAG outputs self = [simple(21),simple(22)] and a double increment of
! the final count, which PRT does not understand.
! In PRT's opinion => final_count = 1
!*******************************************************************
   print *, "3rd assignment: MyTypeArray(%ind = [41 42]) finalized before assignment"
   print *, ""
   final_count = 0
   allocate(MyTypeArray, source = [simple (42, "MyTypeArray"), simple(43, "MyTypeArray")])
   MyTypeArray = [ThyType, ThyType2]
   print '(a,i4,a)', " After 3rd assignment(array var allocated): final_count = ", final_count, "(1)"
   print *, "*******************************************************************"
   print *, ""

!*******************************************************************
! Check that rhs function expressions finalize correctly.
! 'var' is finalized on deallocation and then again on assignment. The
! function result of 'constructor1' is finalized after the assignment.
! (Note NAG only generates two final calls and check_scalar = 11.)
! In PRT's opinion => final_count = 3
!*******************************************************************
   print *, "Deallocation generates final call with self = simple (21, ThyType)"
   print *, "4th assignment: MyTypeArray finalized before assignment"
   print *, "Mtype finalized before assignment with self = simple (11, MyType)"
   print *, "Function result finalized after assignment with self = simple (99, MyType)"
   print *, ""
   final_count = 0
   deallocate (MyType)
   allocate (MyType, source = simple (11, "MyType"))
   MyType = constructor1 (99, "MyType")
   print '(a,i4,a)', " After 4th assignment(array var allocated) :final_count = ", final_count, "(3)"
   print *, "*******************************************************************"
   print *, ""

!*******************************************************************
! Check that rhs array function expressions finalize correctly.
! 'var' is on assignment. The function result of 'constructor3' is
! finalized after the assignment. Both finalizations result in a
! finalization of the extended type and then the parent. In addition,
! the assignment in constructor3 causes a finalization of 'res'.
! Therefore => final_count = 6
! (Note ifort generates ten final calls because of the scalar final
! calls of the parent components, rather than array calls.)
!*******************************************************************
   print *, "5th assignment: MyTypeArray finalized before assignment"
   print *, "1] First finalization is of 'res' in constructor3 with:"
   print *, "Self = [complicated (-1, constructor3, 0.0), complicated (-1, ThyTypeArra1, 0.0)]"
   print *, "2] ThyTypeArray is finalized before assignment and after evaluation of constructor3"
   print *, "Self = [3 times complicated (-1, ThyTypeArra1,0.0)]"
   print *, "3] Function result finalized after assignment with"
   print *, "Self = [complicated (-1, ThyTypeArra2, 0.0), complicated (-1, ThyTypeArra2, 0.0)]"
   print *, ""
   final_count = 0
   allocate (ThyTypeArray(3), source = complicated (-1,"ThyTypeArra1",0.0))
   ThyTypeArray = constructor3 ("ThyTypeArra2")
   print '(a,i4,a)', " After 5th assignment(array var allocated):", final_count, "(6)"
   print *, ""
   print *, "*******************************************************************"
   print *, "Deallocate ThyTypeArray."
   deallocate (ThyTypeArray)
   print *, ""
   print *, "*******************************************************************"

!*******************************************************************
! 6th Assignment has the allocatable version of the function. This should
! give the same result as the previous one.
!*******************************************************************
   print *, "6th assignment: A repeat of the previous with an allocatable function result."
   print *, "This should give the same result as the 5th assignment."
   print *, ""
   final_count = 0
   allocate (ThyTypeArray(3), source = complicated (-1,"ThyTypeArra1",0.0))
   ThyTypeArray = constructor4 ("ThyTypeArra2")
   print '(a,i4,a)', " After 6th assignment(array var allocated):", final_count, "(6)"
   print *, ""
   print *, "*******************************************************************"

!*******************************************************************
! Everybody agrees (PRT thinks) about deallocation, except where arrays
! of extended types are concerned (Intel)
!*******************************************************************
   final_count = 0
   print *, "Deallocations at end"
   print *, ""
   deallocate(Mytype)
   print *, "After 1st deallocation:", final_count
   deallocate(Mytype2)
   print *, "After 2nd deallocation:", final_count
   deallocate(MytypeArray)
   print *, "After 3rd deallocation:", final_count

contains
   function constructor3 (myname) result(res)
      type(complicated) :: res(2)
      character(12) :: myname
      print *, "constructor3: final_count = ", final_count
      res%myname = "constructor3"
      res = [complicated(1, myname, 2.0),complicated(3, myname, 4.0)]
   end function

   function constructor4 (myname) result(res)
      type(complicated), allocatable :: res(:)
      character(12) :: myname
      print *, "constructor4: final_count = ", final_count
      allocate (res(2), source = complicated (1, "constructor3", 1.0))
      res%myname = "constructor4"
      res = [complicated(1, myname, 2.0),complicated(3, myname, 4.0)]
   end function

end program test_final