# -*- Tcl -*- package require nx::test ::nx::configure defaultMethodCallProtection false # # test, whether error message from a submethod contains method path # nx::test case info-errors { ? {::nx::Object info subclasses a b c} \ {invalid argument 'b', maybe too many arguments; should be "::nx::Object info subclasses ?-closure? ?-dependent? ?/pattern/?"} ? {::nx::Object info object mixins a b c} \ {invalid argument 'b', maybe too many arguments; should be "::nx::Object info object mixins ?-guards? ?/pattern/?"} } nx::test configure -count 10 nx::test case submethods { #Object method unknown {} {} Object create o1 ? {o1 foo} "::o1: unable to dispatch method 'foo'" # # test subcmd "tricky" names # - names called on ensemble objects from C (defaultmethod, unknown) # - names equal to helper methods of the ensemble object # Object create o { :object method "string length" x {return [current method]} :object method "string tolower" x {return [current method]} :object method "string info" x {return [current method]} :object method "foo a x" {} {return [current method]} :object method "foo a y" {} {return [current method]} :object method "foo a subcmdName" {} {return [current method]} :object method "foo a defaultmethod" {} {return [current method]} :object method "foo a unknown" args {return [current method]} :object method "foo b" {} {return [current method]} } Class create Foo { :method "bar m1" {a:integer -flag} {;} :method "bar m2" {x:integer -y:boolean} {;} :method "baz a m1" {x:integer -y:boolean} {return m1} :method "baz a m2" {x:integer -y:boolean} {;} :method "baz b" {} {;} } ? {o string length 1} length ? {o string tolower 2} tolower ? {o string toupper 2} \ {unable to dispatch sub-method "toupper" of ::o string; valid are: string info, string length, string tolower} ? {o string} "valid submethods of ::o string: info length tolower" ? {o foo a x} "x" ? {o foo a y} "y" ? {o foo a z} \ {unable to dispatch sub-method "z" of ::o foo a; valid are: foo a defaultmethod, foo a subcmdName, foo a unknown, foo a x, foo a y} ? {o info object method type string} object # the following is a problem, when string has subcmd "info" #? {o::string info class} ::nx::EnsembleObject ? {o string length aaa} "length" ? {o string info class} "info" ? {o string hugo} \ {unable to dispatch sub-method "hugo" of ::o string; valid are: string info, string length, string tolower} Foo create f1 ? {f1 baz a m1 10} m1 ? {f1 baz a m3 10} \ {unable to dispatch sub-method "m3" of ::f1 baz a; valid are: baz a m1, baz a m2} #unable to dispatch method baz a m3; valid subcommands of a: m1 m2} # nx::test configure -count 1 nx::test case defaultmethod { Object create o { :object method "string length" x {return [current method]} :object method "string tolower" x {return [current method]} :object method "string info" x {return [current method]} :object method "foo a x" {} {return [current method]} :object method "foo a y" {} {return [current method]} :object method "foo a subcmdName" {} {return [current method]} :object method "foo a defaultmethod" {} {return [current method]} :object method "foo a unknown" args {return [current method]} :object method "foo b" {} {return [current method]} } Class create Foo { :method "bar m1" {a:integer -flag} {;} :method "bar m2" {x:integer -y:boolean} {;} :method "baz a m1" {x:integer -y:boolean} {return m1} :method "baz a m2" {x:integer -y:boolean} {;} :method "baz b" {} {;} :create f1 } ? {o string} "valid submethods of ::o string: info length tolower" ? {o foo} "valid submethods of ::o foo: a b" ? {f1 bar} "valid submethods of ::f1 bar: m1 m2" ? {f1 baz} "valid submethods of ::f1 baz: a b" ? {f1 baz a} "valid submethods of ::f1 baz a: m1 m2" } # # testing ensemble objects with next # nx::test configure -count 1 nx::test case ensemble-next { nx::Class create FOO { # reduced ensemble :method foo args {lappend :v "FOO.foo//[nx::current method] ([nx::current args])"} # expanded ensemble :method "l1 l2 l3a" {x} { lappend :v "FOO.l1 l2 l3a//[nx::current method] ([nx::current args])" } :method "l1 l2 l3b" {x} { lappend :v "FOO.l1 l2 l3b//[nx::current method] ([nx::current args])" } # uplevel :method "bar x" {varname} {upvar $varname v; return [info exists v]} :method "baz" {} { set hugo 1 return [:bar x hugo] } } nx::Class create M0 { :method "foo b x" {x} { lappend :v "M0.foo b x//[nx::current method] ([nx::current args])" nx::next } :method "foo b y" {x} { lappend :v "M0.foo b y//[nx::current method] ([nx::current args])" nx::next } :method "foo a" {x} { lappend :v "M0.foo a//[nx::current method] ([nx::current args])" nx::next } :method "l1 l2" {args} { lappend :v "l1 l2//[nx::current method] ([nx::current args])" nx::next } } nx::Class create M1 { :method "foo a" {x} { set :v [list "M1.foo a //[nx::current method] ([nx::current args])"] nx::next } :method "foo b x" {x} { set :v [list "M1.foo b x //[nx::current method] ([nx::current args])"] nx::next } :method "foo b y" {x} { set :v [list "M1.foo b y //[nx::current method] ([nx::current args])"] nx::next } :method "l1 l2 l3a" {x} { set :v [list "M1.l1 l2 l3a//[nx::current method] ([nx::current args])"] nx::next } :method "l1 l2 l3b" {x} { set :v [list "M1.l1 l2 l3b//[nx::current method] ([nx::current args])"] nx::next } } FOO mixins set {M1 M0} FOO create f1 # # The last list element shows handling of less deep ensembles # (longer arg list is passed) # ? {f1 foo a 1} "{M1.foo a //a (1)} {M0.foo a//a (1)} {FOO.foo//foo (a 1)}" ? {f1 foo b x 1} "{M1.foo b x //x (1)} {M0.foo b x//x (1)} {FOO.foo//foo (b x 1)}" ? {f1 foo b y 1} "{M1.foo b y //y (1)} {M0.foo b y//y (1)} {FOO.foo//foo (b y 1)}" # # The middle list element shows shrinking (less deep ensembles), the # last element shows expansion via mixin (deeper ensemble is reached # via next) # ? {f1 l1 l2 l3a 100} "{M1.l1 l2 l3a//l3a (100)} {l1 l2//l2 (l3a 100)} {FOO.l1 l2 l3a//l3a (100)}" } nx::test case ensemble-partial-next { nx::Class create M { :public method "info has namespace" {} { nx::next return sometimes } :public method "info has something else" {} { return something } :public method "info has something path" {} { return [::nsf::current methodpath] } :public method "info has something better" {} { nx::next return better } :public method foo {} { return [::nsf::current methodpath] } } nx::Object mixins add M nx::Object create o1 # call a submethod defined by a mixin, which does a next ? {o1 info has namespace} sometimes # call a submethod, which is not defined by the mixin ? {o1 info has type Object} 1 ? {o1 info has type M} 0 # call a submethod, which is nowhere defined ? {o1 info has typo M} \ {unable to dispatch sub-method "typo" of ::o1 info has; valid are: info has mixin, info has namespace, info has something better, info has something else, info has something path, info has type} # call a submethod, which is only defined in the mixin ? {o1 info has something else} something # call a submethod, which is only defined in the mixin, and which # does a next (which should not complain) ? {o1 info has something better} better # ensemble path excluding "wrong" is mixed in ? {o1 info has something wrong} \ {unable to dispatch sub-method "wrong" of ::o1 info has something; valid are: info has something better, info has something else, info has something path} # call defaultcmds on ensembles ? {lsort [o1 info has something]} "valid submethods of ::o1 info has something: better else path" # defaultcmd has to return also subcmds of other shadowed ensembles ? {lsort [o1 info has]} "valid submethods of ::o1 info has: mixin namespace something type" ? {lsort [o1 info]} \ "valid submethods of ::o1 info: baseclass children class has info lookup name object parent precedence variable vars" # returning methodpath in ensemble ? {o1 info has something path} "info has something path" # returning methodpath outside ensemble ? {o1 foo} "foo" } # # Check behavior of upvars in ensemble methods # nx::test case ensemble-upvar { nx::Class create FOO { :method "bar0 x" {varname} {upvar $varname v; return [info exists v]} :method "baz0" {} { set hugo 1 return [:bar0 x hugo] } :method "bar1 x" {varname} {:upvar $varname v; return [info exists v]} :method "baz1" {} { set hugo 1 return [:bar1 x hugo] } :create f1 } ? {f1 baz0} 0 ? {f1 baz1} 1 } # # Check behavior of next with arguments within an ensemble # nx::test case ensemble-next-with-args { nx::Object create o { :object method foo {x} {return $x} :object method "e1 sm" {x} {return $x} :object method "e2 sm1 sm2" {x} {return $x} :object method "e2 e2 e2" {x} {return $x} :object method "e1 e1 e1" args {return $args} } nx::Class create M { :method foo {} {next 1} :method "e1 sm" {} {next 2} :method "e2 sm1 sm2" {} {next 3} :method "e2 e2 e2" {} {next 4} :method "e1 e1 e1" args {next {e1 e1 e1}} } o object mixins add M # case without ensemble ? {o foo} 1 # ensemble depth 1, 1 arg ? {o e1 sm} 2 # ensemble depth 2, 1 arg ? {o e2 sm1 sm2} 3 # ensemble depth 2, 1 arg, same tcl-objs ? {o e2 e2 e2} 4 # ensemble depth 2, multiple args, same tcl-objs ? {o e1 e1 e1} {e1 e1 e1} } nx::test configure -count 1 nx::test case ensemble-next-with-colon-prefix namespace eval ::ns1 { nx::Object create obj { :public object method foo {} { return [:info class] } :public object method ifoo {} { [current] ::nsf::methods::object::info::lookupmethod info} } ? {obj info class} ::nx::Object ? {obj info lookup method info} ::nsf::classes::nx::Object::info ? {obj ifoo} ::nsf::classes::nx::Object::info ? {obj foo} ::nx::Object set infolookup ::nsf::methods::object::info::lookupmethod set infomethod ::nsf::methods::object::info::method ? [list obj $infolookup info] ::nsf::classes::nx::Object::info ? [list obj $infomethod type ::nsf::classes::nx::Object::info] alias obj object method info {} {;} ? [list obj $infolookup info] ::ns1::obj::info ? [list obj $infomethod type ::ns1::obj::info] scripted ? {obj ifoo} ::ns1::obj::info ? {obj foo} {wrong # args: should be ":info"} # Now we try to overwrite the object specific method with an object # named "info" ? {nx::Object create obj::info} "refuse to overwrite cmd ::ns1::obj::info; delete/rename it before overwriting" rename obj::info "" ? {nx::Object create obj::info} ::ns1::obj::info ? [list obj $infolookup info] ::ns1::obj::info ? [list obj $infomethod type ::ns1::obj::info] object ? {obj ifoo} ::ns1::obj::info # To some surprise, we can can still call info class! # This works, since we do here an "ensemble-next" #? {obj info class} ::nx::Object ? {obj info class} {::ns1::obj::info: unable to dispatch method 'class'} # The ensemble-next has in case of foo the leading colon on the # callstack (e.g. ":info"). Make sure that we can still call the # method via ensemle-next. #? {obj foo} ::nx::Object ? {obj foo} {::ns1::obj::info: unable to dispatch method 'class'} } # # Leaf next: Do not trigger unknown handling (see also # NextSearchAndInvoke()) # nx::test case leaf-next-in-submethods { nx::Object create container { set :x 0 :public object method "FOO bar" {} { incr :x; next; # a "leaf next" } :public object method intercept args { incr :x; next; # a "filter next" } :object filters set intercept :FOO bar # Rationale: A call count > 2 would indicate that the leaf next # triggers a further call into filter ... ? [list set _ ${:x}] 2 } } nx::test case object-unknown { # # object level ensemble # nx::Object create o1 { :object method "i o a" {} {return a} :object method "i o b" {} {return b} } ? {o1 i o x} {unable to dispatch sub-method "x" of ::o1 i o; valid are: i o a, i o b} # # object level ensemble on class # nx::Class create C { :public object alias "i o a" ::nsf::methods::class::info::heritage :public object alias "i o b" ::nsf::methods::class::info::heritage } ? {C i o x} {unable to dispatch sub-method "x" of ::C i o; valid are: i o a, i o b} ? {C i o x y} {unable to dispatch sub-method "x" of ::C i o; valid are: i o a, i o b} # # Emulate the "info" and "info object" ensembles on nx::Object and nx::Class # nx::Object public method "i o a" {} {return a} nx::Object public alias "i o b" ::nsf::methods::class::info::heritage nx::Class public alias "i a" ::nsf::methods::class::info::heritage nx::Class public alias "i b" ::nsf::methods::class::info::heritage nx::Class create D {} ? {D i p} {unable to dispatch sub-method "p" of ::D i; valid are: i a, i b, i o a, i o b} ? {D i o a} a ? {D i o x} {unable to dispatch sub-method "x" of ::D i o; valid are: i o a, i o b} ? {D i o x y} {unable to dispatch sub-method "x" of ::D i o; valid are: i o a, i o b} ::nsf::method::delete nx::Class i ::nsf::method::delete nx::Object i } nx::test case unknown-in-info { nx::Class create C catch {C info x y z} err ? [list string match {unable to dispatch sub-method "x" of ::C info; valid are:*} $err] 1 #C info object x y z catch {C info object x y z} err ? [list string match {unable to dispatch sub-method "x" of ::C info object; valid are:*} $err] 1; ## --> unable to dispatch sub-method "object" of ::C info; valid are: } nx::test case submethods-and-filters { # # submethods as filters? # #set h [C public method "BAR bar" args { # next #}] #C filter {{BAR bar}} } nx::test case submethods-current-introspection { # # [current] & [current class] # nx::Object create o o public object method "FOO foo" {} { return "-[current]-[current class]-" } ? {o FOO foo} -::o-- Class create C C public method "FOO foo" {} { return "-[current]-[current class]-" } C create c ? {c FOO foo} -::c-::C- C mixins set [Class create M1 { :public method "FOO foo" {} { return "-[current]-[current class][next]" } }] ? {c FOO foo} -::c-::M1-::c-::C- o object mixins set ::M1 ? {o FOO foo} -::o-::M1-::o-- o object mixins set {} C mixins set {} # # limit [current methodpath] to collect only ensemble methods? # o eval { :public object method faz {} {return [current methodpath]} ? [list set _ [:faz]] "faz" } # # [current callingmethod] & [current callingclass] # o eval { set body {expr {[:bar] eq "[current class]-[current]-[current methodpath]"}} :public object method "FOO foo" {} $body :public object method "BAR BUU boo" {} $body :public object method baz {} $body set calleeBody {return "[current callingclass]-[current callingobject]-[current callingmethod]"} :public object method bar {} $calleeBody } ? {o FOO foo} 1 "instance method ensemble 1" ? {o BAR BUU boo} 1 "instance method ensemble 2" ? {o baz} 1 "instance method" o eval { set calleeBody {return "[current callingclass]-[current callingobject]-[current callingmethod]"} :object method "a b" {} $calleeBody set body {expr {[:a b] eq "[current class]-[current]-[current methodpath]"}} :public object method "FOO foo" {} $body :public object method "BAR BUU boo" {} $body :public object method baz {} $body } ? {o FOO foo} 1 "object method ensemble 1" ? {o BAR BUU boo} 1 "object method ensemble 2" ? {o baz} 1 "object method" o eval { # TODO: :method "a b c" {} $calleeBody; FAILS -> "can't append to scripted" set calleeBody {return "[current callingclass]-[current callingobject]-[current callingmethod]"} :object method "x y z" {} $calleeBody; set body {expr {[:x y z] eq "[current class]-[current]-[current methodpath]"}} :public object method "FOO foo" {} $body :public object method "BAR BUU boo" {} $body :public object method baz {} $body } ? {o FOO foo} 1 "class level object method ensemble 1" ? {o BAR BUU boo} 1 "class level object method ensemble 2" ? {o baz} 1 "class level object method" # # Make sure that [current callingclass] works for submethods, as # expected # C eval { set body {expr {[:bar] eq "[current class]-[current]-[current methodpath]"}} :public method "FOO foo" {} $body :public method "BAR BUU boo" {} $body :public method baz {} $body :method bar {} { return "[current callingclass]-[current callingobject]-[current callingmethod]" } } set c [C new] ? [list $c FOO foo] 1 ? [list $c BAR BUU boo] 1 ? [list $c baz] 1 # # [current calledmethod] # [current calledclass] # # Note: In my reading, [current calledmethod] cannot be made aware # of the methodpath of a submethod call being intercepted. This is # due to the callstack structure at the time of executing the filter # stack which is entirely agnostic of the submethod dispatch (this # dispatch has not occurred yet). For the same reason, we cannot # record the method path in the filter stack structure. # # From the filter method's perspective, the submethod selectors # ("foo" and "BUU boo" below) are simply arguments provided to the # top-level method. They can only be processed as part of the # filter-local argv. Class create Z { :object property msg :method intercept args { [current class] eval [list set :msg [list [lrange [current methodpath] 1 end-1] \ [current calledmethod] \ [current calledclass] \ [current nextmethod]]] next } } set c [Z new] Z filters set intercept foreach selector [list "FOO foo" "BAR BUU boo" "baz"] { Z public method $selector {} {;} set root [lindex $selector 0] set mh [Z info method registrationhandle $root] $c {*}$selector ? [list set _ [join [Z cget -msg] -]] -$root-::Z-$mh } Z filters set {} } # # Test current args in ensemble methods # nx::test case current-args { nx::Class create C { :method foo {{-x 1} z:optional} {return [current args]} :method "bar foo" {{-x 1} z:optional} {return [current args]} :create c1 } ? {c1 foo} "" ? {c1 bar foo} "" ? {c1 foo -x 2} "-x 2" ? {c1 bar foo -x 2} "-x 2" } # # Test keepcallerself and perobjectdispatch with their respective # interactions for plain object dispatch and for object dispatch via # method interface # nx::test case per-object-dispatch { nx::Class create C { :public method foo {} {return foo-[self]} :public method baz {} {return [c1::1 baz]} :create c1 { :public object method bar {} {return bar-[self]} } } ? {c1 foo} "foo-::c1" ? {c1 bar} "bar-::c1" C create c1::1 { :public object method bar {} {return bar-[self]} :public object method baz {} {return baz-[self]} } # # Just the same as above # ? {c1::1 foo} "foo-::c1::1" ? {c1::1 bar} "bar-::c1::1" # if we specify anything special, then we have per-default # - keepcallerself false # - perobjectdispatch false ? {c1 1 foo} "foo-::c1::1" ? {c1 1 bar} "bar-::c1::1" ? {c1 baz} "baz-::c1::1" # just make setting explicit ::nsf::object::property ::c1::1 keepcallerself off ::nsf::object::property ::c1::1 perobjectdispatch off ? {c1 1 foo} "foo-::c1::1" ? {c1 1 bar} "bar-::c1::1" ? {c1 baz} "baz-::c1::1" # keepcallerself off - the self in the called method is the invoked object # perobjectdispatch on - the instance method is not callable ::nsf::object::property ::c1::1 keepcallerself off ::nsf::object::property ::c1::1 perobjectdispatch on ? {c1 1 foo} {::c1::1: unable to dispatch method 'foo'} ? {c1 1 bar} "bar-::c1::1" ? {c1 baz} "baz-::c1::1" # keepcallerself on - the self in the called method is the caller # perobjectdispatch on - the instance method is not callable ::nsf::object::property ::c1::1 keepcallerself on ::nsf::object::property ::c1::1 perobjectdispatch on ? {c1 1 foo} {::c1::1: unable to dispatch method 'foo'} ? {c1 1 bar} "bar-::c1" #### ignore keepcallerself via interface with explicit receiver intentionally ? {c1 baz} "baz-::c1::1" # keepcallerself on - the self in the called method is the caller # perobjectdispatch off - the instance method is callable ::nsf::object::property ::c1::1 keepcallerself on ::nsf::object::property ::c1::1 perobjectdispatch off ? {c1 1 foo} "foo-::c1" ? {c1 1 bar} "bar-::c1" #### ignore keepcallerself via interface with explicit receiver intentionally ? {c1 baz} "baz-::c1::1" } # # Test forwarding to child object, with respect to settings of the # object properties keepcallerself and allowmethoddispatch # nx::test configure -count 1000 nx::test case child-obj-delegation { nx::Object create obj { nx::Object create [self]::child { :public object method foo {} {return [self]} } :public object forward link1 {%[self]::child} :public object forward link2 :child :public object method link3 args {[self]::child {*}$args} :public object alias link4 [self]::child :public object forward link5 [self]::child } # # Default case # keepcallerself false # perobjectdispatch false # ::nsf::object::property obj::child keepcallerself false ::nsf::object::property obj::child perobjectdispatch false ? {obj link1 foo} {::obj::child} #? {obj link2 foo} {::obj: unable to dispatch method 'child'} ? {obj link2 foo} {::obj::child} ? {obj link3 foo} {::obj::child} ? {obj link4 foo} {::obj::child} ? {obj link5 foo} {::obj::child} ? {obj child foo} {::obj::child} #? {lsort [obj info object methods child]} {} #? {lsort [obj info object methods]} {link1 link2 link3 link4 link5} #? {lsort [obj info lookup methods child]} {} #? {lsort [obj info lookup methods child*]} {} ? {lsort [obj info object methods child]} {child} ? {lsort [obj info object methods]} {child link1 link2 link3 link4 link5} ? {lsort [obj info lookup methods child]} {child} ? {lsort [obj info lookup methods child*]} {child} # # turn on keepcallerself and perobjectdispatch # ::nsf::object::property obj::child keepcallerself true ::nsf::object::property obj::child perobjectdispatch true ? {obj link1 foo} {::obj::child} #? {obj link2 foo} {::obj: unable to dispatch method 'child'} ? {obj link2 foo} {::obj} ? {obj link3 foo} {::obj::child} ? {obj link4 foo} {::obj} ? {obj link5 foo} {::obj::child} ? {obj child foo} {::obj} #? {lsort [obj info object methods child]} {} #? {lsort [obj info object methods]} {link1 link2 link3 link4 link5} #? {lsort [obj info lookup methods child]} {} #? {lsort [obj info lookup methods child*]} {} ? {lsort [obj info object methods child]} {child} ? {lsort [obj info object methods]} {child link1 link2 link3 link4 link5} ? {lsort [obj info lookup methods child]} {child} ? {lsort [obj info lookup methods child*]} {child} # # just perobjectdispatch # ::nsf::object::property obj::child keepcallerself false ::nsf::object::property obj::child perobjectdispatch true ? {obj link1 foo} {::obj::child} ? {obj link2 foo} {::obj::child} ? {obj link3 foo} {::obj::child} ? {obj link4 foo} {::obj::child} ? {obj link5 foo} {::obj::child} ? {obj child foo} {::obj::child} ? {lsort [obj info object methods child]} {child} ? {lsort [obj info object methods]} {child link1 link2 link3 link4 link5} ? {lsort [obj info lookup methods child]} {child} ? {lsort [obj info lookup methods child*]} {child} # # just keepcallerself # ::nsf::object::property obj::child keepcallerself true ::nsf::object::property obj::child perobjectdispatch false ? {obj link1 foo} {::obj::child} #? {obj link2 foo} {::obj: unable to dispatch method 'foo'} ? {obj link2 foo} {::obj} ? {obj link3 foo} {::obj::child} #? {obj link4 foo} {::obj: unable to dispatch method 'foo'} ? {obj link4 foo} {::obj} ? {obj link5 foo} {::obj::child} #? {obj child foo} {::obj: unable to dispatch method 'foo'} ? {obj child foo} {::obj} ? {lsort [obj info object methods child]} {child} ? {lsort [obj info object methods]} {child link1 link2 link3 link4 link5} ? {lsort [obj info lookup methods child]} {child} ? {lsort [obj info lookup methods child*]} {child} } # # Examplify the current behavior of "keepcallerself" with and without # the setting of "perobjectdispatch" # nx::test configure -count 1 nx::test case keepcallerself { nx::Class create C {:public method foo {} {return C-[self]}} nx::Class create D {:public method foo {} {return D-[self]}} C create c1 { ::nsf::object::property [self] keepcallerself true :public object method bar {} {return c1-[self]} :public object method baz {} {return c1-[self]} } D create d1 { :public object method bar {} {return d1-[self]} :public object alias c1 ::c1 } # The normal dispatch ignores the keepcallerself completely ? {c1 bar} c1-::c1 ? {c1 foo} C-::c1 ? {c1 baz} c1-::c1 # The dispatch via object aliased method calls actually "d1 bar", # although c1 is in the dispatch path #? {d1 c1 bar} d1-::d1 #? {d1 c1 foo} D-::d1 #? {d1 c1 baz} "::d1: unable to dispatch method 'baz'" ? {d1 c1 bar} c1-::d1 ? {d1 c1 foo} C-::d1 ? {d1 c1 baz} c1-::d1 # The destroy destroys actually d1, not c1, although destroy is # dispatched originally on c1 ? {d1 c1 destroy} "" ? {nsf::object::exists d1} 0 ? {nsf::object::exists c1} 1 # So, keepcallerself is currently pretty useless, unless used in # combination with "perobjectdispatch", which we set in the # following test cases C create c1 { ::nsf::object::property [self] keepcallerself true ::nsf::object::property [self] perobjectdispatch true :public object method bar {} {return c1-[self]} :public object method baz {} {return c1-[self]} } D create d1 { :public object method bar {} {return d1-[self]} :public object alias c1 ::c1 } # The normal dispatch ignores the keepcallerself and # perobjectdispatch completely ? {c1 bar} c1-::c1 ? {c1 foo} C-::c1 ? {c1 baz} c1-::c1 # The dispatch via object aliased method calls actually "d1 bar", # although c1 is in the dispatch path ? {d1 c1 bar} c1-::d1 ? {d1 c1 foo} "::c1: unable to dispatch method 'foo'" ? {d1 c1 baz} c1-::d1 } nx::test case ensemble-vs-simple-method { ? {nx::Class create C} ::C ? {C public method foo {args} {return foo/1}} "::nsf::classes::C::foo" ? {C public method "foo x" {args} {return foo/2}} \ {refuse to overwrite method foo; delete/rename method first.} ? {C public method "foo x y" {args} {return foo/3}} \ {refuse to overwrite method foo; delete/rename method first.} ? {C public method "bar x" {args} {return bar/2}} {::C::slot::__bar::x} ? {C public method "bar x y" {args} {return foo/3}} \ {refuse to overwrite cmd ::C::slot::__bar::x; delete/rename it before overwriting} C create c1 ? {c1 foo x y z} "foo/1" ? {c1 bar x y z} "bar/2" ? {nx::Object create o1} ::o1 ? {o1 public object method foo {args} {return foo/1}} "::o1::foo" ? {o1 public object method "foo x" {args} {return foo/2}} \ {refuse to overwrite object method foo; delete/rename object method first.} ? {o1 public object method "foo x y" {args} {return foo/3}} \ {refuse to overwrite object method foo; delete/rename object method first.} ? {o1 public object method "bar x" {args} {return bar/2}} {::o1::bar::x} ? {o1 public object method "bar x y" {args} {return foo/3}} \ {refuse to overwrite cmd ::o1::bar::x; delete/rename it before overwriting} ? {o1 foo x y z} "foo/1" ? {o1 bar x y z} "bar/2" } nx::test case ensemble-next-vs-colon-dispatch { nx::Class create A { :method "x s" args { next return [current class] } } nx::Class create B -superclasses A { :public method "x s" args { return [list [current class] {*}[next]] } :create b } set sc "::B ::A" ? {b eval { :x s }} $sc ? {b eval { : x s }} $sc ? {b x s} $sc } nx::test case ensemble-callstack-introspection { set ::body { return [list [current nextmethod] [current isnextcall] {*}[next]] } nx::Class create A { set ::handle [:method "i s" args $::body] :create a } nx::Class create B -superclasses A { :public method "i s" args $::body :create b } ? {b eval { :i s }} {{::nsf::classes::A::i s} 0 {} 1} ? {::nsf::cmd::info args [lindex [b eval { :i s }] 0]} "args" ? {::nsf::cmd::info definitionhandle [lindex [b eval { :i s }] 0]} $::handle ? {::nsf::cmd::info body [lindex [b eval { :i s }] 0]} $::body ? {b i s} {{::nsf::classes::A::i s} 0 {} 1}; ? {::nsf::cmd::info args [lindex [b i s] 0]} "args" ? {::nsf::cmd::info definitionhandle [lindex [b i s] 0]} $::handle ? {::nsf::cmd::info body [lindex [b i s] 0]} $::body ? {a eval { :i s }} {{} 0} ? {a i s} {{} 0} unset -nocomplain ::handle unset -nocomplain ::body } ::nx::configure defaultMethodCallProtection true nx::test case ensemble-forwards { set C [nx::Class new { set handle [:forward "foo 1" join %method ""] ? [list info commands $handle] $handle set handle [:public forward "foo 2" join %method ""] ? [list info commands $handle] $handle set handle [:protected forward "foo 3" join %method ""] ? [list info commands $handle] $handle set handle [:private forward "foo 4" join %method ""] ? [list info commands $handle] $handle set handle [:object forward "foo 5" join %method ""] ? [list info commands $handle] $handle set handle [:public object forward "foo 6" join %method ""] ? [list info commands $handle] $handle set handle [:protected object forward "foo 7" join %method ""] ? [list info commands $handle] $handle set handle [:private object forward "foo 8" join %method ""] ? [list info commands $handle] $handle }] ? [list $C foo 6] "6" ? [list $C foo 5] "unable to dispatch sub-method \"5\" of $C foo; valid are: foo 6" ? [list $C eval {:foo 5}] "5" ? [list $C foo 7] "unable to dispatch sub-method \"7\" of $C foo; valid are: foo 6" ? [list $C eval {:foo 7}] "7" ? [list $C foo 8] "unable to dispatch sub-method \"8\" of $C foo; valid are: foo 6" ? [list $C eval {:foo 8}] "unable to dispatch sub-method \"8\" of $C foo; valid are: foo 6"; ? [list $C eval {: -local foo 8}] "8"; set c [$C new] ? [list $c foo 2] "2" ? [list $c foo 1] "unable to dispatch sub-method \"1\" of $c foo; valid are: foo 2" ? [list $c eval {:foo 1}] "1" ? [list $c foo 3] "unable to dispatch sub-method \"3\" of $c foo; valid are: foo 2" ? [list $c eval {:foo 3}] "3" ? [list $c foo 4] "unable to dispatch sub-method \"4\" of $c foo; valid are: foo 2" ? [list $c eval {:foo 4}] "unable to dispatch sub-method \"4\" of $c foo; valid are: foo 2"; ? [list $c eval {: -local foo 4}] "4"; } nx::test case ensemble-private-helper { nx::Class create B { :public method "bar 1" {} {return [list B.bar.1 {*}[next]]} :public method "baz 1" {} {return [list B.baz.1 {*}[next]]} :create b1 { :public object method foo {} {: -local bar 1} :public object method foo2 {} {:bar 1} :private object method "bar 1" {} {: -local baz 1} :private object method "baz 1" {} {return [list "b1.baz.1" {*}[next]]} } } nx::Class create C -superclass B { :public method "bar 1" {} {return [list C.bar.1 {*}[next]]} :public method "baz 1" {} {return [list C.baz.1 {*}[next]]} :create c1 { :public object method foo {} {: -local bar 1} :public object method foo2 {} {:bar 1} :private object method "bar 1" {} {: -local baz 1} :private object method "baz 1" {} {return [list "c1.baz.1" {*}[next]]} } } ? {b1 bar 1} "B.bar.1" ? {b1 baz 1} "B.baz.1" ? {b1 foo} "b1.baz.1 B.baz.1" ? {b1 foo2} "B.bar.1" ? {c1 bar 1} "C.bar.1 B.bar.1" ? {c1 baz 1} "C.baz.1 B.baz.1" ? {c1 foo} "c1.baz.1 C.baz.1 B.baz.1" ? {c1 foo2} "C.bar.1 B.bar.1" } nx::test case ensemble-private-local-checks { nx::Class create B { :public method "bar 1" {} {return [list B.bar.1 {*}[next]]} :public method "bar 2" {} {return [list B.bar.2 {*}[next]]} :public method FOO1 {} {: -local bar 1} :public method FOO2 {} {:bar 1} :public method "FOO3 FAR FIM" {} {: -local bar 1} :create b1 { :public object method foo {} {: -local bar 1} :public object method faa {} {: -local noop 2} :public object method fee1 {} {: -local bar 2} :public object method fee2 {} {: -local bar 3} :private object method "bar 1" {} {: -local baz 1} :private object method "baz 1" {} {return "b1.baz.1"} } } nx::Class create C -superclass B { :public method "bar 1" {} {return [list C.bar.1 {*}[next]]} :public method "baz 1" {} {return [list C.baz.1 {*}[next]]} :create c1 { :public object method foo {} {: -local bar 1} :public object method faa {} {: -local noop 2} :public object method fee1 {} {: -local bar 2} :public object method fee2 {} {: -local bar 3} :private object method "bar 1" {} {: -local baz 1} :private object method "baz 1" {} {return "c1.baz.1"} } } ? {b1 faa} "::b1: unable to dispatch method 'noop'" ? {b1 foo} "b1.baz.1" ? {b1 fee1} "B.bar.2" ? {b1 fee2} "unable to dispatch sub-method \"3\" of ::b1 bar; valid are: bar 1, bar 2" ? {b1 FOO1} "B.bar.1" ? {b1 FOO2} "B.bar.1" ? {b1 FOO3 FAR FIM} "B.bar.1" ? {c1 faa} "::c1: unable to dispatch method 'noop'" ? {c1 foo} "c1.baz.1" ? {c1 fee1} "B.bar.2" ? {c1 fee2} "unable to dispatch sub-method \"3\" of ::c1 bar; valid are: bar 1, bar 2" ? {c1 FOO1} "B.bar.1" ? {c1 FOO2} "C.bar.1 B.bar.1" ? {c1 FOO3 FAR FIM} "B.bar.1" } # # Local variables: # mode: tcl # tcl-indent-level: 2 # indent-tabs-mode: nil # End: