Re: Memory leak - What the ...?

[mosteo@gmail.com (Alex R. Mosteo)]

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.

The example will create 1000 messages and then delete them
overwritting them with an empty value.

I suppose gnatchop will suffice (beware: use ./test and not simply
test):

with Ada.Finalization;
with Ada.Streams; use Ada.Streams;

package Test_Aux is
   
   type Stream_Element_Array_Access is access
      Ada.Streams.Stream_Element_Array;

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

   ------------
   -- Create --
   ------------
   function Create (Data : in 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

   ------------
   -- Create --
   ------------
   function Create (Data : in Stream_Element_Array) return Udp_Message
is
      Msg : Udp_Message := 
         (Ada.Finalization.Controlled with 
          Data => new 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 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 (
         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;
use  Ada;
with Text_IO; use Text_IO;

with Test_Aux; use Test_Aux;

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

   Text_Io.Put_Line ("Deleting...");
   for I in Arr'Range loop
      Arr (I) := Empty;
   end loop;
exception
   when E: others =>
      Text_IO.Put_Line ("Exception: " &
Exceptions.Exception_Information (E));
end test;