new files

Task/Delegates/Ada/delegates.ada

@@ -0,0 +1,48 @@
+with Ada.Text_IO;  use Ada.Text_IO;
+
+procedure Delegation is
+   package Things is
+      -- We need a common root for our stuff
+      type Object is tagged null record;
+      type Object_Ptr is access all Object'Class;
+
+      -- Objects that have operation thing
+      type Substantial is new Object with null record;
+      function Thing (X : Substantial) return String;
+
+      -- Delegator objects
+      type Delegator is new Object with record
+         Delegate : Object_Ptr;
+      end record;
+      function Operation (X : Delegator) return String;
+
+      No_Thing  : aliased Object;      -- Does not have thing
+      Has_Thing : aliased Substantial; -- Has one
+   end Things;
+
+   package body Things is
+      function Thing (X : Substantial) return String is
+      begin
+         return "delegate implementation";
+      end Thing;
+
+      function Operation (X : Delegator) return String is
+      begin
+         if X.Delegate /= null and then X.Delegate.all in Substantial'Class then
+            return Thing (Substantial'Class (X.Delegate.all));
+         else
+            return "default implementation";
+         end if;
+      end Operation;
+   end Things;
+
+   use Things;
+
+   A : Delegator; -- Without a delegate
+begin
+   Put_Line (A.Operation);
+   A.Delegate := No_Thing'Access; -- Set no thing
+   Put_Line (A.Operation);
+   A.Delegate := Has_Thing'Access; -- Set a thing
+   Put_Line (A.Operation);
+end Delegation;