Delegates: Difference between revisions

Content added Content deleted

Inline

@@ Line 402: / Line 402: @@
    a.delegate = Delegate()
    assert a.operation() == 'delegate implementation'</lang>
+=={{header|Tcl}}==
+{{works with|Tcl|8.6}}
+{{works with|Tcl|8.5}}and the [http://wiki.tcl.tk/TclOO TclOO package]
+Uses [[Assertions#Tcl]]
+<lang tcl>package require Tcl 8.6
+oo::class create Delegate {
+    method thing {} {
+        return "delegate impl."
+    }
+    export thing
+}
+oo::class create Delegator {
+    constructor args {
+        my delegate {*}$args
+    }
+    method delegate args {
+        my variable delegate
+        if {[llength $args] == 0} {
+            if {[info exists delegate]} {
+                return $delegate
+            }
+        } else {
+            set delegate [lindex $args 0]
+        }
+    }
+    method operation {} {
+        my variable delegate
+        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"</lang>
+To code the <code>operation</code> method without relying on catching an exception, but strictly by using introspection:
+<lang tcl>    method operation {} {
+        my variable delegate
+        if { [info exists delegate] &&
+             [info object isa object $delegate] &&
+             "thing" in [info object methods $delegate -all]
+        } {
+            set result [$delegate thing]
+        } else {
+            set result "default implementation"
+        }
+    }
+</lang>