1--  Copyright 2006-2014 Simon Wright <simon@pushface.org>
2
3--  This package is free software; you can redistribute it and/or
4--  modify it under terms of the GNU General Public License as
5--  published by the Free Software Foundation; either version 2, or
6--  (at your option) any later version. This package is distributed in
7--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
8--  even the implied warranty of MERCHANTABILITY or FITNESS FOR A
9--  PARTICULAR PURPOSE. See the GNU General Public License for more
10--  details. You should have received a copy of the GNU General Public
11--  License distributed with this package; see file COPYING.  If not,
12--  write to the Free Software Foundation, 59 Temple Place - Suite
13--  330, Boston, MA 02111-1307, USA.
14
15--  As a special exception, if other files instantiate generics from
16--  this unit, or you link this unit with other files to produce an
17--  executable, this unit does not by itself cause the resulting
18--  executable to be covered by the GNU General Public License.  This
19--  exception does not however invalidate any other reasons why the
20--  executable file might be covered by the GNU Public License.
21
22with Ada.Unchecked_Deallocation;
23
24package body BC.Support.Auto_Pointers is
25
26
27   function Create (Value : P) return Pointer is
28      Result : Pointer;
29   begin
30      Result.The_Owner.The_Object :=
31        new Object'(The_Owner => Result.The_Owner'Unchecked_Access,
32                    The_P => Value);
33      return Result;
34   end Create;
35
36
37   function Value (Ptr : Pointer) return P is
38   begin
39      if Ptr.The_Owner.The_Object = null then
40         return null;
41      else
42         return Ptr.The_Owner.The_Object.The_P;
43      end if;
44   end Value;
45
46
47   procedure Adjust (Obj : in out Pointer) is
48   begin
49      if Obj.The_Owner.The_Object /= null then
50         declare
51            The_Object : Object_P renames Obj.The_Owner.The_Object;
52            The_Objects_Owner : Owner_P renames The_Object.The_Owner;
53         begin
54            The_Objects_Owner.The_Object := null;
55            The_Objects_Owner := Obj.The_Owner'Unchecked_Access;
56         end;
57      end if;
58   end Adjust;
59
60
61   procedure Delete is new Ada.Unchecked_Deallocation (T, P);
62   procedure Delete is new Ada.Unchecked_Deallocation (Object, Object_P);
63
64   procedure Finalize (Obj : in out Pointer) is
65   begin
66      if Obj.The_Owner.The_Object /= null then
67         Delete (Obj.The_Owner.The_Object.The_P);
68         Delete (Obj.The_Owner.The_Object);
69      end if;
70   end Finalize;
71
72
73end BC.Support.Auto_Pointers;
74