Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
Announcements
Welcome to the Intel Community. If you get an answer you like, please mark it as an Accepted Solution to help others. Thank you!
26750 Discussions

The reuse pointer derived type causes free(): double free error (simple application of linkedlists)

silva__gabriel
Beginner
159 Views

Hello!

I'm trying to reuse a linked list. The module used to construct the linked list is this: https://jblevins.org/research/generic-list.pdf

module linkedlist
  implicit none

  private

  public :: list_t
  public :: list_data
  public :: list_init
  public :: list_free
  public :: list_remove
  public :: list_insert
  public :: list_put
  public :: list_get
  public :: list_next
  public :: list_change
  
  ! A public variable to use as a MOLD for transfer()
  integer, dimension(:), allocatable :: list_data

  ! Linked list node data type
  type :: list_t
     private
     integer, dimension(:), pointer :: data => null()
     type(list_t), pointer :: next => null()
  end type list_t

contains

  ! Initialize a head node SELF and optionally store the provided DATA.
  subroutine list_init(self, data)
    type(list_t), pointer :: self
    integer, dimension(:), intent(in), optional :: data

    allocate(self)
    nullify(self%next)

    if (present(data)) then
       allocate(self%data(size(data)))
       self%data = data
    else
       nullify(self%data)
    end if
  end subroutine list_init

  ! Free the entire list and all data, beginning at SELF
  subroutine list_free(self)
    type(list_t), pointer :: self
    type(list_t), pointer :: current
    type(list_t), pointer :: next

    current => self
    do while (associated(current))
       next => current%next
       if (associated(current%data)) then
          deallocate(current%data)
          nullify(current%data)
       end if
       deallocate(current)
       nullify(current)
       current => next
    end do

  end subroutine list_free
  
    ! Remove element AFTER SELF
  subroutine list_remove(self)
    type(list_t), pointer :: self
    type(list_t), pointer :: current
    type(list_t), pointer :: next

    current => self
    next => current%next
    current%next = next%next
  end subroutine list_remove


  ! Return the next node after SELF
  function list_next(self) result(next)
    type(list_t), pointer :: self
    type(list_t), pointer :: next
    next => self%next
  end function list_next

  ! Insert a list node after SELF containing DATA (optional)
  subroutine list_insert(self, data)
    type(list_t), pointer :: self
    integer, dimension(:), intent(in), optional :: data
    type(list_t), pointer :: next

    allocate(next)
    
    if (present(data)) then
       allocate(next%data(size(data)))
       next%data = data
    else
       nullify(next%data)
    end if
    
    next%next => self%next
    self%next => next
    
  end subroutine list_insert
  
! Change the NEXT node after a element CURRENT to after anOTHER (in other list for example).  
  subroutine list_change(current,other)
    type(list_t), pointer :: current
    type(list_t), pointer :: next
    type(list_t), pointer :: other
    
    next => current%next
    if (associated(next%next)) then
        current%next =>  next%next
    else 
        current%next => null()
    end if
    next%next => other%next
    other%next => next
    
    
  end subroutine list_change

  ! Store the encoded DATA in list node SELF
  subroutine list_put(self, data)
    type(list_t), pointer :: self
    integer, dimension(:), intent(in) :: data

    if (associated(self%data)) then
       deallocate(self%data)
       nullify(self%data)
    end if
    self%data = data
  end subroutine list_put

  ! Return the DATA stored in the node SELF
  function list_get(self) result(data)
    type(list_t), pointer :: self
    integer, dimension(:), pointer :: data
    data => self%data
  end function list_get
  
!   function list_isnull(self) result(a)
!     type(list_t), pointer :: self = .false.
!     logical :: a
!     if 
    
    
end module linkedlist

The main program is

! A derived type for storing data.
module data
  implicit none

  private
  public :: data_t
  public :: data_ptr

  ! Data is stored in data_t
  type :: data_t
     real :: x
  end type data_t

  ! A trick to allow us to store pointers in the list
  type :: data_ptr
     type(data_t), pointer :: p
  end type data_ptr
end module data

! A simple generic linked list test program
program list_test
  use linkedlist
  use data
  implicit none

  type(list_t), pointer :: ll => null(), node
  type(data_t), target :: dat_a
  type(data_t), target :: dat_b
  type(data_ptr) :: ptr

!    integer, pointer :: p1
!    integer, target :: t1, t2
!    
!    p1=>t1
!    p1 = 1
!    
!    Print *, p1
!    Print *, t1
!    print*, "A"
!    
!    deallocate(p1)
!    
!    print*, "B"
!    
!    t2 = 2
!    p1 => t2
!    print*, p1
!    
!    
!    deallocate(p1)
!    
!    print*, "C"
   
  
  
  ! Initialize two data objects
  dat_a%x = 17.5
  dat_b%x = 3.0

  ! Initialize the list with dat_a
  ptr%p => dat_a
  call list_init(ll, DATA=transfer(ptr, list_data))
  print *, 'Initializing list with data:', ptr%p

  ! Insert dat_b into the list
  ptr%p => dat_b
  call list_insert(ll, DATA=transfer(ptr, list_data))
  print *, 'Inserting node with data:', ptr%p

  ! Get the head node
  ptr = transfer(list_get(ll), ptr)
  print *, 'Head node data:', ptr%p

  ! Get the next node
  ptr = transfer(list_get(list_next(ll)), ptr)
  print *, 'Second node data:', ptr%p



  print*, associated(node)
  node => list_next(ll)
  ! Free the list starting on the secound node (after ll)
  call list_free(node)
  node => list_next(ll)
  print*, associated(node) ! It prints True, but it should be false since I deallocated the next node
  ! Initialize the list with dat_a
  ptr%p => dat_a
  call list_insert(ll, DATA=transfer(ptr, list_data))
  print *, 'Initializing list with data:', ptr%p

  ! Insert dat_b into the list
  ptr%p => dat_b
  call list_insert(ll, DATA=transfer(ptr, list_data))
  print *, 'Inserting node with data:', ptr%p

  ! Get the head node
  ptr = transfer(list_get(ll), ptr)
  print *, 'Head node data:', ptr%p

  ! Get the next node
  ptr = transfer(list_get(list_next(ll)), ptr)
  print *, 'Second node data:', ptr%p

  
  ! try to free it again
  node => list_next(ll)
  print*, associated(node), "capivara"
  call list_free(node) !The code breaks with double free here
  print*, "lalala"
  print*, associated(node)
  
end program list_test

When I try to free the list a second time, it crashes and I get double free error. For some reason, even after I deallocate the first time, if I test it, I get that the node still associated. But if I try to require the data that the node stores it  crashes.

 

 

0 Kudos
1 Solution
Juergen_R_R
Valued Contributor I
159 Views

Checked a bit closer: list_data has really never been allocated. No wonder that you cannot transfer it. Next programming error:

print*, associated(node)

Node has never been associated before. So the program stops with a runtime error.

View solution in original post

4 Replies
Juergen_R_R
Valued Contributor I
159 Views

This is for sure a programming error:

Runtime Error: main.f90, line 62: ALLOCATABLE LIST_DATA is not currently allocated

 

Juergen_R_R
Valued Contributor I
160 Views

Checked a bit closer: list_data has really never been allocated. No wonder that you cannot transfer it. Next programming error:

print*, associated(node)

Node has never been associated before. So the program stops with a runtime error.

View solution in original post

silva__gabriel
Beginner
159 Views

>Checked a bit closer: list_data has really never been allocated.

I don't know why it had to be allocated. It is just the mold of the transfer function.

 

jimdempseyatthecove
Black Belt
159 Views

>>I don't know why it had to be allocated. It is just the mold of the transfer function

list_data is an (unallocated) array. The mold requires the shape of this array. I suppose for some peculiar reason you might wish to have transfer to construct an unallocated array out of the input arg, but I suspect this was not your intention.

Also, I didn't review your code in depth. But on the surface, it appears that you are attempting to use transfer to convert a data_ptr object into an integer array object. This doesn't make sense. Did you intend to convert ptr%p (the scalar real) into an integer array?

Jim Dempsey

Reply