Re: Memory leak - What the ...?

["Christoph Karl Walter Grein" <AdaMagica@web.de>]

with Ada.Text_Io;
use Ada.Text_Io;

with Ada.Unchecked_Deallocation;

package body Test_Aux is

    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
	Put_Line ("Create" & Stream_Element_Offset'Image (Data'Last));
	return Msg;
    end Create;

    procedure Adjust (This : in out Udp_Message) is
    begin
	if This.Data /= null then
	    Put_Line ("Adjust" & Stream_Element_Offset'Image (This.Data'Last));
	    This.Data := new Stream_Element_Array'(This.Data.all);
	else
	    Put_Line ("Adjust null");
	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
	if This.Data /= null then
	    Put_Line ("Finalize" &
		      Stream_Element_Offset'Image (This.Data'Last));
	else
	    Put_Line ("Finalize null");
	end if;
	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_It is
    Empty : Udp_Message;
    Arr : array (1 .. 2) of Udp_Message;
    -- Initialize is called for Empty and each component of Arr;
    -- does nothing since not overridden.
begin
    Text_Io.Put_Line ("Adding...");
    for I in Arr'Range loop
	Arr (I) := Create ((1 .. Stream_Element_Offset (I) =>
			       Stream_Element'First));
	-- Create 1      => Create an intermediate object Msg in place
	--                  with Data as given.
	--                  Neither Initialize nor Adjust is called.
	-- Adjust 1      => Some internal
	-- Finalize 1    =>               copying of the intermediate object
	-- Finalize null => Finalize (Arr (I)); Left side of assignment
	--                  statement; does nothing since Data = null.
	--                  Copy Msg to Arr (I) - Shallow copy.
	-- Adjust 1      => Adjust (Arr (I)); Make a deep copy from
	--                  This.Data.all (this is the intermediate Msg.Data).
	-- Finalize 1    => Finalize Msg - Destruct the intermediate object,
	--                  i.e. de-allocate Msg.Data.
	-- Create 2
	-- Adjust 2
	-- Finalize 2
	-- Finalize null
	-- Adjust 2
	-- Finalize 2
    end loop;
    -- I cannot see a problem here.

    Text_Io.Put_Line ("Deleting...");
    for I in Arr'Range loop
	Arr (I) := Empty;
	-- Finalize 1    => Finalize (Arr (I)); Left side of assignment
	--                  statement; de-allocates Data.
	--                  Copy Empty to Arr (I)
	-- Adjust null   => Adjust (Arr (I)); does nothing since
	--                  Empty.Data = null.
	-- Finalize 2
	-- Adjust null
    end loop;
    -- Finalize null
    -- Finalize null
    -- Finalize null
    -- Finalize is called for each component of Arr in inverse sequence, then
    -- for Empty.
    -- Does nothing since Data = null always.
    --
    -- I can't see a problem.
exception
    when E: others =>
	Text_Io.Put_Line ("Exception: " & Exceptions.Exception_Information (E));
end Test_It;

__________________________________________________________
Mit WEB.DE FreePhone mit hoechster Qualitaet ab 0 Ct./Min.
weltweit telefonieren! http://freephone.web.de/?mc=021201