Community
cancel
Showing results for 
Search instead for 
Did you mean: 
Highlighted
Black Belt
8 Views

Finalization not happening when actual argument implicitly deallocated

I have been putting together a thin wrapper around the Direct2D graphics stuff, which I'll post once I've finished writing some documentation.  It is working quite nicely, except for a resource leak where the compiler is not invoking the finalizer of a polymorphic allocatable component when objects are deallocated as part of being associated with INTENT(OUT) allocatable dummy arguments.

module direct2d
  implicit none
  
  type manager
    integer :: comp = 0
  contains
    final :: manager_final
  end type manager
  
  type, extends(manager) :: d2d1resource
  end type d2d1resource
  
  type, extends(d2d1resource) :: d2d1geometry
  end type d2d1geometry
  
  ! THis is ultimately an extension of manager, which has a 
  ! finalizer.
  type, extends(d2d1geometry) :: d2d1pathgeometry
  end type d2d1pathgeometry
contains
  subroutine manager_final(obj)
    type(manager), intent(inout) :: obj
    
    print "('manager_final called with comp of ',i0)", obj%comp
    if (obj%comp > 0) then
      obj%comp = 0
    end if
  end subroutine manager_final
end module direct2d

module m2
  use direct2d
  implicit none
  
  type parent
  end type parent
  
  type, extends(parent) :: extension
    class(d2d1geometry), allocatable :: arrow
  end type extension
contains
  subroutine create_arrow(arrow)
    class(d2d1geometry), intent(out), allocatable :: arrow
    
    type(d2d1pathgeometry), allocatable :: path
    allocate(path)
    path%comp = 1
    call move_alloc(path, arrow)
  end subroutine create_arrow
end module m2

program p
  use m2
  implicit none
  print "('Before call to exec')"
  call exec
  print "('After call to exec')"
contains
  subroutine exec
    class(parent), allocatable :: test
    
    print "('Before first call to create.')"
    ! test not allocated, so it is not finalized.
    call create(test)
    
    print "('Before second call to create - where''s the finalizer?')"
    ! test is allocated here, so we expect finalizer call, 
    ! but we don't get one.
    call create(test)
    
    print "('Before third call to create and explicit deallocate.')"
    ! test is allocated here, explicit deallocation results in 
    ! finalizer call, as expected.
    if (allocated(test)) deallocate(test)
    call create(test)
    
    ! Test is allocated here, and gets automatically deallocated 
    ! and finalized as we would expect.
    print "('Before end of subroutine.')"
  end subroutine exec
  
  subroutine create(test)
    class(parent), intent(out), allocatable :: test
    type(extension), allocatable :: ext
    
    allocate(ext)
    call create_arrow(ext%arrow)
    call move_alloc(ext, test)
  end subroutine create
end program p

>ifort /check:all /warn:all /standard-semantics /traceback "2016-05-01 d2d-finalization.f90" && "2016-05-01 d2d-finaliza
tion.exe"
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 16.0.2.180 Build 20160204
Copyright (C) 1985-2016 Intel Corporation.  All rights reserved.

Microsoft (R) Incremental Linker Version 14.00.23918.0
Copyright (C) Microsoft Corporation.  All rights reserved.

"-out:2016-05-01 d2d-finalization.exe"
-subsystem:console
-incremental:no
"2016-05-01 d2d-finalization.obj"
Before call to exec
Before first call to create.
Before second call to create - where's the finalizer?
Before third call to create and explicit deallocate.
manager_final called with comp of 1
Before end of subroutine.
manager_final called with comp of 1
After call to exec

 

0 Kudos
4 Replies
Highlighted
8 Views

Thanks, we'll look into this. 

0 Kudos
Highlighted
8 Views

Escalated as issue DPD200410482 . 

0 Kudos
Highlighted
8 Views

Fixed for the final 17.0 release. We were not finalizing polymorphic intent(out) dummies if the declared type wasn't finalizable.

0 Kudos
Highlighted
Black Belt
8 Views

Thanks - that explains some other issues I've been seeing.  I hadn't cottoned on to the declared type bit.

0 Kudos