# -*- Tcl -*- package require nx package require nx::test nx::test configure -count 1 nx::test case call-protected { nx::Class create C { :public alias SET ::set :public method foo {} {return [current method]} :public method bar {} {return [current method]} :public method bar-foo {} { c1 foo } :public method bar-SET {} { c1 SET x 1 } } C create c1 C create c2 ? {c1 SET x 1} {1} ? {c1 foo} {foo} ? {c1 bar-SET} {1} ? {c1 bar-foo} {foo} ::nsf::method::property C SET call-protected true ? {c1 SET x 1} {::c1: unable to dispatch method 'SET'} ? {nx::dispatch c1 SET x 2} {2} "dispatch of protected methods works" ? {c1 foo} {foo} ? {c1 bar} {bar} ? {c1 bar-SET} {1} ? {c1 bar-foo} {foo} ? {c2 bar-SET} {::c1: unable to dispatch method 'SET'} ? {c2 bar-foo} {foo} ::nsf::method::property C foo call-protected true ? {c1 SET x 1} {::c1: unable to dispatch method 'SET'} ? {nx::dispatch c1 SET x 2} {2} "dispatch of protected methods works" ? {c1 bar} {bar} "other method work" ? {c1 foo} {::c1: unable to dispatch method 'foo'} ? {c1 bar-SET} {1} "internal call of protected C implementend method" ? {c1 bar-foo} {foo} "internal call of protected Tcl implemented method" ? {c2 bar-SET} {::c1: unable to dispatch method 'SET'} ? {c2 bar-foo} {::c1: unable to dispatch method 'foo'} # unset call protected ? {::nsf::method::property C SET call-protected} 1 ::nsf::method::property C SET call-protected false ? {::nsf::method::property C SET call-protected} 0 ? {::nsf::method::property C foo call-protected} 1 ::nsf::method::property C foo call-protected false ? {::nsf::method::property C foo call-protected} 0 ? {c1 SET x 3} 3 ? {nx::dispatch c1 SET x 2} {2} ? {c1 foo} {foo} ? {c1 bar} {bar} ? {c1 bar-SET} {1} ? {c1 bar-foo} {foo} ? {c2 bar-SET} 1 ? {c2 bar-foo} {foo} # define a protected method C protected method foo {} {return [current method]} ? {::nsf::method::property C SET call-protected} 0 ? {c1 SET x 3} 3 ? {nx::dispatch c1 SET x 4} {4} ? {c1 foo} {::c1: unable to dispatch method 'foo'} ? {c1 bar} {bar} ? {c1 bar-SET} {1} ? {c1 bar-foo} foo ? {c2 bar-SET} 1 ? {c2 bar-foo} {::c1: unable to dispatch method 'foo'} } # # Check protection + filter # # Allow to call methods as filters even if these are protected or # private. # nx::test case protected+filter { nx::Class create C { :method f1 args { next } :private method f2 args { next } :public method foo {} { return foo} } C create c1 ? {c1 foo} foo # add a protected filter c1 object filter add f1 ? {c1 foo} foo # add a private filter c1 object filter add f2 ? {c1 foo} foo } nx::test case redefined-protected { nx::Class create C { :public alias SET ::set :public method foo {} {return [current method]} } # # Define SET and foo as redefined-protected # ? {::nsf::method::property C SET redefine-protected true} 1 ? {::nsf::method::property C foo redefine-protected true} 1 ? {C method SET {a b c} {...}} \ {refuse to overwrite protected method 'SET'; derive e.g. a sub-class!} \ "redefine method SET" ? {C method foo {a b c} {...}} \ {refuse to overwrite protected method 'foo'; derive e.g. a sub-class!} \ "redefine method foo" # check a predefined protection ? {::nx::Class method create {a b c} {...}} \ {refuse to overwrite protected method 'create'; derive e.g. a sub-class!} \ "redefine method create" # try to redefine predefined protected method via alias ? {::nsf::method::alias nx::Class create ::set} \ {refuse to overwrite protected method 'create'; derive e.g. a sub-class!} \ "redefine alias create" # try to redefine via forward ? {C forward SET ::set} \ {refuse to overwrite protected method 'SET'; derive e.g. a sub-class!} \ "redefine forward SET" # try to redefine via setter ? {C property -accessor public SET} \ {refuse to overwrite protected method 'SET'; derive e.g. a sub-class!} \ "redefine property SET" # redefine-protect object specific method nx::Object create o o object method foo {} {return 13} ::nsf::method::property o foo redefine-protected true ? {o object method foo {} {return 14}} \ {refuse to overwrite protected method 'foo'; derive e.g. a sub-class!} } # # Use case for private: # Hide "helper methods of e.g. mixin" # nx::test case private-helper { nx::Class create B { :public method bar {} {return "B.bar [next]"} :public method baz {} {return "B.baz [next]"} :create b1 { :public object method baz {} {return "b1.baz [next]"} } } nx::Class create C -superclass B { :public method bar {} {return "C.bar [next]"} :public method baz {} {return "C.baz [next]"} :create c1 { :public object method baz {} {return "c1.baz [next]"} } } # Behavior without mixin with private methods ? {b1 bar} "B.bar " ? {b1 baz} "b1.baz B.baz " ? {c1 bar} "C.bar B.bar " ? {c1 baz} "c1.baz C.baz B.baz " # # Define a mixin with helper methods "bar" and "baz". The helper # methods are defined as private to avoid interference. # nx::Class create M { :public method foo {} {: -local bar} :private method bar {} {: -local baz} :private method baz {} {return "M.baz"} } # Behavior with mixin . THe private helper methods are "invisible" # for invocation and next path. B mixin add M ? {b1 bar} "B.bar " ? {b1 baz} "b1.baz B.baz " ? {c1 bar} "C.bar B.bar " ? {c1 baz} "c1.baz C.baz B.baz " ? {b1 foo} "M.baz" ? {c1 foo} "M.baz" } # # Use case for private: # Hide "helper object specific helper methods" # nx::test case object-private-helper { nx::Class create B { :public method bar {} {return "B.bar [next]"} :public method baz {} {return "B.baz [next]"} :create b1 { :public object method foo {} {: -local bar} :private object method bar {} {: -local baz} :private object method baz {} {return "b1.baz"} } } nx::Class create C -superclass B { :public method bar {} {return "C.bar [next]"} :public method baz {} {return "C.baz [next]"} :create c1 { :public object method foo {} {: -local bar} :private object method bar {} {: -local baz} :private object method baz {} {return "c1.baz"} } } # Behavior of per-object helper methods, which are invisible for # invocation through "bar" and "baz" ? {b1 bar} "B.bar " ? {b1 baz} "B.baz " ? {b1 foo} "b1.baz" ? {c1 bar} "C.bar B.bar " ? {c1 baz} "C.baz B.baz " ? {c1 foo} "c1.baz" # # Define a mixin class which shadows "bar" and "baz". The behavior # of the object-methods with its private methods is not affected. # nx::Class create M { :public method bar {} {return "M.bar [next]"} :public method baz {} {return "M.baz [next]"} } B mixin add M ? {b1 bar} "M.bar B.bar " ? {b1 baz} "M.baz B.baz " ? {b1 foo} "b1.baz" ? {c1 bar} "M.bar C.bar B.bar " ? {c1 baz} "M.baz C.baz B.baz " ? {c1 foo} "c1.baz" } # # Check local + filter # nx::test case local+filter { nx::Class create C { :method f1 args { return "f1 [next]" } :public method foo {} { return "C.foo [: -local bar]"} :private method bar {} { return "bar"} :public method baz {} { return "C.baz [next]"} } nx::Class create D -superclass C { :public method baz {} { return "D.baz [next]"} } D create d1 ? {d1 baz} "D.baz C.baz " ? {d1 foo} "C.foo bar" ? {d1 bar} "::d1: unable to dispatch method 'bar'" # add a filter; be sure that we still can call the private -local # method d1 object filter add f1 ? {d1 baz} "f1 D.baz C.baz " ? {d1 foo} "f1 C.foo f1 bar" ? {d1 bar} "::d1: unable to dispatch method 'bar'" # remove the filter d1 object filter set "" # define call to private method via method handle C public method foo {} { return "C.foo [[self] [C info method registrationhandle bar]]"} # the behavior without filter, should be like above ? {d1 baz} "D.baz C.baz " ? {d1 foo} "C.foo bar" ? {d1 bar} "::d1: unable to dispatch method 'bar'" # add a filter; be sure that we still can call the private method d1 object filter add f1 ? {d1 baz} "f1 D.baz C.baz " ? {d1 foo} "f1 C.foo f1 bar" ? {d1 bar} "::d1: unable to dispatch method 'bar'" } # # test private # nx::test case private { nx::Class create B { :private method p1 {} {return B.p1} :private method p2 {} {return B.p2} :public method p3 {} {return B.p3} :public method p4 {} {return B.p4} :create b1 } nx::Class create C -superclass B { :private method p1 {} {return "C.p1 [next]"} :public method p2 {} {return "C.p2 [next]"} :private method p3 {} {return "C.p3 [next]"} :public method p4 {} {return "C.p4 [next]"} :create c1 } nx::Class create D -superclass C { :public method p1 {} {return "D.p1 [next]"} :public method p2 {} {return "D.p2 [next]"} :public method p3 {} {return "D.p3 [next]"} :public method p4 {} {return "D.p4 [next]"} :create d1 } # check introspection and "-callprotection" filter ? {lsort [C info methods]} "p2 p4" ? {lsort [C info methods -callprotection all]} "p1 p2 p3 p4" ? {lsort [C info methods -callprotection public]} "p2 p4" ? {lsort [C info methods -callprotection protected]} "" ? {lsort [C info methods -callprotection private]} "p1 p3" # called shadowed # C.p1 private B.p1 private # C.p2 public B.p2 private # C.p3 private B.p3 public # C.p4 public B.p4 public ? {c1 p1} "::c1: unable to dispatch method 'p1'" ? {c1 p2} "C.p2 " ? {c1 p3} "B.p3" ? {c1 p4} "C.p4 B.p4" # called shadowed shadowed # D.p1 public C.p1 private B.p1 private # D.p2 public C.p2 public B.p2 private # D.p3 public C.p3 private B.p3 public # D.p4 public C.p4 public B.p4 public ? {d1 p1} "D.p1 " ? {d1 p2} "D.p2 C.p2 " ? {d1 p3} "D.p3 B.p3" ? {d1 p4} "D.p4 C.p4 B.p4" # add on B calls to local C eval { :public method q1 {} {: -local p1} :public method q3 {} {: -local p3} } # all chains start with C, since local resolve works ? {c1 q1} "C.p1 " ? {c1 q3} "C.p3 B.p3" # calls via method handles allows us to dispatch private methods, # results like "-local" resolves above ? {c1 [C info method registrationhandle p1]} "C.p1 " ? {c1 [C info method registrationhandle p3]} "C.p3 B.p3" # calls via method handles allows us to dispatch private methods, # results like "-local" resolves above ? {nx::dispatch c1 [C info method registrationhandle p1]} "C.p1 " ? {nx::dispatch c1 [C info method registrationhandle p3]} "C.p3 B.p3" # we can't call the private method via dispatch, since the private # methods are removed from the search for methods ? {nx::dispatch c1 p1} "::c1: unable to dispatch method 'p1'" ? {nx::dispatch c1 p3} "B.p3" # via dispatch, the local flag uses (as always) the context of the # currently execting class, which is not provided below ? {nx::dispatch c1 -local p1} "::c1: unable to dispatch method 'p1'" } # # test ": -local" on classes # nx::test case class-my-local { nx::Class create Base { :private method baz {a b} { expr {$a + $b} } :public method foo {a b} {: -local baz $a $b} } nx::Class create Sub -superclass Base { :public method bar {a b} {: -local baz $a $b} :private method baz {a b} { expr {$a * $b} } :create s1 } ? {s1 foo 3 4} 7 ? {s1 bar 3 4} 12 ? {s1 baz 3 4} {::s1: unable to dispatch method 'baz'} } # # test ": -local" on objects # nx::test case object-my-local { nx::Class create M { :public method foo {} {return "M [next]"} :public method foo2 {} {return "M2 [next]"} } nx::Object create o1 { :protected object method foo {} {return o1} :public object method foo2 {} {:foo} :public object method bar {} {: -local foo} } ? {o1 foo} {::o1: unable to dispatch method 'foo'} ? {o1 bar} o1 ? {o1 foo2} o1 o1 object mixin add M ? {o1 foo} "M o1" ? {o1 bar} "o1" ? {o1 foo2} "M2 M o1" } # # test "my" + path instead of ": -local" on classes # nx::test case my+handle-instead-of-my-local { nx::Class create Base { :private method privateMethod {a b} { expr {$a + $b} } :public method foo {a b} {: [Base info method registrationhandle privateMethod] $a $b} } nx::Class create Sub -superclass Base { :public method bar {a b} {: [Sub info method registrationhandle privateMethod] $a $b} :private method privateMethod {a b} { expr {$a * $b} } :create s1 } ? {s1 foo 3 4} 7 ? {s1 bar 3 4} 12 } # # test object::dispatch instead of ": -local" on classes # nx::test case dispatch-instead-of-my-local { nx::Class create Base { :private method privateMethod {a b} { expr {$a + $b} } :public method foo {a b} { dispatch [self] [Base info method registrationhandle privateMethod] $a $b } } nx::Class create Sub -superclass Base { :public method bar {a b} { dispatch [self] [Sub info method registrationhandle privateMethod] $a $b } :private method privateMethod {a b} { expr {$a * $b} } :create s1 } ? {s1 foo 3 4} 7 ? {s1 bar 3 4} 12 } # # Test -system flag on dispatch with explicit receiver # nx::test case system-flag { # # create an object, which overloads some system behavior # nx::Object create o1 { :public object method info {} {return "overloads system info"} :public object method destroy {} {return "overloads system destroy"} :public object method "object method" args {return "overloads method 'object method'"} :object variable v 1 } ? {o1 info} "overloads system info" ? {o1 ::nx::Object::slot::__info::vars} "v" ? {o1 [nx::Object info method definitionhandle "info vars"]} "v" #? {o1 -system info vars} "v" ? {nx::dispatch o1 -system info vars} "v" #? {o1 -system} "no method name specified" ? {o1 object method foo {} {return foo}} "overloads method 'object method'" ? {nx::dispatch o1 -system public object method foo {} {return foo}} "::o1::foo" ? {o1 destroy} "overloads system destroy" ? {nsf::object::exists o1} 1 ? {nx::dispatch o1 -system destroy} "" ? {nsf::object::exists o1} 0 # # create a class, which overloads some system behavior # nx::Class create C { :public method info {} {return "overloads system info"} :public method destroy {} {return "overloads system destroy"} :variable v 1 :create c1 } ? {c1 info} "overloads system info" ? {c1 ::nx::Object::slot::__info::vars} "v" ? {c1 [nx::Object info method definitionhandle "info vars"]} "v" #? {c1 -system info vars} "v" ? {nx::dispatch c1 -system info vars} "v" ? {c1 destroy} "overloads system destroy" ? {nsf::object::exists c1} 1 #? {c1 -system destroy} "" ? {nx::dispatch c1 -system destroy} "" ? {nsf::object::exists c1} 0 } # # Check my-local + private + next # # Never call a private method via "next", but allow "next" from # private methods # nx::test case class-my-local+next { nx::Class create Base { :private method baz {a b} { expr {$a + $b} } :protected method baz2 {a b} { expr {$a + $b} } :public method foo {a b} {: -local baz $a $b} :create b1 } # we can call Base.baz only through Base.foo ? {b1 foo 4 5} 9 ? {b1 baz 4 5} {::b1: unable to dispatch method 'baz'} # Define and register a mixin class, where method "foo" is calling a # private method via ": -local" nx::Class create Mix { :private method baz {a b} { expr {$a ** $b} } :public method foo {a b} {: -local baz $a $b} } b1 object mixin add Mix # we can call Mix.baz only through Mix.foo ? {b1 foo 4 5} 1024 ? {b1 baz 4 5} {::b1: unable to dispatch method 'baz'} # # the private method has a next # nx::Class create Intermediate -superclass Base { :private method baz {a b} { next } :private method baz2 {a b} { next } :public method foo {a b} {: -local baz $a $b} :public method foo2 {a b} {: -local baz2 $a $b} :create i1 } # next in the private method reaches a private method, which is ignored ? {i1 foo 4 5} "" ? {i1 baz 4 5} {::i1: unable to dispatch method 'baz'} # next in the private method reaches a non-private method, which is honored ? {i1 foo2 4 5} 9 nx::Class create Sub -superclass Intermediate { :public method bar {a b} {: -local baz $a $b} :private method baz {a b} { expr {$a * $b} } :create s1 } # next in the private method reaches a private method, which is ignored ? {s1 foo 4 5} "" ? {s1 baz 4 5} {::s1: unable to dispatch method 'baz'} # next in the private method reaches a non-private method, which is honored ? {s1 foo2 4 5} 9 ? {s1 bar 4 5} 20 # add per-class mixin Sub mixin add Mix # foo is shadowed in the mixin and calls the mixin-private method ? {s1 foo 4 5} 1024 ? {s1 baz 4 5} {::s1: unable to dispatch method 'baz'} # next in the private method reaches a non-private method, which is honored ? {s1 foo2 4 5} 9 ? {s1 bar 4 5} 20 } # # Test setting / clearing private and protected flags # nx::test case call-protected-flags { Class create C C protected method foo {} {return foo} ? {::nsf::method::property C foo call-protected} 1 ? {::nsf::method::property C foo call-private} 0 ? {C info method definition foo} "::C protected method foo {} {return foo}" C public method foo {} {return foo} ? {::nsf::method::property C foo call-protected} 0 ? {::nsf::method::property C foo call-private} 0 ? {C info method definition foo} "::C public method foo {} {return foo}" C private method foo {} {return foo} ? {::nsf::method::property C foo call-protected} 1 ? {::nsf::method::property C foo call-private} 1 ? {C info method definition foo} "::C private method foo {} {return foo}" ? {::nsf::method::property C foo call-private false} 0 ? {::nsf::method::property C foo call-protected} 1 ? {::nsf::method::property C foo call-private} 0 ? {::nsf::method::property C foo call-private true} 1 ? {::nsf::method::property C foo call-protected} 1 ? {::nsf::method::property C foo call-private} 1 ? {::nsf::method::property C foo call-protected false} 0 ? {::nsf::method::property C foo call-protected} 0 ? {::nsf::method::property C foo call-private} 0 } # # private subobjects # nx::test case private-subobject { nx::Object create obj { :public object method foo {} {return foo-[self]} nx::Object create [self]::child { :public object method bar {} {return bar-[self]} } } ? {obj child bar} "bar-::obj::child" ? {obj foo} "foo-::obj" ? {obj info object methods} "child foo" ? {::nsf::method::property obj foo call-private 1} 1 ? {obj child bar} "bar-::obj::child" ? {obj foo} {::obj: unable to dispatch method 'foo'} ? {obj info object methods} "child" ? {::nsf::method::property obj child call-private 1} 1 ? {obj child bar} {::obj: unable to dispatch method 'child'} ? {obj foo} {::obj: unable to dispatch method 'foo'} ? {obj info object methods} "" ? {::nsf::method::property obj foo call-protected 0} 0 ? {obj child bar} {::obj: unable to dispatch method 'child'} ? {obj foo} "foo-::obj" ? {obj info object methods} "foo" ? {::nsf::method::property obj child call-protected 0} 0 ? {obj child bar} "bar-::obj::child" ? {obj foo} "foo-::obj" ? {obj info object methods} "child foo" } # # Test protected and private object properties # nx::test case protected-priv-class-property { nx::Class create C { :property -accessor public {a a1} :property -accessor protected {b b1} :property -accessor private {c c1} :property -accessor private {d:integer 1} :public method foo {p} {return [: $p get]} :public method bar {p} {return [: -local $p get]} :public method baz {p v} {return [: -local $p set $v]} :create c1 } # call properties directly ? {c1 a get} a1 ? {c1 b get} {::c1: unable to dispatch method 'b'} ? {c1 c get} {::c1: unable to dispatch method 'c'} # call properties via method ? {c1 foo a} a1 ? {c1 foo b} b1 ? {c1 foo c} {::c1: unable to dispatch method 'c'} # call properties via method via "-local" dispatch ? {c1 bar a} a1 ? {c1 bar b} b1 ? {c1 bar c} {c1} ? {lsort [c1 info vars]} "__private a b" ? {c1 eval {lsort [array names :__private]}} "::C,c ::C,d" # Private property with value constraint ? {c1 bar d} {1} ? {c1 baz d 2} {2} ? {c1 bar d} {2} ? {c1 baz d x} {expected integer but got "x" for parameter "value"} # # Define a private property with the same name as the private # property in the superclass; define a public per-object property # with the same name. The call "d1 c" resolves to the per-object # property, the private properties are accessed via methods. # The values of the private properties do not conflict. # nx::Class create D -superclass C { :property -accessor private {c c1d} :public method bard {p} {return [: -local $p get]} :create d1 { :object property -accessor public {c c1o} } } ? {d1 bar c} c1 ? {d1 bard c} c1d ? {d1 c get} c1o # # Define a public property with the same name as the private # property in the superclass; define private per-object property # with the same name. The call "d1 c" resolves to the public # property on D, the private properties are accessed via methods. # The values of the private properties do not conflict. # nx::Class create D -superclass C { :property -accessor public {c c1d} :public method bard {p} {return [: -local $p get]} :create d1 { :object property -accessor private {c c1o} :public object method bard1 {p} {return [: -local $p get]} } } ? {d1 bar c} c1 ? {d1 bard c} c1d ? {d1 bard1 c} c1o ? {d1 c get} c1d } # # Test properties in class hierarchy, where a subclass defines a # private property with the same name as a property in a superclass. # nx::test case private-shadows-public-property { nx::Class create C { :property -accessor public {x c} } nx::Class create D -superclass C { :property -accessor private {x d} :public method bar-d {p} {return [: -local $p get]} } nx::Class create E -superclass D { :property -accessor private {x e} :public method bar-e {p} {return [: -local $p get]} } E create e1 ? {e1 x get} c ? {e1 bar-d x} d ? {e1 bar-e x} e } # # Test protected and private class properties # nx::test case protected-priv-object-property { nx::Object create o { :object property -accessor public {a a1} :object property -accessor protected {b b1} :object property -accessor private {c c1} :object property -accessor private {d:integer 1} :public object method foo {p} {return [: $p get]} :public object method bar {p} {return [: -local $p get]} :public object method baz {p v} {return [: -local $p set $v]} } ? {o a get} a1 ? {o b get} {::o: unable to dispatch method 'b'} ? {o c get} {::o: unable to dispatch method 'c'} ? {o foo a} a1 ? {o foo b} b1 ? {o foo c} {::o: unable to dispatch method 'c'} ? {o bar a} a1 ? {o bar b} b1 ? {o bar c} {c1} #? {lsort [o info vars]} "____C.c ____C.d a b" ? {lsort [o info vars]} "__private a b" ? {o eval {lsort [array names :__private]}} "::o,c ::o,d" ? {o bar d} {1} ? {o baz d 2} {2} ? {o bar d} {2} ? {o baz d x} {expected integer but got "x" for parameter "value"} } # # Test protected and private class object properties # nx::test case protected-priv-class-object-property { nx::Class create C { :object property -accessor public {a a1} :object property -accessor protected {b b1} :object property -accessor private {c c1} :object property -accessor private {d:integer 1} :public object method foo {p} {return [: $p get]} :public object method bar {p} {return [: -local $p get]} :public object method baz {p v} {return [: -local $p set $v]} } ? {C a get} a1 ? {C b get} {method 'b' unknown for ::C; consider '::C create b get' instead of '::C b get'} ? {C c get} {method 'c' unknown for ::C; consider '::C create c get' instead of '::C c get'} ? {C foo a} a1 ? {C foo b} b1 ? {C foo c} {method 'c' unknown for ::C; consider '::C create c get' instead of '::C c get'} ? {C bar a} a1 ? {C bar b} b1 ? {C bar c} {c1} #? {lsort [o info vars]} "____C.c ____C.d a b" ? {lsort [C info vars]} "__private a b" ? {C eval {lsort [array names :__private]}} "::C,c ::C,d" ? {C bar d} {1} ? {C baz d 2} {2} ? {C bar d} {2} ? {C baz d x} {expected integer but got "x" for parameter "value"} ? {C public object property {d:integer 1}} {'property' is not a method defining method} ? {C protected object property {d:integer 1}} {'property' is not a method defining method} ? {C private object property {d:integer 1}} {'property' is not a method defining method} } # # Local variables: # mode: tcl # tcl-indent-level: 2 # indent-tabs-mode: nil # End: