# -*- Tcl -*- package require nx package require nx::test ########################################### # trivial object delegation ########################################### nx::test case delegation { nx::Object create dog nx::Object create tail { :public object method wag args { return $args } :public object method nxwag args { return $args } } dog public object forward wag tail %proc dog public object forward nxwag tail %method ? {dog wag 100} 100 ? {dog nxwag 100} 100 } ########################################### # evaluating in scope ########################################### nx::test case inscope { nx::Class create X { :property {x 1} :public forward Incr -frame object incr } X create x1 -x 100 x1 Incr x x1 Incr x x1 Incr x ? {x1 cget -x} 103 } ########################################### # adding ########################################### nx::test case adding { nx::Object create obj { :public object forward addOne expr 1 + } ? {obj addOne 5} 6 } ########################################### # more arguments ########################################### nx::test case multiple-args { nx::Object create target { :public object method foo args {return $args} } nx::Object create obj { :public object forward foo target %proc %self a1 a2 } ? {obj foo x1 x2} [list ::obj a1 a2 x1 x2] obj public object forward foo target %proc %self %%self %%p ? {obj foo x1 x2} [list ::obj %self %p x1 x2] } ########################################### # mixin example ########################################### nx::test case mixin-via-forward { nx::Object create mixin { :object method unknown {m args} {return [concat [current] $m $args]} } nx::Object create obj { :public object forward Mixin mixin %1 %self } ? {obj Mixin add M1} [list ::mixin add ::obj M1] ? {catch {obj Mixin}} 1 obj public object forward Mixin mixin "%1 {Getter Setter}" %self ? {obj Mixin add M1} [list ::mixin add ::obj M1] ? {obj Mixin M1} [list ::mixin Setter ::obj M1] ? {obj Mixin} [list ::mixin Getter ::obj] } ########################################### # sketching extensibe info ########################################### nx::test case info-via-forward { nx::Object create Info { :public object method @mixin {o} { $o info mixin } :public object method @class {o} { ;# without prefix, doing here a [Info class] wod be wrong $o info class } :public object method @help {o} { ;# define a new subcommand for info foreach c [:info object methods] {lappend result [string range $c 1 end]} return $result } } nx::Object public forward Info -prefix @ Info %1 %self nx::Class create X { :create x1 } ? {x1 Info class} ::X ? {x1 Info help} [list help mixin class] } ########################################### # variations of placement of options ########################################### nx::test case incr { nx::Object create obj { set :x 1 :public object forward i1 -frame object incr x } ? {obj i1} 2 } ########################################### # introspeciton options ########################################### nx::test case introspection { nx::Class create C { :public forward Info -prefix @ Info %1 %self } ? {C info methods -type forwarder} Info C public forward XXXo x ? {lsort [C info methods -type forwarder]} [list Info XXXo] ? {C info methods -type forwarder X*} [list XXXo] ? {lsort [C info methods -type forwarder *o]} [list Info XXXo] # delete the forwarder C method XXXo {} {} ? {C info methods -type forwarder} [list Info] # get the definition of a instforwarder ? {C info method definition Info} [list ::C public forward Info -prefix @ Info %1 %self] # check introspection for objects nx::Object create obj { :public object forward i1 -frame object incr x :public object forward Mixin mixin %1 %self :public object forward foo target %proc %self %%self %%p :public object forward addOne expr 1 + } ? {lsort [obj info object methods -type forwarder]} "Mixin addOne foo i1" ? {obj info object method definition Mixin} "::obj public object forward Mixin mixin %1 %self" ? {obj info object method definition addOne} "::obj public object forward addOne expr 1 +" ? {obj info object method definition foo} "::obj public object forward foo target %proc %self %%self %%p" ? {obj info object method definition i1} "::obj public object forward i1 -frame object ::incr x" } ########################################### # test serializer ########################################### package require nx::serializer nx::test case serializer { nx::Object create obj { :object method test {} {puts "i am [current method]"} } set ::a [Serializer deepSerialize obj] #puts <<$::a>> eval $::a ? {set ::a} [Serializer deepSerialize obj] } ########################################### # test optional target cmd ########################################### nx::test case optional-target { nx::Object create obj { set :x 2 :public object forward append -frame object } ? {obj append x y z} 2yz nx::Object create n; nx::Object create n::x {:public object method current {} {current}} nx::Object create o o public object forward ::n::x ? {o x current} ::n::x } ########################################### # arg including instvar ########################################### nx::test case percent-cmd { nx::Object create obj { set :x 10 :public object forward x* expr {%:eval {set :x}} * } ? {obj x* 10} "100" } ########################################### # positional arguments ########################################### nx::test case positioning-args { nx::Object create obj obj public object forward @end-13 list {%@end 13} ? {obj @end-13 1 2 3 } [list 1 2 3 13] obj public object forward @-1-13 list {%@-1 13} ? {obj @-1-13 1 2 3 } [list 1 2 13 3] obj public object forward @1-13 list {%@1 13} ? {obj @1-13 1 2 3 } [list 13 1 2 3] ? {obj @1-13} [list 13] obj public object forward @2-13 list {%@2 13} ? {obj @2-13 1 2 3 } [list 1 13 2 3] obj public object forward @list 10 {%@0 list} {%@end 99} ? {obj @list} [list 10 99] ? {obj @list a b c} [list 10 a b c 99] obj public object forward @list {%@end 99} {%@0 list} 10 ? {obj @list} [list 10 99] ? {obj @list a b c} [list 10 a b c 99] obj public object forward @list {%@2 2} {%@1 1} {%@0 list} ? {obj @list} [list 1 2] ? {obj @list a b c} [list 1 2 a b c] obj public object forward @list x y z {%@0 list} {%@1 1} {%@2 2} ? {obj @list} [list 1 2 x y z] ? {obj @list a b c} [list 1 2 x y z a b c] obj public object forward @list x y z {%@2 2} {%@1 1} {%@0 list} ? {obj @list} [list x 1 y 2 z] ? {obj @list a b c} [list x 1 y 2 z a b c] # adding some test cases which cover the interactions # between %@POS and %1 substitutions # obj public object forward @end-13 list {%@end 13} %1 %self ? {obj @end-13 1 2 3 } [list 1 ::obj 2 3 13] obj public object forward @end-13 list %1 {%@end 13} %self ? {obj @end-13 1 2 3 } [list 1 ::obj 2 3 13] obj public object forward @end-13 list {%@end 13} %1 %1 %1 %self ? {obj @end-13 1 2 3 } [list 1 1 1 ::obj 2 3 13] obj public object forward @end-13 list {%@-1 13} %1 %self ? {obj @end-13 1 2 3 } [list 1 ::obj 2 13 3] obj public object forward @end-13 list {%@1 13} %1 %self ? {obj @end-13 1 2 3 } [list 13 1 ::obj 2 3] } nx::test case forwarder-basics { nx::Object create obj ## ## Particular role of first forwarder arg: (fully-qualified) target ## & methodName in one (provides shortcut notation) ## ? {obj info object methods foo} "" obj public object forward ::ns1::foo ? {obj info object methods foo} "foo" ? {obj foo X} {invalid command name "::ns1::foo"} namespace eval ::ns1 {proc foo {p} {return $p}} ? {obj foo X} "X" obj public object forward ::ns1::foo %method %method ? {namespace eval ::ns1 { ::obj foo }} "foo" # make sure, old-style arguments don't get moved into argument # delegatee cmd (called target) ? {obj public object forward x1 -methodprefix @ -verbose %self X} \ "target '-methodprefix' must not start with a dash" ? {obj public object forward x2 -prefix @ -verbose %self X} \ "::obj::x2" ? {obj x2 a b c} "::obj: unable to dispatch method '@X'" ## ## argclindex ## obj public object forward foo list {%argclindex {A B C}} ? {obj foo} A ? {obj foo _} "B _" ? {obj foo _ _} "C _ _" ? {obj foo _ _ _ _} "forward: not enough elements in specified list of ARGC argument argclindex {A B C}" ## ## %1 + defaults ## ::nsf::configure debug 2 obj public object method FOO args {return [current method]-$args} obj public object method OOF args {return [current method]-$args} obj public object forward foo -verbose %self %1 ? {obj foo} {%1 requires argument; should be "foo arg ..."} obj public object forward foo -verbose %self {%1 FOO} ? {obj foo} "FOO-" ? {obj foo X} {::obj: unable to dispatch method 'X'} obj public object forward foo -verbose %self {%1 FOO OOF} ? {obj foo X} {::obj: unable to dispatch method 'X'} obj public object forward foo -verbose %self {%1 {FOO OOF}} ? {obj foo X} "OOF-X" ? {obj foo X Y} {::obj: unable to dispatch method 'X'} obj public object forward foo -verbose %self {%1 {FOO OOF}} {%1 {A B}} ? {obj foo} "FOO-A" obj public object forward foo -verbose %self {%1 {FOO OOF}} {%1 {A B}} ? {obj foo X} "OOF-B X" ## ## -prefix; requires a 2nd arg! ## ## obj public object method _FOO args {return [current method]-$args} ## 1) 2nd arg is missing! Prefix is silently neglected ... obj public object forward FOO -prefix _ %self ? {obj FOO} {::obj} # 2) There is a 2nd arg, a method argument ? {obj FOO FOO X} "_FOO-X" "prefix, 2nd arg is method argument" # 3) There is a 2nd arg, a forwarder argument obj public object forward FOO -prefix _ %self %1 ? {obj FOO FOO X} "_FOO-X" "prefix, 2nd arg is forwarder argument" # 4) There is a 2nd arg, a forwarder argument provided through %1 obj public object forward FOO -prefix _ %self {%1 {FOO FOO}} ? {obj FOO X} "_FOO-X" "prefix, 2nd arg is forwarder argument provided through %1" } nx::test case positioning-arg-extended { nx::Object create obj obj public object forward foo list {%@end %self} ? {obj foo 1 2 3} [list 1 2 3 ::obj] obj public object forward foo list {%@end %method} ? {obj foo 1 2 3} [list 1 2 3 foo] obj public object forward foo list {%@end %%} ? {obj foo 1 2 3} [list 1 2 3 %] obj public object forward foo list {%obj foo} ? {obj foo 1 2 3} "too many nested evaluations (infinite loop?)" obj public object forward foo list {%apply {{x} {return $x}} A} ? {obj foo 1 2 3} [list A 1 2 3] ## positioning of "simple" cmd substitution works fine obj public object forward foo list {%@end %obj} ? {obj foo 1 2 3} [list 1 2 3 ::obj] ## lindex allows for omitting the index arg or passing {} as index value ... forward catches both cases nicely: obj public object forward foo list {%@{} %obj} ? {obj foo 1 2 3} "forward: invalid index specified in argument %@{} %obj" obj public object forward foo list {%@ %obj} ? {obj foo 1 2 3} "forward: invalid index specified in argument %@ %obj" ## ## resolving name conflicts between Tcl commands & predefined ## placeholder names -> use fully qualified names ## obj public object forward foo list {%@end %::proc} ? {obj foo 1 2 3} {wrong # args: should be "::proc name args body"} # the next test does not work unless called from nxsh, which imports ::nx::self #obj public object forward foo list {%@end %::self} #? {obj foo 1 2 3} [list 1 2 3 ::obj] obj public object forward foo list {%@end %::nx::self} ? {obj foo 1 2 3} [list 1 2 3 ::obj] "fully qualified self" obj public object forward foo list {%@end %::1} ? {obj foo 1 2 3} {invalid command name "::1"} ## ## position prefixes are interpreted in a context-dependent manner: ## obj public object forward foo list {%@1 %@1} ? {obj foo 1 2 3} {invalid command name "@1"} if {![string length "ISSUES"]} { ## list protection makes this fail obj public object forward foo list {%@end {%argclindex {A B C D}}} ? {obj foo 1 2 3} [list 1 2 3 D] ## positioned "complex" cmd substitution (cmd + args) not working because of list protection obj public object forward foo list {%@end {%list 1}} ? {obj foo 1 2 3} [list 1 2 3 A] ## Why not %1 not working with positioning working? obj public object forward foo list {%@end %1} ? {obj foo 1 2 3} [list 1 2 3 1] ## ## Should this be caught somehow? How would this be treated when list protection would not interfere? ## obj public object forward foo list {%@1 {%@1 "x"}} ? {obj foo 1 2 3} "forward: invalid index specified in argument %@{} %obj" } } ############################################### # substitution depending on number of arguments ############################################### nx::test case num-args { nx::Object create obj { :public object forward f %self [list %argclindex [list a b c]] :object method a args {return [list [current method] $args]} :object method b args {return [list [current method] $args]} :object method c args {return [list [current method] $args]} } ? {obj f} [list a {}] ? {obj f 1 } [list b 1] ? {obj f 1 2} [list c {1 2}] ? {catch {obj f 1 2 3}} 1 } ############################################### # option earlybinding ############################################### nx::test case earlybinding { nx::Object create obj { #:public object forward s -earlybinding ::set ::X :public object forward s ::set ::X } ? {obj s 100} 100 ? {obj s} 100 nx::Object public method f args { next } nx::Class create NS nx::Class create NS::Main { :public object method m1 {} { :m2 } :public object method m2 {} { ? {namespace eval :: {nx::Object create toplevelObj1}} ::toplevelObj1 ? [list set _ [namespace current]] ::NS ? [list set _ [NS create m1]] ::NS::m1 NS filter f ? [list set _ [NS create m2]] ::NS::m2 NS filter "" namespace eval ::test { ? [list set _ [NS create m3]] ::test::m3 NS filter f ? [list set _ [NS create m4]] ::test::m4 NS filter "" } namespace eval test { ? [list set _ [NS create m5]] ::NS::test::m5 NS filter f ? [list set _ [NS create m6]] ::NS::test::m6 NS filter "" } } :public method i1 {} { :i2 } :public method i2 {} { ? {namespace eval :: {nx::Object create toplevelObj2}} ::toplevelObj2 ? [list set _ [namespace current]] ::NS ? [list set _ [NS create i1]] ::NS::i1 NS filter f ? [list set _ [NS create i2]] ::NS::i2 NS filter "" namespace eval ::test { ? [list set _ [NS create i3]] ::test::i3 NS filter f ? [list set _ [NS create i4]] ::test::i4 NS filter "" } namespace eval test { ? [list set _ [NS create i5]] ::NS::test::i5 NS filter f ? [list set _ [NS create i6]] ::NS::test::i6 NS filter "" } } } #puts ==== NS::Main m1 NS::Main create m m i1 #puts ==== ? [list set _ [NS create n1]] ::n1 NS filter f ? [list set _ [NS create n2]] ::n2 NS filter "" #puts ==== namespace eval test { ? [list set _ [NS create n1]] ::test::n1 ? [list set _ [NS create n3]] ::test::n3 NS filter f ? [list set _ [NS create n4]] ::test::n4 NS filter "" } } ########################################### # forward to expr + callstack ########################################### nx::test case callstack { nx::Object public forward expr -frame object nx::Class create C { :method xx {} {current} :public object method t {o expr} { return [$o expr $expr] } } C create c1 ? {c1 expr {[current]}} ::c1 ? {c1 expr {[current] eq "::c1"}} 1 ? {c1 expr {[:xx]}} ::c1 ? {c1 expr {[:info class]}} ::C ? {c1 expr {[:info has type C]}} 1 ? {c1 expr {[:info has type ::C]}} 1 ? {C t ::c1 {[current]}} ::c1 ? {C t ::c1 {[current] eq "::c1"}} 1 ? {C t ::c1 {[:xx]}} ::c1 ? {C t ::c1 {[:info class]}} ::C ? {C t ::c1 {[:info has type C]}} 1 ? {C t ::c1 {[:info has type ::C]}} 1 nx::Object method expr {} {} } # # Local variables: # mode: tcl # tcl-indent-level: 2 # indent-tabs-mode: nil # End: