rxada_0.1.1_dd9da799/src/body/rx-tools-lazies.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
with Ada.Unchecked_Deallocation;

package body Rx.Tools.Lazies is

   procedure Free is new Ada.Unchecked_Deallocation (Content, Ptr);

   ---------
   -- Get --
   ---------

   function Get (This : in out Lazy) return Ptr is
      X : Ptr;
   begin
      This.Safe.Get (X);
      return X;
   end Get;

   ----------
   -- Safe --
   ----------

   protected body Safes is

      ---------
      -- Get --
      ---------

      procedure Get (X : in out Ptr) is
      begin
         if Instance /= null then
            X := Instance;
         else
            Instance := new Content;
            X     := Instance;
         end if;
      end Get;

      ----------
      -- Free --
      ----------

      procedure Free is
      begin
         Free (Instance);
      end Free;

   end Safes;

   --------------
   -- Finalize --
   --------------

   overriding procedure Finalize (This : in out Lazy) is
   begin
      This.Safe.Free;
   end Finalize;

end Rx.Tools.Lazies;