Index: TODO =================================================================== diff -u -N -r625a3e7b5660331938ab739fb28eda3d5540e189 -r199e95f5c3774fc56dfb85a47f99c0b8141bf29e --- TODO (.../TODO) (revision 625a3e7b5660331938ab739fb28eda3d5540e189) +++ TODO (.../TODO) (revision 199e95f5c3774fc56dfb85a47f99c0b8141bf29e) @@ -4551,6 +4551,11 @@ - cget: make error message closer to tcl conventions - extended regression test +package nx::plain-object-method: +- made warnings configurable via + nx::configure plain-object-method-warning on|off +- completed coverage and test cases + ======================================================================== TODO: Index: library/nx/plain-object-method.tcl =================================================================== diff -u -N -rf93a2f18571f5f0fe266cd26299f463d55f0ac2d -r199e95f5c3774fc56dfb85a47f99c0b8141bf29e --- library/nx/plain-object-method.tcl (.../plain-object-method.tcl) (revision f93a2f18571f5f0fe266cd26299f463d55f0ac2d) +++ library/nx/plain-object-method.tcl (.../plain-object-method.tcl) (revision 199e95f5c3774fc56dfb85a47f99c0b8141bf29e) @@ -2,55 +2,51 @@ namespace eval ::nx { - nx::Object eval { - - :public method method { - name arguments:parameter,0..* -returns body -precondition -postcondition - } { - ::nsf::log warn "LEGACY CMD: [self] [current method] [current args]" - :public object [current method] {*}[current args] + # + # Define a method to allow configuration for tracing of the + # convenience methods. Use + # + # nx::configure plain-object-method-warning on|off + # + # for activation/deactivation of tracing + # + nx::configure public object method plain-object-method-warning {onoff:boolean,optional} { + if {[info exists onoff]} { + set :plain-object-method-warning $onoff + } else { + if {[info exists :plain-object-method-warning]} { + if {${:plain-object-method-warning}} { + uplevel {::nsf::log warn "plain object method: [self] [current method] [current args]"} + } + } } + } - :public method alias args { - ::nsf::log warn "LEGACY CMD: [self] [current method] [current args]" - :public object [current method] {*}$args - } - :public method forward args { - ::nsf::log warn "LEGACY CMD: [self] [current method] [current args]" - :public object [current method] {*}$args - } - :public method filter args { - ::nsf::log warn "LEGACY CMD: [self] [current method] [current args]" - :object [current method] {*}$args + nx::Object eval { + # + # Definitions redirected to "object" + # + foreach m {alias filter forward method mixin property variable} { + :public method $m {args} { + nx::configure plain-object-method-warning + :object [current method] {*}[current args] + } } - :public method mixin args { - ::nsf::log warn "LEGACY CMD: [self] [current method] [current args]" - :object [current method] {*}$args + # + # info subcmmands + # + foreach m {method methods slots variables + "filter guards" "filter methods" + "mixin guards" "mixin classes" + } { + :public method "info $m" {args} [subst -nocommands { + nx::configure plain-object-method-warning + :info object $m {*}[current args] + }] } - :public method property args { - ::nsf::log warn "LEGACY CMD: [self] [current method] [current args]" - :object [current method] {*}$args - } - :public method variable args { - ::nsf::log warn "LEGACY CMD: [self] [current method] [current args]" - :object [current method] {*}$args - } - - :public alias "info method" ::nsf::methods::object::info::method - :public alias "info methods" ::nsf::methods::object::info::methods - :public alias "info filter guard" ::nsf::methods::object::info::filterguard - :public alias "info filter methods" ::nsf::methods::object::info::filtermethods - :public alias "info mixin guard" ::nsf::methods::object::info::mixinguard - :public alias "info mixin classes" ::nsf::methods::object::info::mixinclasses - - :public method "info slots" args { - ::nsf::log warn "LEGACY CMD: [self] [current method] [current args]" - :object [current method] {*}$args - } - } @@ -59,13 +55,15 @@ # method require, base cases # :method "require method" {methodName} { + nx::configure plain-object-method-warning ::nsf::method::require [::nsf::self] $methodName 1 return [:info lookup method $methodName] } # # method require, public explicitly # :method "require public method" {methodName} { + nx::configure plain-object-method-warning set result [:require object method $methodName] ::nsf::method::property [self] $result call-protected false return $result @@ -74,6 +72,7 @@ # method require, protected explicitly # :method "require protected method" {methodName} { + nx::configure plain-object-method-warning set result [:require object method $methodName] ::nsf::method::property [self] $result call-protected true return $result Index: tests/plain-object-method.test =================================================================== diff -u -N -rf93a2f18571f5f0fe266cd26299f463d55f0ac2d -r199e95f5c3774fc56dfb85a47f99c0b8141bf29e --- tests/plain-object-method.test (.../plain-object-method.test) (revision f93a2f18571f5f0fe266cd26299f463d55f0ac2d) +++ tests/plain-object-method.test (.../plain-object-method.test) (revision 199e95f5c3774fc56dfb85a47f99c0b8141bf29e) @@ -14,18 +14,45 @@ ? {lsort [o info]} "valid submethods of ::o info: children class has info lookup name object parameter parent precedence variable vars" } +# +# require the conveniance layer +# and make it verbose +# package require nx::plain-object-method +nx::configure plain-object-method-warning on + + nx::Test case plain-methods-1 { nx::Class create M1 nx::Object create o { - :public method foo {} {return foo} + :public method foo {} {return [:pm1]} :public method f args {next} - #:mixin M1 + :protected method pm1 args {return pm1} + :public alias a ::o::pm1 + :public forward fwd %self pm1 + :private method priv args {return priv} + :method pm2 args {return pm2} + :property -accessor public p + :variable v1 1 + :variable -incremental v2:integer 1 # # public, protected, private # alias, forward # } + ? {o info methods} "v2 p foo fwd a f" + ? {lsort [o info methods -callprotection protected]} "per-object-slot pm1 pm2" + ? {lsort [o info methods -callprotection private]} "priv" + + ? {o info variables} "::o::per-object-slot::v2 ::o::per-object-slot::p" + ? {o info object variables} "::o::per-object-slot::v2 ::o::per-object-slot::p" + ? {o info slots} "::o::per-object-slot::v2 ::o::per-object-slot::p" + + ? {o pm1} "::o: unable to dispatch method 'pm1'" + ? {o foo} "pm1" + ? {o a} "pm1" + ? {o fwd} "pm1" + ? {o mixin M1} ::M1 ? {o info mixin classes} ::M1 ? {o mixin ""} "" @@ -36,6 +63,6 @@ ? {o filter ""} "" ? {o info filter methods} "" - ? {lsort [o info object methods]} "f foo" - ? {lsort [o info]} "valid submethods of ::o info: children class filter has info lookup method methods mixin name object parameter parent precedence slots variable vars" + ? {lsort [o info object methods]} "a f foo fwd p v2" + ? {lsort [o info]} "valid submethods of ::o info: children class filter has info lookup method methods mixin name object parameter parent precedence slots variable variables vars" }