Function Fortran多态性、函数和分配

我是Fortran面向对象编程的初学者，我正在尝试编写一个程序，其中包含处理多态变量作为参数的过程。 虽然我的原始代码要复杂得多（许多过程、几个派生类型等等），但我可以分离出一个简单的问题示例，比如：我有一个复制多态变量的过程，并稍微修改了这个副本

我能够使用子程序成功地编写测试程序：

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

然而，我已经努力了好几天，试图让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

。 然而，检查这个简单测试程序的内存预算（我使用OSX上的仪器软件），似乎有些内存在结束之前没有释放。 我怀疑复制函数和赋值子例程都分配内存，并且我只释放了一个事件，剩下一个已分配

由于我打算在更复杂的代码中大量使用这样一个例程，所以我真正关心的是内存分配/释放。 当然，我可以使用子程序版本的程序，但如果有办法，我更喜欢函数版本

---

有办法解决这样的问题吗？

这听起来像是我不久前提出的一个关于函数与子例程的问题：

---

我认为在使用子例程（允许分配和解除分配）和使用函数（只能分配）之间有一种折衷。我建议，如果数据结构很大，就不要使用函数，而是使用子例程。

您尝试过使用指针吗

    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

---

在函数示例中，我想您的意思是

y=fun\u copy（x）

。另一个解决方法是分配（y，source=fun\u copy（x）），但这并没有那么吸引人。不过，看看同样的事情是否会持续下去会很有趣。@francescalus是的，我的意思是

y=fun\u copy（x）

。我编辑了原始帖子并更正了它。另外，我刚刚尝试了您的解决方法，内存分配/释放问题仍然存在。据我所知没有变化。我（还）不知道答案，但我想我们可以排除已定义的分配是问题。

valgrind

显示

fun\u copy

中的分配未被分配。此处创建的临时文件将被传递到

myassign

，然后再也不会被释放。我所能看到的唯一可行的方法是完成临时任务，据我所知，它还没有在gfortran中实现。我知道这会在某种程度上改变您的意图，但是您是否尝试过使用指针而不是可分配的？这将避免创建临时文件的问题，因为您无法手动取消分配临时文件。而是在函数内部分配一个指针并返回它，然后确保在调用代码中取消分配它。

    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