Print

---

Hello,

We have encountered a memory leak problem in the piece of code included
hereafter, and have no efficient idea to solve it. We work on SUN/SOLARIS 2.6
with SUN Workshop Compiler V4.2. The code presented hereafter is producing two
memory leaks that seem to find their origin in the deallocation process of the
DEALLOCATE intrinsic function.

Lets define a pointer towards a derived type that contains fields that are
themselves pointer towards derived types or arrays. When the deallocate
function is used on that kind of derived type, the fields that are pointers
are not deallocated so that a memory leak occurs. This problem could be solved
by creating a new deallocation routine adaptde to each kind of derived that
produces such problems.

Unfortunately, this occurs in some more sneaky situations such as in the
second memory leak where the memory leak occurs after the reassignment of
structure "elab". The code is probably deallocating the previous one
implicitly creating the same behavior as the one highlighted in the 1st memory
leak example.

Does someone can help, telling if the analysis we made is correct and if there
is a solution to prevent memory leaks of that type ?

Maybe a solution could be to define an overload of "DEALLOCATE" intrinsic
function which is specific to each defined derived type. We tried that
solution but the overload was compiled but was not taken into account when
needed at the execution, because the intrinsic version prevailed.
What do you think of that solution ?

Thank you in advance for your collaboration.

Jean-Jacques Wasbauer

-----------------------------------------------------------------------------------

program prg_fuite
use fuite
implicit none

type(elementaire)::element
type(elementaire),pointer::pt_element

type(elabore)::elab
real(kind=8),pointer,dimension(:)::tab
integer,pointer,dimension(:)::itab
real(kind=8)::x,cx




allocate(tab(2))
tab(1) = 2._8
tab(2) = -12._8

allocate(itab(2))
itab(1) = 3
itab(2) = -9

!=========================
! 1st memory leak example
allocate(pt_element)
pt_element=affecter_elementaire(x=1._8,i=2,c="w",tab=tab,itab=itab)

! Memory leak occurence
deallocate(pt_element)


!=========================
! 2nd memory leak
element=affecter_elementaire(x=1._8,i=2,c="w",tab=tab,itab=itab)
elab=affecter_elabore(type=12,element=element)

! Memory leak occurence
elab=affecter_elabore(type=12,element=affecter_elementaire(x=1._8,i=2,c="w",tab=tab))




end program prg_fuite

-----------------------------------------------------------------------------------

module fuite
implicit none

  type elementaire
     real(kind=8)::x
     integer::i
     character(len=10)::c
     real(kind=8),dimension(:),pointer::tab
     integer,dimension(:),pointer::itab
  end type elementaire


  type elabore
     integer::type
     type(elementaire),pointer::el
  end type elabore

  interface assignment (=)
     module procedure egaler_elementaire,egaler_elabore
  end interface

CONTAINS


  function affecter_elementaire(x,i,c,tab,itab) result (el)

    real(kind=8),intent(in),optional::x
    integer,intent(in),optional::i
    character(len=*),intent(in),optional::c
    real(kind=8),optional,pointer,dimension(:)::tab
    integer,optional,pointer,dimension(:)::itab
    type(elementaire)::el


    if ( present(x)) then
       el%x = x
    end if

    if ( present(i)) then
       el%i = i
    end if

    if ( present(c)) then
       el%c = trim(c)
    end if

    if (associated(el%tab)) then
       deallocate(el%tab)
    end if
    if ( present(tab)) then
       if ( associated(tab)) then
          allocate(el%tab(size(tab)))
          el%tab(:) = tab(:)
       end if
    end if
    if (associated(el%itab)) then
       deallocate(el%itab)
    end if
    if ( present(itab)) then
       if ( associated(itab)) then
          allocate(el%itab(size(itab)))
          el%itab(:) = itab(:)
       end if
    end if
  end function affecter_elementaire


  function affecter_elabore(type,element) result (el)
    integer,intent(in),optional::type
    type(elementaire),intent(in),optional::element
    type(elabore)::el

    if ( present(type)) then
       el%type = type
    end if

    if ( associated(el%el)) then
       deallocate(el%el)
    end if
    if ( present(element)) then
       allocate(el%el)
       el%el = element
    end if

  end function affecter_elabore



  subroutine egaler_elementaire(elb,ela)
    type(elementaire),intent(out)::elb
    type(elementaire),intent(in)::ela

    elb%x=ela%x

    elb%i = ela%i

    elb%c=ela%c

    if ( associated(elb%tab)) then
       deallocate(elb%tab)
    end if
    if ( associated(ela%tab)) then
       allocate(elb%tab(size(ela%tab)))
       elb%tab(:) = ela%tab(:)
    end if
    if ( associated(elb%itab)) then
       deallocate(elb%itab)
    end if
    if ( associated(ela%itab)) then
       allocate(elb%itab(size(ela%itab)))
       elb%itab(:) = ela%itab(:)
    end if
  end subroutine egaler_elementaire


  subroutine egaler_elabore(elb,ela)
    type(elabore),intent(out)::elb
    type(elabore),intent(in)::ela

    elb%type=ela%type

    if ( associated(elb%el)) then
       deallocate(elb%el)
    end if

    if ( associated(ela%el)) then
       allocate(elb%el)
       elb%el=ela%el
    end if
  end subroutine egaler_elabore
end module fuite
---------------------------------------------------------------------------------