在 Fortran 中复制复杂派生类型的正确方法

Question

我将 Intel Visual Fortran 2015 与 Visual Studio 2012 结合使用。

我尝试了许多不同的方法来尝试在我的代码中创建一个复杂派生类型的副本，但我能想到的每一种方法都会导致内存泄漏，所以我一定是做错了什么。

这是我的问题的简化示例

type Vehicle_T

    real :: time
    real, dimension(3) :: eciPos
    ...
    a bunch of variables
    ...

end Type Vehicle_T

type, extends(Vehicle_Entity_T) :: Aircraft_T
    real :: alt
    ...
    a bunch of variables
    ...
end type Aircraft_T


type Track_T
    real :: tupdated
    ...
    a bunch of variables
    ...

    class(Vehicle_T), pointer :: object

end type Track_T

type(Track_T) :: a, b

a = constructTrack(various values)

b = copyTrack(a)

contains

!The simplest way I've found that works but causes memory leak
function copyTrack(inTrack) result(outTrack)

    type(Track_T), intent(in) :: inTrack
    type(Track_T) :: outTrack

    outTrack = inTrack
    allocate(outTrack%object, source = inTrack%object)

end function copyTrack

!Another method that causes a memory leak
function copyTrack2(inTrack) result(outTrack)

    type(Track_T), intent(in) :: inTrack
    type(Track_T) :: outTrack

    outTrack%tupdated = inTrack%tupdated
    ...copy all of the rest of the values...

    if(associated(outTrack%object)) deallocate(outTrack%object)
    allocate(outTrack%object, source = inTrack%object)

end function copyTrack2

Answer 1

当你这样做时，你必须照顾 object 组件 b

`b` = some_new_object

无论新对象来自何处。 无论你在你的函数中做什么，它总是会泄漏。（或者不，如果你使用终结，见下文。我还没有使用它，因为许多编译器不完全支持它，主要是 gfortran .)

泄漏的原因是b 包含一个指针组件，该组件只能从b 访问。在内部赋值期间指针将被覆盖，指针的目标将丢失。

使用子程序：

implicit none

type Vehicle_T

    real :: time = 0
    real, dimension(3) :: eciPos = 0


end Type Vehicle_T

type, extends(Vehicle_T) :: Aircraft_T
    real :: alt

end type Aircraft_T


type Track_T
    real :: tupdated

    class(Vehicle_T), pointer :: object => null()

end type Track_T

type(Track_T) :: a, b

integer :: i

allocate(Aircraft_T :: a%object)

do i = 1, 10
  call copyTrack(b, a)
end do

deallocate(a%object)
deallocate(b%object)

contains


subroutine copyTrack(outTrack, inTrack)

    type(Track_T), intent(in) :: inTrack
    type(Track_T) :: outTrack

    if (associated(outTrack%object)) deallocate(outTrack%object)
    outTrack = inTrack
    allocate(outTrack%object, source = inTrack%object)

end subroutine copyTrack



end

或者更好的重载赋值：

module types
  implicit none

  type Vehicle_T

      real :: time = 0
      real, dimension(3) :: eciPos = 0


  end Type Vehicle_T

  type, extends(Vehicle_T) :: Aircraft_T
      real :: alt

  end type Aircraft_T


  type Track_T
      real :: tupdated

      class(Vehicle_T), pointer :: object => null()
  contains
      procedure :: copyTrack
      generic :: assignment(=) => copyTrack
  end type Track_T

contains

    subroutine copyTrack(outTrack, inTrack)

        type(Track_T), intent(in) :: inTrack
        class(Track_T), intent(inout) :: outTrack

        if (associated(outTrack%object)) deallocate(outTrack%object)

        allocate(outTrack%object, source = inTrack%object)

    end subroutine copyTrack



end module


  use types

  implicit none

  type(Track_T) :: a, b

  integer :: i

  allocate(Aircraft_T :: a%object)

  do i = 1, 10
    b = a
  end do

  deallocate(a%object)
  deallocate(b%object)

end

具有函数和终结性。 希望不会在 ifort 中泄漏，但会在 gfortran 中泄漏。

module types
  implicit none

  type Vehicle_T

      real :: time = 0
      real, dimension(3) :: eciPos = 0


  end Type Vehicle_T

  type, extends(Vehicle_T) :: Aircraft_T
      real :: alt

  end type Aircraft_T


  type Track_T
      real :: tupdated

      class(Vehicle_T), pointer :: object => null()
  contains
    final :: finalize_Track
  end type Track_T

contains

    function copyTrack(inTrack) result(outTrack)

        type(Track_T), intent(in) :: inTrack
        type(Track_T) :: outTrack

        outTrack = inTrack
        allocate(outTrack%object, source = inTrack%object)

    end function copyTrack

   subroutine finalize_Track(t)
     type(Track_T), intent(inout) :: t
     if (associated(t%object)) deallocate(t%object)
   end subroutine
end module


  use types

  type(Track_T) :: a, b

  integer :: i

  allocate(Aircraft_T :: a%object)

  do i = 1, 10
    b = copyTrack(a)
  end do

  deallocate(a%object)
  deallocate(b%object)

end