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
---------------------------------------------------------------------------------