From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI
	autolearn=unavailable autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,edd7ea1b2d7e9a18
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2003-02-13 04:49:31 PST
Path: 
 archiver1.google.com!news1.google.com!newsfeed.stanford.edu!news-spur1.maxwell.syr.edu!news.maxwell.syr.edu!newsfeed.icl.net!newsfeed.fjserv.net!newsfeed.icl.net!newsfeed.fjserv.net!proxad.net!freenix!enst.fr!not-for-mail
From: "Grein, Christoph" <christoph.grein@eurocopter.com>
Newsgroups: comp.lang.ada
Subject: Re: Pitfall: freeing access discriminants
Date: Thu, 13 Feb 2003 13:41:00 +0100 (MET)
Organization: ENST, France
Message-ID: <mailman.4.1045140569.13246.comp.lang.ada@ada.eu.org>
Reply-To: "Grein, Christoph" <christoph.grein@eurocopter.com>, "comp.lang.ada
	mail to news gateway" <comp.lang.ada@ada.eu.org>
NNTP-Posting-Host: marvin.enst.fr
Mime-Version: 1.0
Content-Type: TEXT/plain; charset=us-ascii
X-Trace: avanie.enst.fr 1045140570 68868 137.194.161.2 (13 Feb 2003 12:49:30
 GMT)
X-Complaints-To: usenet@enst.fr
NNTP-Posting-Date: Thu, 13 Feb 2003 12:49:30 +0000 (UTC)
To: comp.lang.ada@ada.eu.org
Return-Path: <christoph.grein@eurocopter.com>
X-Authentication-Warning: mail.eurocopter.com: uucp set sender to
	<christoph.grein@eurocopter.com> using -f
Content-MD5: 1bPUm5T26021qFyc4hJSCg==
X-Mailer: dtmail 1.2.1 CDE Version 1.2.1 SunOS 5.6 sun4u sparc 
X-BeenThere: comp.lang.ada@ada.eu.org
X-Mailman-Version: 2.1
Precedence: list
List-Id: comp.lang.ada mail to news gateway <comp.lang.ada.ada.eu.org>
List-Unsubscribe: <http://ada.eu.org/mailman/listinfo/comp.lang.ada>,
	<mailto:comp.lang.ada-request@ada.eu.org?subject=unsubscribe>
List-Post: <mailto:comp.lang.ada@ada.eu.org>
List-Help: <mailto:comp.lang.ada-request@ada.eu.org?subject=help>
List-Subscribe: <http://ada.eu.org/mailman/listinfo/comp.lang.ada>,
	<mailto:comp.lang.ada-request@ada.eu.org?subject=subscribe>
Xref: archiver1.google.com comp.lang.ada:34048
Date: 2003-02-13T13:41:00+01:00

This works, but you have to be careful with the allocation pools.
Also access discriminants can never be null, so if you deallocate the object it 
is accessing, ...

Ok, here you are safe since you finalize the whole object.

with Ada.Finalization;

package Acc_Dis is

  type T (D: access Integer) is
    new Ada.Finalization.Limited_Controlled with null record;

  procedure Finalize (Object: in out T);

  V: T (new Integer'(5));

end Acc_Dis;
with Ada.Unchecked_Deallocation;

package body Acc_Dis is

  procedure Finalize (Object: in out T) is
    type Integer_Ptr is access all Integer;
    procedure Free is new Ada.Unchecked_Deallocation (Integer, Integer_Ptr);
    P: Integer_Ptr := Integer_Ptr (Object.D);
  begin
    Free (P);
  end Finalize;

end Acc_Dis;
-----------------------
Also this works:

with Ada.Finalization;

package Acc_Dis is

  type Integer_Ptr is access Integer;

  type T (D: Integer_Ptr) is
    new Ada.Finalization.[Limited_]Controlled with null record;
  -- An access subtype discriminate does not afford a limited type.

  procedure Finalize (Object: in out T);

  V: T (new Integer'(5));

end Acc_Dis;
with Ada.Unchecked_Deallocation;

package body Acc_Dis is

  procedure Free is new Ada.Unchecked_Deallocation (Integer, Integer_Ptr);

  procedure Finalize (Object: in out T) is
    P: Integer_Ptr := Object.D;
  begin
    Free (P);
  end Finalize;

end Acc_Dis;