lace_0.1.0_347e4627/source/events/concrete/lace-subject_and_deferred_observer.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
with
     ada.unchecked_Deallocation;


package body lace.Subject_and_deferred_Observer
is
   package body Forge
   is
      function to_Subject_and_Observer (Name : in String) return Item
      is
      begin
         return Self : Item
         do
            Self.Name := to_unbounded_String (Name);
         end return;
      end to_Subject_and_Observer;


      function new_Subject_and_Observer (Name : in String) return View
      is
      begin
         return new Item' (to_Subject_and_Observer (Name));
      end new_Subject_and_Observer;

   end Forge;


   overriding
   procedure destroy (Self : in out Item)
   is
   begin
      Deferred.destroy (Deferred.item (Self));   -- Destroy base classes.
      Subject .destroy (Subject .item (Self));
   end destroy;


   procedure free (Self : in out View)
   is
      procedure deallocate is new ada.unchecked_Deallocation (Item'Class, View);
   begin
      Self.destroy;
      deallocate (Self);
   end free;


   overriding
   function Name (Self : in Item) return String
   is
   begin
      return to_String (Self.Name);
   end Name;

end lace.Subject_and_deferred_Observer;