# -*- Tcl -*- package require nx package require nx::test nx::test configure -count 10 nx::test case method-require { # # A few method-provides # # Some provides could be in e.g. nx.tcl, some could be loaded via # package require. We could as well think about an auto-indexer # producing these.... # nsf::method::provide append {::nsf::method::alias append -frame object ::append} nsf::method::provide lappend {::nsf::method::alias lappend -frame object ::lappend} nsf::method::provide set {::nsf::method::alias set -frame object ::set} nsf::method::provide tcl::set {::nsf::method::alias set -frame object ::set} nsf::method::provide exists {::nsf::method::alias exists ::nsf::methods::object::exists} nsf::method::provide foo {::nsf::method::create foo {x y} {return x=$x,y=$y}} # # Provide an example for an application defined method provider # nsf::proc ::get_mixin {object -per-object:switch mixinClass methodName} { ::nsf::mixin $object -per-object=${per-object} $mixinClass return [$mixinClass info method registrationhandle $methodName] } # use the method provider nsf::method::provide x {::get_mixin ::MIX x} { # here could be as well a package require, etc. ::nx::Class create ::MIX {:public method x {} {return x}} } # # Lets try it out: # nx::Class create C { :require method set :require method exists # required names can be different from registered names; if there # are multiple set methods, we could point to the right one ? [list [self] require method tcl::set] "::nsf::classes::C::set" # object methods ? [list [self] require object method lappend] "::C::lappend" # a scripted object method ? [list [self] require object method foo] "::C::foo" ? [list [self] require object method x] "::nsf::classes::MIX::x" ? [list [self] require method x] "::nsf::classes::MIX::x" # looks as well ok: ? [list [self] require namespace] "" } # # Try protected and public # ? {C require public method lappend} ::nsf::classes::C::lappend ? {::nsf::method::property C lappend call-protected} 0 ? {C require protected method lappend} ::nsf::classes::C::lappend ? {::nsf::method::property C lappend call-protected} 1 ? {C require protected object method set} ::C::set ? {::nsf::method::property C ::C::set call-protected} 1 # # call these methods # C create c1 ? {c1 set x 100} 100 ? {c1 exists x} 1 ? {C lappend some_list e1 e2} "e1 e2" ? {C foo 1 2} x=1,y=2 ? {C x} x # # Definitions directly on object # Object create o1 ? {o1 require object method set} ::o1::set ? {o1 require object method x} ::nsf::classes::MIX::x ? {o1 require public object method lappend} ::o1::lappend ? {::nsf::method::property o1 lappend call-protected} 0 ? {o1 require protected object method lappend} ::o1::lappend ? {::nsf::method::property o1 lappend call-protected} 1 } nx::test case parent-require { ::nx::Class public object method __unknown {name} { #puts stderr "***** __unknown called with <$name>" ::nx::Object create $name } ::nsf::object::unknown::add nx {::nx::Class __unknown} nx::Class create C ? {C create ::o::o} "::o::o" ? {::o info class} "::nx::Object" ? {::o::o info class} "::C" ? {::nx::Object create ::a::b} "::a::b" ? {::a info class} "::nx::Object" ? {::a::b info class} "::nx::Object" ? {C create ::1::2::3::4} "::1::2::3::4" ? {::1 info class} "::nx::Object" ? {::1::2 info class} "::nx::Object" ? {::1::2::3 info class} "::nx::Object" ? {::1::2::3::4 info class} "::C" } # # Test what happens if we try to redefine a "nonexistent" protected method. # nx::test case method-redefine-nonexistent { ? {nx::Class public method __alloc arg {return 1}} {refuse to overwrite protected method __alloc on ::nx::Class} ? {nx::Class public method __dealloc arg {return 1}} {refuse to overwrite protected method __dealloc on ::nx::Class} ? {nx::Class public method __recreate arg {return 1}} {refuse to overwrite protected method __recreate on ::nx::Class} } # # Test what happens if a class-specific method is registered and # called on an object. # nx::test case method-require-scope { nx::Object create o ::nsf::method::require o __alloc ? {o __alloc x} {method __alloc not dispatched on valid class} } # # Local variables: # mode: tcl # tcl-indent-level: 2 # indent-tabs-mode: nil # End: