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;

Task/Delegates/CoffeeScript/delegates-1.coffee

@@ -0,0 +1,24 @@
+class Delegator
+  operation: ->
+    if @delegate and typeof (@delegate.thing) is "function"
+      return @delegate.thing()
+    "default implementation"
+
+class Delegate
+  thing: ->
+    "Delegate Implementation"
+
+testDelegator = ->
+  # Delegator with no delegate.
+  a = new Delegator()
+  console.log a.operation()
+
+  # Delegator with delegate not implementing "thing"
+  a.delegate = "A delegate may be any object"
+  console.log a.operation()
+
+  # Delegator with delegate that does implement "thing"
+  a.delegate = new Delegate()
+  console.log a.operation()
+
+testDelegator()

Task/Delegates/Perl/delegates-1.pl

@@ -0,0 +1,38 @@
+use strict;
+
+package Delegator;
+sub new {
+   bless {}
+}
+sub operation {
+   my ($self) = @_;
+   if (defined $self->{delegate} && $self->{delegate}->can('thing')) {
+      $self->{delegate}->thing;
+   } else {
+      'default implementation';
+   }
+}
+1;
+
+package Delegate;
+sub new {
+   bless {};
+}
+sub thing {
+   'delegate implementation'
+}
+1;
+
+
+package main;
+# No delegate
+my $a = Delegator->new;
+$a->operation eq 'default implementation' or die;
+
+# With a delegate that does not implement "thing"
+$a->{delegate} = 'A delegate may be any object';
+$a->operation eq 'default implementation' or die;
+
+# With delegate that implements "thing"
+$a->{delegate} = Delegate->new;
+$a->operation eq 'delegate implementation' or die;

Task/Delegates/Ruby/delegates-1.rb

@@ -0,0 +1,31 @@
+class Delegator
+   attr_accessor :delegate
+   def operation
+      if @delegate.respond_to?(:thing)
+         @delegate.thing
+      else
+         'default implementation'
+      end
+   end
+end
+
+class Delegate
+   def thing
+      'delegate implementation'
+   end
+end
+
+if __FILE__ == $PROGRAM_NAME
+
+   # No delegate
+   a = Delegator.new
+   puts a.operation # prints "default implementation"
+
+   # With a delegate that does not implement "thing"
+   a.delegate = 'A delegate may be any object'
+   puts a.operation # prints "default implementation"
+
+   # With delegate that implements "thing"
+   a.delegate = Delegate.new
+   puts a.operation # prints "delegate implementation"
+end

Task/Delegates/Tcl/delegates-1.tcl

@@ -0,0 +1,53 @@
+package require TclOO
+
+oo::class create Delegate {
+    method thing {} {
+        return "delegate impl."
+    }
+    export thing
+}
+
+oo::class create Delegator {
+    variable delegate
+    constructor args {
+        my delegate {*}$args
+    }
+
+    method delegate args {
+        if {[llength $args] == 0} {
+            if {[info exists delegate]} {
+                return $delegate
+            }
+        } elseif {[llength $args] == 1} {
+            set delegate [lindex $args 0]
+        } else {
+            return -code error "wrong # args: should be \"[self] delegate ?target?\""
+        }
+    }
+
+    method operation {} {
+        try {
+            set result [$delegate thing]
+        } on error e {
+            set result "default implementation"
+        }
+        return $result
+    }
+}
+
+# to instantiate a named object, use: class create objname; objname aMethod
+# to have the class name the object:  set obj [class new]; $obj aMethod
+
+Delegator create a
+set b [Delegator new "not a delegate object"]
+set c [Delegator new [Delegate new]]
+
+assert {[a operation] eq "default implementation"}   ;# a "named" object, hence "a ..."
+assert {[$b operation] eq "default implementation"}  ;# an "anonymous" object, hence "$b ..."
+assert {[$c operation] ne "default implementation"}
+
+# now, set a delegate for object a
+a delegate [$c delegate]
+assert {[a operation] ne "default implementation"}
+
+puts "all assertions passed"