agpl_1.0.0_b5da3320/src/agpl-indefinite_protected_value.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
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
 

with Ada.Unchecked_Deallocation;

package body Agpl.Indefinite_Protected_Value is

   procedure Free is
     new Ada.Unchecked_Deallocation (Element_Type, Element_Access);

   -----------
   -- Empty --
   -----------

   function Empty (This : in Object) return Boolean is
   begin
      return This.Internal.Empty;
   end Empty;

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

   function Get (This : in Object) return Element_Type is
   begin
      return This.Internal.Get;
   end Get;

   ---------
   -- Set --
   ---------

   procedure Set (This : in out Object; That : Element_Type) is
   begin
      This.Internal.Set (That);
   end Set;

   -------------
   -- Operate --
   -------------

   procedure Operate (This : in out Object; Using : in out Functor'Class) is
   begin
      This.Internal.Operate (Using);
   end Operate;

   ---------------------
   -- Internal_Object --
   ---------------------

   protected body Internal_Object is

      -----------
      -- Empty --
      -----------

      function Empty return Boolean is
      begin
         return Value = null;
      end Empty;

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

      function Get return Element_Type is
      begin
         return Value.all;
      end Get;

      ---------
      -- Set --
      ---------

      procedure Set (This  : in Element_Type) is
      begin
         Free (Value);
         Value := new Element_Type'(This);
      end Set;

      -------------
      -- Operate --
      -------------

      procedure Operate (Using : in out Functor'Class) is
      begin
         Operate (Using, Value.all);
      end Operate;

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

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

   end Internal_Object;

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

   procedure Finalize (This : in out Object) is
   begin
      This.Internal.Free;
   end Finalize;

end Agpl.Indefinite_Protected_Value;