Index: TODO =================================================================== diff -u -r37b3e36b164b30d7eec8545781a9d2f6af64dbc2 -r7e20ec3d04d3b6a0789c26b4e77a2291df02f609 --- TODO (.../TODO) (revision 37b3e36b164b30d7eec8545781a9d2f6af64dbc2) +++ TODO (.../TODO) (revision 7e20ec3d04d3b6a0789c26b4e77a2291df02f609) @@ -5786,15 +5786,15 @@ - Re-factored new hash-table infrastructure (based on function-pointer keys) to support method-definitions (and future uses as well). +- Allow combination of "-trace get" with default value (was previously disallowed) +- Extend regression test + ======================================================================== TODO: - Shouldn't we add debug/deprecated filters for "info methods", i.e.: ... info methods ?-debug? ?-deprecated? ?-callprotection all|public|protected|private? ?-closure? ?-type all|scripted|builtin|alias|forwarder|object|setter|nsfproc? ?-path? ?-source all|application|system? ?/pattern/?" -- add regression tests for debug and deprecated in methods (behavior) -- add regression tests for nsf::proc flags -debug and -deprecated (behavior) - - add to doc: # in case, when similar cmds are commented, add: @@ -5805,10 +5805,6 @@ nsf::method::property /obj/ ?-per-object? /method/ debug ?0|1? nsf::method::property /obj/ ?-per-object? /method/ deprecated ?0|1? - -- gcc6: - * ISOBJ(methodObj); will raise a warning, when methodObj is declared as nonnull - - maybe better handling of single-colon prefixed vars in trace procs, when passing values to nsf::var::set/get/... Index: library/nx/nx.tcl =================================================================== diff -u -r4fa580aed7f0c54c8e09ec6bb1fc1b46789334ed -r7e20ec3d04d3b6a0789c26b4e77a2291df02f609 --- library/nx/nx.tcl (.../nx.tcl) (revision 4fa580aed7f0c54c8e09ec6bb1fc1b46789334ed) +++ library/nx/nx.tcl (.../nx.tcl) (revision 7e20ec3d04d3b6a0789c26b4e77a2291df02f609) @@ -1451,7 +1451,19 @@ if {[info exists :initblock]} { if {[info exists :default]} { if {[llength $options] > 0} { - ::nsf::is -complain [join $options ,] ${:default} + # + # In case the parameter options contain a "slotset", this + # options would not be allowed by nsf::is. Therefore, we + # remove this option before testing (we are already in the + # slot object). + # + set p [lsearch -exact $options "slotset" ] + if {$p > -1} { + set check_options [lreplace $options $p $p] + } else { + set check_options $options + } + ::nsf::is -complain [join $check_options ,] ${:default} #puts stderr "::nsf::is -complain [join $options ,] ${:default} ==> OK" } append initblock "\n::nsf::var::set \[::nsf::self\] ${:name} [list ${:default}]\n" @@ -1823,10 +1835,9 @@ ::nx::VariableSlot public method setCheckedInstVar {-nocomplain:switch object value} { - if {[::nsf::var::exists $object ${:name}] && !$nocomplain} { - return -code error \ - "object $object has already an instance variable named '${:name}'" - } + #if {[::nsf::var::exists $object ${:name}] && !$nocomplain} { + # return -code error "object $object has already an instance variable named '${:name}'" + #} set options [:getParameterOptions -withMultiplicity true] if {[llength $options]} { @@ -2083,10 +2094,10 @@ return -code error \ "'-trace default' can't be used together with default value" } - if {"get" in ${:trace}} { - return -code error \ - "'trace get' can't be used together with default value" - } + #if {"get" in ${:trace}} { + # return -code error \ + # "'trace get' can't be used together with default value" + #} } if {"default" in ${:trace}} { #puts stderr "DEFAULTCMD [self] trace=${:trace}" @@ -2246,6 +2257,7 @@ foreach o [split $parameterOptions ,] { if {$o ne "noconfig"} {lappend noptions $o} } + set parameterOptions [join $noptions ,] ::nsf::is -complain $parameterOptions $defaultValue } else { Index: tests/parameters.test =================================================================== diff -u -r546f8ddb033b81b5a4f9836d4f5541c9f68ac306 -r7e20ec3d04d3b6a0789c26b4e77a2291df02f609 --- tests/parameters.test (.../parameters.test) (revision 546f8ddb033b81b5a4f9836d4f5541c9f68ac306) +++ tests/parameters.test (.../parameters.test) (revision 7e20ec3d04d3b6a0789c26b4e77a2291df02f609) @@ -1326,7 +1326,13 @@ } +# +# basic slot trace tests +# nx::test case slot-traces { + # + # basic tests for object slots + # ::nx::Object create o { :object property -accessor public -trace default a { :public object method value=default {obj var} {puts stderr V=DEFAULT; return 4 } @@ -1352,6 +1358,10 @@ ? {o c set 5} 999 ? {::nsf::object::property o2 hasperobjectslots} 1 + # + # basic tests for class slots + # + ::nx::Class create C { :property -accessor public -trace default a { :public object method value=default {obj var} { return 4 } @@ -1399,8 +1409,8 @@ ? {o eval {info exists :a}} 0 ? {o eval {info exists :b}} 0 - ? {o object property -trace get {b 0} { }} "'trace get' can't be used together with default value" - ? {o eval {info exists :b}} 0 + ? {o object property -trace get {b:integer 0} { }} "" + ? {o eval {info exists :b}} 1 ? {o eval {info exists :c}} 0 ? {o object property -trace {default get} c { }} "'-trace default' and '-trace get' can't be used together" @@ -1440,7 +1450,7 @@ ? {Klass property -trace default {a 0} { }} "'-trace default' can't be used together with default value" - ? {Klass property -trace get {b 0} { }} "'trace get' can't be used together with default value" + ? {Klass property -trace get {b 0} { }} "" ? {Klass property -trace {default get} c { }} "'-trace default' and '-trace get' can't be used together" @@ -3149,7 +3159,86 @@ ? {::f1 cget -x} "3" } +# +# test trace meta slot + default +# +nx::test case trace-meta-slot { + ::nx::MetaSlot create ::nsv::TraceVariableSlot -superclass ::nx::VariableSlot { + :property {trace {get set}} + :public method value=set {obj varName value} { + incr ::trace_set + #puts stderr "SET nsv_set $obj $varName $value" + next + } + :public method value=get {obj varName} { + incr ::trace_get + #puts stderr "GET nsv_set $obj $varName" + next + } + } + + set ::trace_set 0 + set ::trace_get 0 + nx::Class create Foo { + + :property -class ::nsv::TraceVariableSlot {x 123} + :property -class ::nsv::TraceVariableSlot {y 456} + + :public method exists {var} { info exists :$var } + :public method vars {} { :info vars} + :public method get {var} { set :$var } + :public method foo {} { incr :x } + + :create ::f1 + } + + # + # State after creation + # + + ? {set ::trace_set} 0 + ? {set ::trace_get} 0 + ? {lsort [::f1 vars]} "__initcmd x y" + + # + # Change the value of ::f1.x via configure + # + + ? {::f1 cget -x} "123" + + ? {set ::trace_set} 0 + ? {set ::trace_get} 2 ;# since the next triggers the default setter, which has no "-notrace" + + set ::trace_set 0 + set ::trace_get 0 + + # + # Change the value of ::f1.x via configure + # + ? {::f1 configure -x 2} "" + + ? {set ::trace_set} 2 ;# since the next triggers the default setter, which has no "-notrace" + ? {set ::trace_get} 0 + + ? {::f1 cget -x} "2" + + # + # Change the value of ::f1.x via variable changes + # + set ::trace_set 0 + set ::trace_get 0 + + ? {::f1 foo} "3" + ? {set ::trace_set} 1 + ? {set ::trace_get} 1 + + ? {::f1 cget -x} "3" +} + + + + # # Testing nsf::parseargs #