I have a doubly-linked list implemented in Fortran 2008 (GNU Fortran v4.9.2). The list behaves as expected in terms of being able to insert/delete/push/pop, but under heavy use there is a memory leak I believe is coming pointers that are not being deallocated.
Here is a minimum working case:
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
Switch the value of
IsDebug to toggle the short/long versions of the test.
c_Node has a integer pointer that is allocated before a value is stored, and deallocated in
m_Delete() when the node is no longer required. On line 160 (
m_Delete()) the node being deleted should be deallocated, but this line throws a runtime error stating that the node is not allocated and therefore is unable to be deallocated. When this line is commented out, the list works, but if the full test is run then the program will take ~2.5GB of memory, and I think the leak is due to these nodes not being deallocated when they’re deleted, resulting in millions of allocated pointers.
I’ve commented the code that, hopefully, you all can see what’s going on. I must be making a fundamental mistake somewhere with how I’ve implemented this linked list, but a similar implementation in C++ works just fine.
What am I doing wrong that keeps a deleted node from being able to be deallocated? Or is that actually the problem here?
P.S. On a side note, I'm not entirely sure when to use
pointer => null(). Could you comment on my use of each please?