Fortran：如何插入链表中未释放指针的内存泄漏
Fortran: How to plug memory leak from un-deallocated pointer in linked list
我有一个在 Fortran 2008 (GNU Fortran v4.9.2) 中实现的双向链表。该列表在能够 insert/delete/push/pop 方面表现符合预期，但在大量使用下存在内存泄漏，我认为即将到来的指针未被释放。
这是一个最小的工作案例：
module c_DLLMod
implicit none
private
type, public :: c_Node
private
type(c_Node), pointer :: Parent => null(), Child => null()
integer, allocatable :: Val
contains
procedure :: GetVal => m_GetVal
procedure :: SetVal => m_SetVal
end type c_Node
type, public :: c_DLL
private
type(c_Node), pointer :: Head => null(), Tail => null()
integer :: Size
logical :: IsReady = .false.
contains
procedure :: Front => m_Front
procedure :: PushFront => m_PushFront
procedure :: PopFront => m_PopFront
procedure :: Delete => m_Delete
procedure :: IsEmpty => m_IsEmpty
procedure :: Free => m_Free
end type c_DLL
interface c_DLL
module procedure m_NewDLL
end interface c_DLL
contains
! Begin c_Node methods
subroutine m_SetVal(N, Val)
class(c_Node), intent(inout) :: N
integer, intent(in) :: Val
if (.not. allocated(N%Val)) allocate(N%Val)
N%Val = Val
end subroutine m_SetVal
integer function m_GetVal(N) result(Val)
class(c_Node), intent(in) :: N
Val = N%Val
end function m_GetVal
! End c_Node methods
! Begin c_DLL methods
! Initialize linked list by setting initial size and ready status
function m_NewDLL() result(L)
type(c_DLL) :: L
L%Size = 0
L%IsReady = .true.
end function m_NewDLL
! Make sure that the head points to the first node and the tail to the last
subroutine m_Listify(L)
class(c_DLL), intent(inout) :: L
do while(associated(L%Head%Parent))
L%Head => L%Head%Parent
end do
do while(associated(L%Tail%Child))
L%Tail => L%Tail%Child
end do
end subroutine m_Listify
! Return the value stored in the front (head) node
integer function m_Front(L) result(Val)
class(c_DLL), intent(in) :: L
Val = 0
if (L%IsReady) Val = L%Head%GetVal()
end function m_Front
! Push new value to the front of the list
subroutine m_PushFront(L, Val)
class(c_DLL), intent(inout) :: L
integer, intent(in) :: Val
if (L%IsReady) then
if (L%Size == 0) then
! List is new or empty, so need to allocate the head node
! and assign its value to Val
if (.not. associated(L%Head)) then
allocate(L%Head)
L%Tail => L%Head ! List only has 1 value, so tail and head are same
end if
call L%Head%SetVal(Val)
else
! List is not empty, so make sure head and tail point to right
! nodes, then allocate new node in front of the head and assign
! Val to it.
call m_Listify(L)
allocate(L%Head%Parent)
call L%Head%Parent%SetVal(Val)
L%Head%Parent%Child => L%Head ! Give the new head its child node
nullify(L%Head%Parent%Parent) ! Tell new head that it is in fact the head (i.e. no parent node)
L%Head => L%Head%Parent ! Set head pointer to the new head
end if
L%Size = L%Size + 1
end if
end subroutine m_PushFront
! Remove the head node from the list
subroutine m_PopFront(L)
class(c_DLL), intent(inout) :: L
if (L%IsReady .and. L%Size > 0) then
if (associated(L%Head%Child)) then
! List has more than 1 value, so need to point head to the
! new head after popping
L%Head => L%Head%Child
call m_Delete(L, L%Head%Parent) ! Head%Parent is actually the head until it's deleted
else
! List has only 1 element, so can simply delete it
call m_Delete(L, L%Head)
end if
end if
end subroutine m_PopFront
! Remove a node N from the list, maintaining connectivity in the list
subroutine m_Delete(L, N)
class(c_DLL), intent(inout) :: L
type(c_Node), pointer, intent(inout) :: N
if (L%IsReady .and. L%Size >= 1) then
deallocate(N%Val) ! Deallocate the integer Val of the node to be deleted (N)
if (associated(N%Parent)) then
if (associated(N%Child)) then
! N has both parent and child nodes, so need to point parent to child
! and child to parent so that the list stays connected
N%Child%Parent => N%Parent
N%Parent%Child => N%Child
else
! N has only parent node, so the parent's child pointer will now become null,
! so that the parent know's it's the new tail of the list
nullify(N%Parent%Child)
end if
else
if (associated(N%Child)) then
! N has only child node, so the child's parent pointer will now become null,
! so that the child know's it's the new head of the list
nullify(N%Child%Parent)
end if
end if
! At this point I'm done with N, and N was allocated earlier by
! either the m_NewDLL function or inside a call to m_PushFront,
! but if I try to deallocate then it throws a runtime error that
! N isn't allocated and cannot be deallocated.
! deallocate(N)
nullify(N)
L%Size = L%Size - 1
end if
end subroutine m_Delete
! Check if list is empty
logical function m_IsEmpty(L)
class(c_DLL), intent(in) :: L
m_IsEmpty = (L%Size == 0)
end function m_IsEmpty
! Delete all elements of the list, starting with the head node
subroutine m_Free(L)
class(c_DLL), intent(inout) :: L
type(c_Node), pointer :: Cur
if (L%IsReady .and. L%Size > 0) then
Cur => L%Head
do while(associated(Cur%Child))
Cur => Cur%Child
call m_Delete(L, Cur%Parent)
end do
call m_Delete(L, Cur)
L%Size = 0
L%IsReady = .false.
end if
end subroutine m_Free
end module c_DLLMod
! Simple test program that pushs array values to a list
! and then pops them off the front of the list.
! This behavior is that of a stack, so the order
! of array elements is reversed in the process of
! pushing/popping.
program main
use c_DLLMod
implicit none
type(c_DLL) :: List
integer, dimension(10) :: A
integer :: i, j
! When IsDebug is true, the test will execute 10 million times, and
! the program's memory cost will go to ~2.5GB.
! When IsDebug is false, the test will execute once, and will output
! values along the way so that you can see the list is
! performing as expected.
logical :: IsDebug = .true.
A = (/ 2,1,4,3,6,5,8,7,10,9 /)
write(*,*) 'Starting test'
List = c_DLL()
do j = 1, 10000000
if (IsDebug) write(*,*) 'populate list'
do i = 1, 10
call List%PushFront(A(i))
if (IsDebug) write(*,*) List%Front()
end do
if (IsDebug) write(*,*) 'empty list'
do while(.not. List%IsEmpty())
if (IsDebug) write(*,*) List%Front()
call List%PopFront
end do
if (IsDebug) stop
end do
write(*,*) 'Finished'
call List%Free
end program main
切换 IsDebug 的值以切换测试的 short/long 版本。
每个 c_Node 都有一个整数指针，在存储值之前分配，并在不再需要该节点时在 m_Delete() 中释放。在第 160 行（deallocate(N) in m_Delete()），被删除的节点应该被释放，但是这一行抛出一个 运行time 错误，指出该节点没有被分配，因此无法被释放.当这一行被注释掉时，列表有效，但如果完整测试是 运行 那么程序将占用 ~2.5GB 内存，我认为泄漏是由于这些节点在它们被释放时没有被释放删除，导致分配了数百万个指针。
我已经评论了代码，希望你们都能看到发生了什么。我一定是在某个地方犯了一个根本性的错误，我是如何实现这个链表的，但是 C++ 中的类似实现工作得很好。
我做错了什么导致无法重新分配已删除的节点？[=37=] 或者这实际上是这里的问题吗？
谢谢，
蒂姆
P.S。附带一提，我不完全确定何时使用 nullify(pointer) 与 pointer => null()。你能评论一下我对每一个的使用吗？
找到错误的关键（在用 valgrind 进行简短检查后）是这篇文章：
! At this point I'm done with N, and N was allocated earlier by
! either the m_NewDLL function or inside a call to m_PushFront,
! but if I try to deallocate then it throws a runtime error that
! N isn't allocated and cannot be deallocated.
! deallocate(N)
你真的应该释放N。此时它为空的事实意味着有问题！
错误在这里：
if (associated(N%Child)) then
! N has only child node, so the child's parent pointer will now become null,
! so that the child know's it's the new head of the list
nullify(N%Child%Parent)
事实上，您现在正在使 N 无效，因为您传递给 m_Delete 的是
call m_Delete(L, L%Head%Parent)
所以N是L%Head%Parent，N%Child是L%Head，它的Parent是N。至少如果我理解你的代码是对的。
无论如何，如果我取消注释 deallocate 并注释这个 nullify，它会很好地工作：
==3347==
==3347== HEAP SUMMARY:
==3347== in use at exit: 0 bytes in 0 blocks
==3347== total heap usage: 41 allocs, 41 frees, 12,271 bytes allocated
==3347==
==3347== All heap blocks were freed -- no leaks are possible
==3347==
==3347== For counts of detected and suppressed errors, rerun with: -v
==3347== ERROR SUMMARY: 0 errors from 0 contexts (suppressed: 2 from 2)
正如 IanH 在他的评论中指出的那样，还有另一个问题。您在此调用的两个单独参数中两次将同一实体作为实际参数传递给 m_delete：
call m_Delete(L, L%Head)
L%Head 是 L 的一部分，您可以通过第二个参数更改 L%Head 的关联状态，还可以通过第一个参数更改 L 其他部分的值。这是不允许的。解决此问题的最短方法是将 target 属性添加到 Fortran 2008 标准第 12.5.2.13p1(3b) 段中 m_Delete 的第一个虚拟参数。所有限制都在 F2008 的第 12.5.2.13 节中。
我有一个在 Fortran 2008 (GNU Fortran v4.9.2) 中实现的双向链表。该列表在能够 insert/delete/push/pop 方面表现符合预期，但在大量使用下存在内存泄漏，我认为即将到来的指针未被释放。
这是一个最小的工作案例：
module c_DLLMod
implicit none
private
type, public :: c_Node
private
type(c_Node), pointer :: Parent => null(), Child => null()
integer, allocatable :: Val
contains
procedure :: GetVal => m_GetVal
procedure :: SetVal => m_SetVal
end type c_Node
type, public :: c_DLL
private
type(c_Node), pointer :: Head => null(), Tail => null()
integer :: Size
logical :: IsReady = .false.
contains
procedure :: Front => m_Front
procedure :: PushFront => m_PushFront
procedure :: PopFront => m_PopFront
procedure :: Delete => m_Delete
procedure :: IsEmpty => m_IsEmpty
procedure :: Free => m_Free
end type c_DLL
interface c_DLL
module procedure m_NewDLL
end interface c_DLL
contains
! Begin c_Node methods
subroutine m_SetVal(N, Val)
class(c_Node), intent(inout) :: N
integer, intent(in) :: Val
if (.not. allocated(N%Val)) allocate(N%Val)
N%Val = Val
end subroutine m_SetVal
integer function m_GetVal(N) result(Val)
class(c_Node), intent(in) :: N
Val = N%Val
end function m_GetVal
! End c_Node methods
! Begin c_DLL methods
! Initialize linked list by setting initial size and ready status
function m_NewDLL() result(L)
type(c_DLL) :: L
L%Size = 0
L%IsReady = .true.
end function m_NewDLL
! Make sure that the head points to the first node and the tail to the last
subroutine m_Listify(L)
class(c_DLL), intent(inout) :: L
do while(associated(L%Head%Parent))
L%Head => L%Head%Parent
end do
do while(associated(L%Tail%Child))
L%Tail => L%Tail%Child
end do
end subroutine m_Listify
! Return the value stored in the front (head) node
integer function m_Front(L) result(Val)
class(c_DLL), intent(in) :: L
Val = 0
if (L%IsReady) Val = L%Head%GetVal()
end function m_Front
! Push new value to the front of the list
subroutine m_PushFront(L, Val)
class(c_DLL), intent(inout) :: L
integer, intent(in) :: Val
if (L%IsReady) then
if (L%Size == 0) then
! List is new or empty, so need to allocate the head node
! and assign its value to Val
if (.not. associated(L%Head)) then
allocate(L%Head)
L%Tail => L%Head ! List only has 1 value, so tail and head are same
end if
call L%Head%SetVal(Val)
else
! List is not empty, so make sure head and tail point to right
! nodes, then allocate new node in front of the head and assign
! Val to it.
call m_Listify(L)
allocate(L%Head%Parent)
call L%Head%Parent%SetVal(Val)
L%Head%Parent%Child => L%Head ! Give the new head its child node
nullify(L%Head%Parent%Parent) ! Tell new head that it is in fact the head (i.e. no parent node)
L%Head => L%Head%Parent ! Set head pointer to the new head
end if
L%Size = L%Size + 1
end if
end subroutine m_PushFront
! Remove the head node from the list
subroutine m_PopFront(L)
class(c_DLL), intent(inout) :: L
if (L%IsReady .and. L%Size > 0) then
if (associated(L%Head%Child)) then
! List has more than 1 value, so need to point head to the
! new head after popping
L%Head => L%Head%Child
call m_Delete(L, L%Head%Parent) ! Head%Parent is actually the head until it's deleted
else
! List has only 1 element, so can simply delete it
call m_Delete(L, L%Head)
end if
end if
end subroutine m_PopFront
! Remove a node N from the list, maintaining connectivity in the list
subroutine m_Delete(L, N)
class(c_DLL), intent(inout) :: L
type(c_Node), pointer, intent(inout) :: N
if (L%IsReady .and. L%Size >= 1) then
deallocate(N%Val) ! Deallocate the integer Val of the node to be deleted (N)
if (associated(N%Parent)) then
if (associated(N%Child)) then
! N has both parent and child nodes, so need to point parent to child
! and child to parent so that the list stays connected
N%Child%Parent => N%Parent
N%Parent%Child => N%Child
else
! N has only parent node, so the parent's child pointer will now become null,
! so that the parent know's it's the new tail of the list
nullify(N%Parent%Child)
end if
else
if (associated(N%Child)) then
! N has only child node, so the child's parent pointer will now become null,
! so that the child know's it's the new head of the list
nullify(N%Child%Parent)
end if
end if
! At this point I'm done with N, and N was allocated earlier by
! either the m_NewDLL function or inside a call to m_PushFront,
! but if I try to deallocate then it throws a runtime error that
! N isn't allocated and cannot be deallocated.
! deallocate(N)
nullify(N)
L%Size = L%Size - 1
end if
end subroutine m_Delete
! Check if list is empty
logical function m_IsEmpty(L)
class(c_DLL), intent(in) :: L
m_IsEmpty = (L%Size == 0)
end function m_IsEmpty
! Delete all elements of the list, starting with the head node
subroutine m_Free(L)
class(c_DLL), intent(inout) :: L
type(c_Node), pointer :: Cur
if (L%IsReady .and. L%Size > 0) then
Cur => L%Head
do while(associated(Cur%Child))
Cur => Cur%Child
call m_Delete(L, Cur%Parent)
end do
call m_Delete(L, Cur)
L%Size = 0
L%IsReady = .false.
end if
end subroutine m_Free
end module c_DLLMod
! Simple test program that pushs array values to a list
! and then pops them off the front of the list.
! This behavior is that of a stack, so the order
! of array elements is reversed in the process of
! pushing/popping.
program main
use c_DLLMod
implicit none
type(c_DLL) :: List
integer, dimension(10) :: A
integer :: i, j
! When IsDebug is true, the test will execute 10 million times, and
! the program's memory cost will go to ~2.5GB.
! When IsDebug is false, the test will execute once, and will output
! values along the way so that you can see the list is
! performing as expected.
logical :: IsDebug = .true.
A = (/ 2,1,4,3,6,5,8,7,10,9 /)
write(*,*) 'Starting test'
List = c_DLL()
do j = 1, 10000000
if (IsDebug) write(*,*) 'populate list'
do i = 1, 10
call List%PushFront(A(i))
if (IsDebug) write(*,*) List%Front()
end do
if (IsDebug) write(*,*) 'empty list'
do while(.not. List%IsEmpty())
if (IsDebug) write(*,*) List%Front()
call List%PopFront
end do
if (IsDebug) stop
end do
write(*,*) 'Finished'
call List%Free
end program main
切换 IsDebug 的值以切换测试的 short/long 版本。
每个 c_Node 都有一个整数指针，在存储值之前分配，并在不再需要该节点时在 m_Delete() 中释放。在第 160 行（deallocate(N) in m_Delete()），被删除的节点应该被释放，但是这一行抛出一个 运行time 错误，指出该节点没有被分配，因此无法被释放.当这一行被注释掉时，列表有效，但如果完整测试是 运行 那么程序将占用 ~2.5GB 内存，我认为泄漏是由于这些节点在它们被释放时没有被释放删除，导致分配了数百万个指针。
我已经评论了代码，希望你们都能看到发生了什么。我一定是在某个地方犯了一个根本性的错误，我是如何实现这个链表的，但是 C++ 中的类似实现工作得很好。
我做错了什么导致无法重新分配已删除的节点？[=37=] 或者这实际上是这里的问题吗？
谢谢，
蒂姆
P.S。附带一提，我不完全确定何时使用 nullify(pointer) 与 pointer => null()。你能评论一下我对每一个的使用吗？
找到错误的关键（在用 valgrind 进行简短检查后）是这篇文章：
! At this point I'm done with N, and N was allocated earlier by
! either the m_NewDLL function or inside a call to m_PushFront,
! but if I try to deallocate then it throws a runtime error that
! N isn't allocated and cannot be deallocated.
! deallocate(N)
你真的应该释放N。此时它为空的事实意味着有问题！
错误在这里：
if (associated(N%Child)) then
! N has only child node, so the child's parent pointer will now become null,
! so that the child know's it's the new head of the list
nullify(N%Child%Parent)
事实上，您现在正在使 N 无效，因为您传递给 m_Delete 的是
call m_Delete(L, L%Head%Parent)
所以N是L%Head%Parent，N%Child是L%Head，它的Parent是N。至少如果我理解你的代码是对的。
无论如何，如果我取消注释 deallocate 并注释这个 nullify，它会很好地工作：
==3347==
==3347== HEAP SUMMARY:
==3347== in use at exit: 0 bytes in 0 blocks
==3347== total heap usage: 41 allocs, 41 frees, 12,271 bytes allocated
==3347==
==3347== All heap blocks were freed -- no leaks are possible
==3347==
==3347== For counts of detected and suppressed errors, rerun with: -v
==3347== ERROR SUMMARY: 0 errors from 0 contexts (suppressed: 2 from 2)
正如 IanH 在他的评论中指出的那样，还有另一个问题。您在此调用的两个单独参数中两次将同一实体作为实际参数传递给 m_delete：
call m_Delete(L, L%Head)
L%Head 是 L 的一部分，您可以通过第二个参数更改 L%Head 的关联状态，还可以通过第一个参数更改 L 其他部分的值。这是不允许的。解决此问题的最短方法是将 target 属性添加到 Fortran 2008 标准第 12.5.2.13p1(3b) 段中 m_Delete 的第一个虚拟参数。所有限制都在 F2008 的第 12.5.2.13 节中。