function - Fortran 多态性、函数和分配

Question

我是 Fortran 的 OOP 初学者，我正在尝试编写一个程序，其中包含将多态变量作为参数处理的过程。
尽管我的原始代码要复杂得多(许多过程、几种派生类型等)，但我可以隔离我的问题的一个简单示例，例如:我有一个复制多态变量并稍微修改此副本的过程。

我能够使用子例程成功编写我的测试程序:

MODULE my_module

type :: my_type
    real :: data
endtype my_type

type, extends(my_type) :: my_derived_type
end type my_derived_type

CONTAINS

subroutine sub_copy(old,new) 
implicit none
class(my_type), intent(in) :: old
class(my_type), allocatable, intent(out) :: new
allocate(new, source = old)
new%data = new%data + 1
end subroutine sub_copy

END MODULE my_module

PROGRAM my_prog
use my_module
implicit none
type(my_derived_type) :: x
class(my_type), allocatable :: y

x%data = 1.0
call sub_copy(x,y)
print*,y%data
deallocate(y)

END PROGRAM my_prog

这在预期结果和内存分配/释放方面都表现良好。

但是，我一直在努力使 Fortran 函数能够完成同样的工作。

似乎以与子例程类似的方式定义的函数(见下文)不能简单地用作

y = fun_copy(x)

我的 gfortran 编译器 (v5.0.0) 提示:

Error: Assignment to an allocatable polymorphic variable at (1) is not yet supported

我在这里和那里都读到过，我的编译器确实不支持这种分配。等待这一点，我试图通过定义我自己的赋值运算符 (=) 来解决这个问题。以下代码有效:

MODULE my_module

type :: my_type
    real :: data
endtype my_type

type, extends(my_type) :: my_derived_type
end type my_derived_type

interface assignment(=)
  module procedure myassign
end interface

CONTAINS

function fun_copy(old) result(new) 
implicit none
class(my_type), intent(in) :: old
class(my_type), allocatable :: new
allocate(new, source = old)
new%data = new%data + 1
end function fun_copy

subroutine myassign(new,old)
class(my_type), intent(in)  :: old
class(my_type), allocatable, intent(out) :: new
allocate(new, source=old)
end subroutine

END MODULE my_module

PROGRAM my_prog
use my_module
implicit none
type(my_derived_type) :: x
class(my_type), allocatable :: y

x%data = 1.0
y = fun_copy(x)
print*,y%data
deallocate(y)

END PROGRAM my_prog

从某种意义上说，它确实是 x 的副本。创建为 y .
然而，检查这个简单测试程序的内存预算(我在 OS X 上使用 Instrument 软件)，似乎有些内存在它结束之前没有被释放。
我怀疑复制函数和赋值子例程都分配了内存，并且我只释放了一次，而留下了一次分配。

因为我打算在更复杂的代码中多次使用这样的例程，所以我真的很关心内存分配/释放。
当然，我可以使用程序的子程序版本，但如果有办法，我更喜欢函数版本。

有没有办法处理这样的问题？

Answer 1

您是否尝试过使用指针？

    module my_module

        implicit none

        type :: my_type
            real :: data
        contains
            procedure              :: sub_copy
            procedure              :: fun_copy_ptr
            procedure              :: fun_copy_alloc
            procedure, pass (this) :: my_assign
            generic                :: assignment(=) => my_assign
        end type my_type

        type, extends(my_type) :: my_derived_type
        end type my_derived_type

    contains

        subroutine sub_copy(this, new)
            class(my_type), intent (in)               :: this
            class(my_type), allocatable, intent (out) :: new

            allocate(new, source=this)
            new%data = new%data + 1

        end subroutine sub_copy

        function fun_copy_alloc(this) result (new)
            class(my_type), intent(in)  :: this
            class(my_type), allocatable :: new

            allocate(new, source=this)
            new%data = new%data + 1.0

        end function fun_copy_alloc

        function fun_copy_ptr(this) result (new)
            class(my_type), intent(in) :: this
            class(my_type), pointer    :: new

            allocate(new, source=this)
            new%data = new%data + 1.0

        end function fun_copy_ptr

        subroutine my_assign(new, this)
            class(my_type), intent(in)               :: this
            class(my_type), allocatable, intent(out) :: new

            allocate(new, source=this)

        end subroutine

    end module my_module

    program my_prog

        use my_module, only: &
            my_type, &
            my_derived_type

        implicit none
        type(my_derived_type)       :: x
        class(my_type), allocatable :: y
        class(my_type), pointer     :: y_ptr => null()

        x%data = 1.0

        ! Case 1
        call x%sub_copy(y)
        print *, y%data
        deallocate(y)

        ! Case 2
        y_ptr => x%fun_copy_ptr()
        print *, y_ptr%data
        deallocate(y_ptr)

        ! Case 3
        allocate( y, source=x%fun_copy_alloc() )
        print *, y%data
        deallocate(y)

    end program my_prog