Re: Memory leak - What the ...?

[Stephen Leake <stephen_leake@acm.org>]

mosteo@gmail.com (Alex R. Mosteo) writes:

> Stephen Leake <stephen_leake@acm.org> wrote in message news:<mailman.270.1097458825.390.comp.lang.ada@ada-france.org>...
> > mosteo@gmail.com (Alex R. Mosteo) writes:
> > 
> > > Hi, 
> > > 
> > > as the topic says, this post is about some code which leaks. I'm now
> > > sure of having trapped the leak, but I don't understand where is my
> > > error.
> > 
> > Please post a complete compilable example, so I can run it with gnat 5.02a1.
> 
> Here's the example. Gnatmem shows that it leaks heavily. So I must
> have understood something really wrong about controlled types. I need
> to get this right.

Hmm. This inspired me to try GNAT.Debug_Pools. Here's the instrumented
code:

with Ada.Finalization;
with Ada.Streams;
with GNAT.Debug_Pools;
package Test_Aux is

   type Stream_Element_Array_Access is access Ada.Streams.Stream_Element_Array;
   Pool : GNAT.Debug_Pools.Debug_Pool;
   for Stream_Element_Array_Access'Storage_Pool use Pool;

   type Udp_Message is new Ada.Finalization.Controlled with record
      Data : Stream_Element_Array_Access;
   end record;

   function Create (Data : in Ada.Streams.Stream_Element_Array) return Udp_Message;

   procedure Adjust   (This : in out Udp_Message);
   procedure Finalize (This : in out Udp_Message);

end Test_Aux;
with Ada.Unchecked_Deallocation;
package body Test_Aux is

   function Create (Data : in Ada.Streams.Stream_Element_Array) return Udp_Message
   is
      Msg : Udp_Message :=
        (Ada.Finalization.Controlled with
           Data => new Ada.Streams.Stream_Element_Array'(Data));
   begin
      return Msg;
   end Create;

   procedure Adjust   (This : in out Udp_Message) is
   begin
      if This.Data /= null then
         This.Data := new Ada.Streams.Stream_Element_Array'(This.Data.all);
      end if;
   end Adjust;

   procedure Finalize (This : in out Udp_Message) is
      procedure Free is new Ada.Unchecked_Deallocation
        (Ada.Streams.Stream_Element_Array, Stream_Element_Array_Access);
   begin
      Free (This.Data);
   end Finalize;

end Test_Aux;
with Ada.Exceptions;
with Ada.Streams; use Ada.Streams;
with Ada.Text_IO; use Ada.Text_IO;
with Test_Aux; use Test_Aux;
with GNAT.Debug_Pools;
procedure Test is
   procedure Pool_Info is new GNAT.Debug_Pools.Print_Info (Put_Line);

   Empty : Udp_Message;
   Arr   : array (1 .. 1000) of Udp_Message;
begin
   Put_Line ("Adding...");
   for I in Arr'Range loop
      Arr (I) := Create ((1 .. Stream_Element_Offset (I) => Stream_Element'First));
   end loop;

   Put_Line ("Deleting...");
   for I in Arr'Range loop
      Arr (I) := Empty;
   end loop;

   Pool_Info (Pool);
exception
when E: others =>
   Put_Line ("Exception: " & Ada.Exceptions.Exception_Information (E));
end test;

Compiling with GNAT 5.02a1 and running, we get:

gnatmake -k -g -O0 -gnatf -gnato -gnatwa -gnatwe -gnatwL -gnatVa -I..  test -largs   -bargs -E -cargs 
gcc -c -I./ -g -O0 -gnatf -gnato -gnatwa -gnatwe -gnatwL -gnatVa -I.. -I- ..\test.adb
gcc -c -I./ -g -O0 -gnatf -gnato -gnatwa -gnatwe -gnatwL -gnatVa -I.. -I- ..\test_aux.adb
gnatbind -aO./ -I.. -E -I- -x test.ali
gnatlink test.ali -g
./test.exe 
Adding...
Deleting...
Total allocated bytes :  1530000
Total logically deallocated bytes :  1530000
Total physically deallocated bytes :  0
Current Water Mark:  0
High Water Mark:  511008

Which seems to indicate no leak.

I don't see anything obviously wrong with the code.

There may be a bug with this in GNAT 3.15p on your OS.

Try adding Text_IO.Put_Line in each call, and trace one object's
lifetime; that often makes things clear.

-- 
-- Stephe