# -*- Tcl -*- package req nx::test # # make sure, the defaultAccessor is "none" # #puts stderr "*** default defaultAccessor '[nx::configure defaultAccessor]'" nx::configure defaultAccessor none ##################################################################### # class-level properties ##################################################################### # # Test class-level properties and variables without -incremental # nx::test case class-level { nx::Class create C { :property {a a1} :property -accessor public {b b1} :property -accessor protected {c c1} :property -accessor private {d d1} :property -accessor none {e e1} :variable va va1 :variable -accessor public vb vb1 :variable -accessor protected vc vc1 :variable -accessor private vd vd1 :variable -accessor none ve ve1 # a non-configurable property is a variable :property -accessor none -configurable false {vf vf1} :public method call-local {v} {: -local $v} :create c1 } # # just the public properties are accessible via the configure interface # ? {c1 info configure} { ?-e /value/? ?-a /value/? ?-b /value/? ?-object-mixin /mixinreg .../? ?-class /class/? ?-object-filter /filterreg .../? ?/__initblock/?} ? {lsort [C info slots]} "::C::slot::____C.d ::C::slot::____C.vd ::C::slot::a ::C::slot::b ::C::slot::c ::C::slot::e ::C::slot::va ::C::slot::vb ::C::slot::vc ::C::slot::ve ::C::slot::vf" ? {::C::slot::a definition} "::C property -accessor none {a a1}" ? {::C::slot::b definition} "::C property -accessor public {b b1}" ? {::C::slot::c definition} "::C variable -accessor protected c c1" ? {::C::slot::____C.d definition} "::C variable -accessor private d d1" ? {::C::slot::e definition} "::C property -accessor none {e e1}" ? {::C::slot::va definition} "::C variable -accessor none va va1" ? {::C::slot::vb definition} "::C variable -accessor public vb vb1" ? {::C::slot::vc definition} "::C variable -accessor protected vc vc1" ? {::C::slot::____C.vd definition} "::C variable -accessor private vd vd1" ? {::C::slot::ve definition} "::C variable -accessor none ve ve1" ? {::C::slot::vf definition} "::C variable -accessor none vf vf1" ? {c1 cget -a} a1 ? {c1 cget -b} b1 ? {c1 cget -c} "cget: unknown configure parameter -c" ? {c1 cget -d} "cget: unknown configure parameter -d" ? {c1 cget -va} "cget: unknown configure parameter -va" ? {c1 cget -vb} "cget: unknown configure parameter -vb" ? {c1 cget -vc} "cget: unknown configure parameter -vc" ? {c1 cget -vd} "cget: unknown configure parameter -vd" ? {c1 cget -ve} "cget: unknown configure parameter -ve" ? {c1 cget -vf} "cget: unknown configure parameter -vf" # # No incremental used, so "a" and "e" have no slots # ? {c1 info lookup method a} "" ? {c1 info lookup method b} "::nsf::classes::C::b" ? {c1 info lookup method c} "::nsf::classes::C::c" ? {c1 info lookup method d} "::nsf::classes::C::d" ? {c1 info lookup method e} "" ? {c1 info lookup method f} "" ? {c1 info lookup method va} "" ? {c1 info lookup method vb} "::nsf::classes::C::vb" ? {c1 info lookup method vc} "::nsf::classes::C::vc" ? {c1 info lookup method vd} "::nsf::classes::C::vd" ? {c1 info lookup method ve} "" ? {c1 info lookup method vf} "" # # Check protection of accessors # ? {nsf::method::property C b call-protected} 0 ? {nsf::method::property C c call-protected} 1 ? {nsf::method::property C d call-protected} 1 ? {nsf::method::property C vb call-protected} 0 ? {nsf::method::property C vc call-protected} 1 ? {nsf::method::property C vd call-protected} 1 ? {nsf::method::property C b call-private} 0 ? {nsf::method::property C c call-private} 0 ? {nsf::method::property C d call-private} 1 ? {nsf::method::property C vb call-private} 0 ? {nsf::method::property C vc call-private} 0 ? {nsf::method::property C vd call-private} 1 # # do we have variables set? # ? {c1 eval "info exists :a"} 1 ? {c1 eval "info exists :b"} 1 ? {c1 eval "info exists :c"} 1 ? {c1 eval "info exists :d"} 0 ? {c1 eval "info exists :va"} 1 ? {c1 eval "info exists :vb"} 1 ? {c1 eval "info exists :vc"} 1 ? {c1 eval "info exists :vd"} 0 ? {c1 eval "info exists :ve"} 1 ? {c1 eval "info exists :vf"} 1 # # can we call the accessor directly or via "eval" # ? {c1 a} {::c1: unable to dispatch method 'a'} ? {c1 b} b1 ? {c1 c} {::c1: unable to dispatch method 'c'} ? {c1 d} {::c1: unable to dispatch method 'd'} ? {c1 eval ":a"} {::c1: unable to dispatch method 'a'} ? {c1 eval ":b"} b1 ? {c1 eval ":c"} c1 ? {c1 eval ":d"} {::c1: unable to dispatch method 'd'} ? {c1 va} {::c1: unable to dispatch method 'va'} ? {c1 vb} vb1 ? {c1 vc} {::c1: unable to dispatch method 'vc'} ? {c1 vd} {::c1: unable to dispatch method 'vd'} ? {c1 eval ":va"} {::c1: unable to dispatch method 'va'} ? {c1 eval ":vb"} vb1 ? {c1 eval ":vc"} vc1 ? {c1 eval ":vd"} {::c1: unable to dispatch method 'vd'} # # check the behavior of "private" properties and variables # ? {c1 call-local d} d1 ? {c1 call-local vd} vd1 ? {lsort [c1 info vars]} "__private a b c e va vb vc ve vf" ? {c1 eval "array get :__private"} "::C,vd vd1 ::C,d d1" # # check incremental operations for properties (should fail in all # cases) # ? {c1 b add x} {wrong # args should be "::c1 b ?value?"} ? {c1 c add x} {::c1: unable to dispatch method 'c'} ? {c1 eval {:c add x}} {wrong # args should be "::c1 c ?value?"} ? {c1 d add x} {::c1: unable to dispatch method 'd'} ? {c1 eval {:d add x}} {::c1: unable to dispatch method 'd'} ? {c1 e add x} {::c1: unable to dispatch method 'e'} # # check incremental operations for variables (should fail in all # cases) # ? {c1 va add x} {::c1: unable to dispatch method 'va'} ? {c1 vb add x} {wrong # args should be "::c1 vb ?value?"} ? {c1 vc add x} {::c1: unable to dispatch method 'vc'} ? {c1 eval {:vc add x}} {wrong # args should be "::c1 vc ?value?"} ? {c1 vd add x} {::c1: unable to dispatch method 'vd'} ? {c1 eval {:vd add x}} {::c1: unable to dispatch method 'vd'} ? {c1 ve add x} {::c1: unable to dispatch method 've'} # # The accessor should be a setter due to incremental # ? {C info method definition b} {::C public setter b} # # check error message on a typo. The following command does a # recreate. # ? {C property -accessor proceted {b b1}} {accessor value 'proceted' invalid; might be one of public|protected|private or none} # # The accessor is deleted due to the error # ? {C info method definition b} {} } # # test class-level properties and variables with -incremental # nx::test case class-level-incremental { nx::Class create CC { :property -incremental {a a1} :property -accessor public -incremental {b b1} :property -accessor protected -incremental {c c1} :property -accessor private -incremental {d d1} :property -accessor none -incremental {e e1} :variable -incremental va va1 :variable -accessor public -incremental vb vb1 :variable -accessor protected -incremental vc vc1 :variable -accessor private -incremental vd vd1 :variable -accessor none -incremental ve ve1 :public method call-local {v} {: -local $v} :public method add-local {var value} {: -local $var add $value} :create c1 } # # The use of "-incremental" implies multivalued # ? {c1 info configure} { ?-e /value .../? ?-a /value .../? ?-b /value .../? ?-object-mixin /mixinreg .../? ?-class /class/? ?-object-filter /filterreg .../? ?/__initblock/?} ? {c1 cget -a} a1 ? {c1 cget -b} b1 ? {c1 cget -c} "cget: unknown configure parameter -c" ? {c1 cget -d} "cget: unknown configure parameter -d" ? {c1 cget -va} "cget: unknown configure parameter -va" ? {c1 cget -vb} "cget: unknown configure parameter -vb" ? {c1 cget -vc} "cget: unknown configure parameter -vc" ? {c1 cget -vd} "cget: unknown configure parameter -vd" # # The use of "-incremental" implies an accessor # ? {c1 info lookup method a} "::nsf::classes::CC::a" ;# forcing accessor ? {c1 info lookup method b} "::nsf::classes::CC::b" ? {c1 info lookup method c} "::nsf::classes::CC::c" ? {c1 info lookup method d} "::nsf::classes::CC::d" ? {c1 info lookup method va} "::nsf::classes::CC::va" ;# forcing accessor ? {c1 info lookup method vb} "::nsf::classes::CC::vb" ? {c1 info lookup method vc} "::nsf::classes::CC::vc" ? {c1 info lookup method vd} "::nsf::classes::CC::vd" # # The use of "-incremental" implies an accessor, which is public # ? {nsf::method::property CC a call-protected} 0 ? {nsf::method::property CC b call-protected} 0 ? {nsf::method::property CC c call-protected} 1 ? {nsf::method::property CC d call-protected} 1 ? {nsf::method::property CC va call-protected} 0 ? {nsf::method::property CC vb call-protected} 0 ? {nsf::method::property CC vc call-protected} 1 ? {nsf::method::property CC vd call-protected} 1 ? {nsf::method::property CC a call-private} 0 ? {nsf::method::property CC b call-private} 0 ? {nsf::method::property CC c call-private} 0 ? {nsf::method::property CC d call-private} 1 ? {nsf::method::property CC va call-private} 0 ? {nsf::method::property CC vb call-private} 0 ? {nsf::method::property CC vc call-private} 0 ? {nsf::method::property CC vd call-private} 1 # # do we have variables set? # ? {c1 eval "info exists :a"} 1 ? {c1 eval "info exists :b"} 1 ? {c1 eval "info exists :c"} 1 ? {c1 eval "info exists :d"} 0 ? {c1 eval "info exists :va"} 1 ? {c1 eval "info exists :vb"} 1 ? {c1 eval "info exists :vc"} 1 ? {c1 eval "info exists :vd"} 0 # # can we call the accessor directly or via "eval" # ? {c1 a} a1 ? {c1 b} b1 ? {c1 c} {::c1: unable to dispatch method 'c'} ? {c1 d} {::c1: unable to dispatch method 'd'} ? {c1 eval ":a"} a1 ? {c1 eval ":b"} b1 ? {c1 eval ":c"} c1 ? {c1 eval ":d"} {::c1: unable to dispatch method 'd'} ? {c1 va} va1 ? {c1 vb} vb1 ? {c1 vc} {::c1: unable to dispatch method 'vc'} ? {c1 vd} {::c1: unable to dispatch method 'vd'} ? {c1 eval ":va"} va1 ? {c1 eval ":vb"} vb1 ? {c1 eval ":vc"} vc1 ? {c1 eval ":vd"} {::c1: unable to dispatch method 'vd'} # # check the behavior of "private" properties and variables # ? {c1 call-local d} d1 ? {c1 call-local vd} vd1 ? {lsort [c1 info vars]} "__private a b c e va vb vc ve" ? {c1 eval "array get :__private"} "::CC,vd vd1 ::CC,d d1" # # check incremental operations for properties # ? {c1 a add x} {x a1} ? {c1 b add x} {x b1} ? {c1 c add x} {::c1: unable to dispatch method 'c'} ? {c1 eval {:c add x}} {x c1} ? {c1 d add x} {::c1: unable to dispatch method 'd'} ? {c1 eval {:d add x}} {::c1: unable to dispatch method 'd'} ? {c1 add-local d x} {x d1} ? {c1 e add x} {x e1} # # check incremental operations for variables # ? {c1 va add x} {x va1} ? {c1 vb add x} {x vb1} ? {c1 vc add x} {::c1: unable to dispatch method 'vc'} ? {c1 eval {:vc add x}} {x vc1} ? {c1 vd add x} {::c1: unable to dispatch method 'vd'} ? {c1 eval {:vd add x}} {::c1: unable to dispatch method 'vd'} ? {c1 add-local vd x} {x vd1} ? {c1 ve add x} {x ve1} # # The accessor should be a forwarder due to incremental # ? {CC info method definition b} {::CC public forward b ::CC::slot::b {%1 {get assign}} %self b} # # check error message # ? {CC property -accessor proceted -incremental {b b1}} {accessor value 'proceted' invalid; might be one of public|protected|private or none} # # The accessor is deleted due to the error # ? {CC info method definition b} {} } ##################################################################### # object-level properties ##################################################################### # # Test object-level properties and variables without -incremental # nx::test case object-level { nx::Object create o1 { :object property {a a1} :object property -accessor public {b b1} :object property -accessor protected {c c1} :object property -accessor private {d d1} :object property -accessor none {e e1} :object variable va va1 :object variable -accessor public vb vb1 :object variable -accessor protected vc vc1 :object variable -accessor private vd vd1 :object variable -accessor none ve ve1 :public object method call-local {v} {: -local $v} } # # check the slot for "a" # ? {o1 info lookup slots a} ::o1::per-object-slot::a # # just the public properties are accessible via the configure interface # ? {o1 info configure} { ?-e /value/? ?-a /value/? ?-b /value/? ?-object-mixin /mixinreg .../? ?-class /class/? ?-object-filter /filterreg .../? ?/__initblock/?} # # just the public properties are accessible via the cget interface # ? {o1 cget -a} a1 ? {o1 cget -b} b1 ? {o1 cget -c} {cget: unknown configure parameter -c} ? {o1 cget -d} {cget: unknown configure parameter -d} ? {o1 cget -va} {cget: unknown configure parameter -va} ? {o1 cget -vb} {cget: unknown configure parameter -vb} ? {o1 cget -vc} {cget: unknown configure parameter -vc} ? {o1 cget -vd} {cget: unknown configure parameter -vd} # # We do not have accessors in the default case and in the explicit "none" case. # ? {o1 info lookup method a} "" ? {o1 info lookup method b} "::o1::b" ? {o1 info lookup method c} "::o1::c" ? {o1 info lookup method d} "::o1::d" ? {o1 info lookup method e} "" ? {o1 info lookup method va} "" ? {o1 info lookup method vb} "::o1::vb" ? {o1 info lookup method vc} "::o1::vc" ? {o1 info lookup method vd} "::o1::vd" ? {o1 info lookup method ve} "" # # check public/protected/private settings # ? {nsf::method::property o1 b call-protected} 0 ? {nsf::method::property o1 c call-protected} 1 ? {nsf::method::property o1 d call-protected} 1 ? {nsf::method::property o1 vb call-protected} 0 ? {nsf::method::property o1 vc call-protected} 1 ? {nsf::method::property o1 vd call-protected} 1 ? {nsf::method::property o1 b call-private} 0 ? {nsf::method::property o1 c call-private} 0 ? {nsf::method::property o1 d call-private} 1 ? {nsf::method::property o1 vb call-private} 0 ? {nsf::method::property o1 vc call-private} 0 ? {nsf::method::property o1 vd call-private} 1 # # check if instance variables are created # ? {o1 eval "info exists :a"} 1 ? {o1 eval "info exists :b"} 1 ? {o1 eval "info exists :c"} 1 ? {o1 eval "info exists :d"} 0 ? {o1 eval "info exists :e"} 1 ? {o1 eval "info exists :va"} 1 ? {o1 eval "info exists :vb"} 1 ? {o1 eval "info exists :vc"} 1 ? {o1 eval "info exists :vd"} 0 ? {o1 eval "info exists :ve"} 1 # # check if we can dispatch accessors directly or via "eval" # ? {o1 a} {::o1: unable to dispatch method 'a'} ? {o1 b} b1 ? {o1 c} {::o1: unable to dispatch method 'c'} ? {o1 d} {::o1: unable to dispatch method 'd'} ? {o1 eval ":a"} {::o1: unable to dispatch method 'a'} ? {o1 eval ":b"} b1 ? {o1 eval ":c"} c1 ? {o1 eval ":d"} {::o1: unable to dispatch method 'd'} ? {o1 va} {::o1: unable to dispatch method 'va'} ? {o1 vb} vb1 ? {o1 vc} {::o1: unable to dispatch method 'vc'} ? {o1 vd} {::o1: unable to dispatch method 'vd'} ? {o1 eval ":va"} {::o1: unable to dispatch method 'va'} ? {o1 eval ":vb"} vb1 ? {o1 eval ":vc"} vc1 ? {o1 eval ":vd"} {::o1: unable to dispatch method 'vd'} # # check dispatch of private accessors and private variables # ? {o1 call-local d} d1 ? {o1 call-local vd} vd1 ? {lsort [o1 info vars]} "__private a b c e va vb vc ve" ? {o1 eval "array get :__private"} "::o1,d d1 ::o1,vd vd1" # # check error message # ? {o1 object property -accessor proceted {b b1}} {accessor value 'proceted' invalid; might be one of public|protected|private or none} } # # test object-level properties and variables with -incremental # nx::test case object-level-incremental { nx::Object create o1 { :object property -incremental {a a1} :object property -accessor public -incremental {b b1} :object property -accessor protected -incremental {c c1} :object property -accessor private -incremental {d d1} :object property -accessor none -incremental {e e1} :object variable -incremental va va1 :object variable -accessor public -incremental vb vb1 :object variable -accessor protected -incremental vc vc1 :object variable -accessor private -incremental vd vd1 :object variable -accessor none -incremental ve ve1 :public object method call-local {v} {: -local $v} :public object method add-local {var value} {: -local $var add $value} } # # The use of "-incremental" implies multivalued # ? {o1 info configure} { ?-e /value .../? ?-a /value .../? ?-b /value .../? ?-object-mixin /mixinreg .../? ?-class /class/? ?-object-filter /filterreg .../? ?/__initblock/?} ? {o1 cget -a} a1 ? {o1 cget -b} b1 ? {o1 cget -c} {cget: unknown configure parameter -c} ? {o1 cget -d} {cget: unknown configure parameter -d} ? {o1 cget -va} {cget: unknown configure parameter -va} ? {o1 cget -vb} {cget: unknown configure parameter -vb} ? {o1 cget -vc} {cget: unknown configure parameter -vc} ? {o1 cget -vd} {cget: unknown configure parameter -vd} # # The use of "-incremental" implies an accessor # ? {o1 info lookup method a} "::o1::a" ;# forcing accessor ? {o1 info lookup method b} "::o1::b" ? {o1 info lookup method c} "::o1::c" ? {o1 info lookup method d} "::o1::d" ? {o1 info lookup method va} "::o1::va" ;# forcing accessor ? {o1 info lookup method vb} "::o1::vb" ? {o1 info lookup method vc} "::o1::vc" ? {o1 info lookup method vd} "::o1::vd" # # The use of "-incremental" implies an accessor, which is public # ? {nsf::method::property o1 a call-protected} 0 ? {nsf::method::property o1 b call-protected} 0 ? {nsf::method::property o1 c call-protected} 1 ? {nsf::method::property o1 d call-protected} 1 ? {nsf::method::property o1 va call-protected} 0 ? {nsf::method::property o1 vb call-protected} 0 ? {nsf::method::property o1 vc call-protected} 1 ? {nsf::method::property o1 vd call-protected} 1 ? {nsf::method::property o1 a call-private} 0 ? {nsf::method::property o1 b call-private} 0 ? {nsf::method::property o1 c call-private} 0 ? {nsf::method::property o1 d call-private} 1 ? {nsf::method::property o1 va call-private} 0 ? {nsf::method::property o1 vb call-private} 0 ? {nsf::method::property o1 vc call-private} 0 ? {nsf::method::property o1 vd call-private} 1 # # do we have variables set? # ? {o1 eval "info exists :a"} 1 ? {o1 eval "info exists :b"} 1 ? {o1 eval "info exists :c"} 1 ? {o1 eval "info exists :d"} 0 ? {o1 eval "info exists :va"} 1 ? {o1 eval "info exists :vb"} 1 ? {o1 eval "info exists :vc"} 1 ? {o1 eval "info exists :vd"} 0 # # can we call the accessor directly or via "eval" # ? {o1 a} a1 ? {o1 b} b1 ? {o1 c} {::o1: unable to dispatch method 'c'} ? {o1 d} {::o1: unable to dispatch method 'd'} ? {o1 eval ":a"} a1 ? {o1 eval ":b"} b1 ? {o1 eval ":c"} c1 ? {o1 eval ":d"} {::o1: unable to dispatch method 'd'} ? {o1 va} va1 ? {o1 vb} vb1 ? {o1 vc} {::o1: unable to dispatch method 'vc'} ? {o1 vd} {::o1: unable to dispatch method 'vd'} ? {o1 eval ":va"} va1 ? {o1 eval ":vb"} vb1 ? {o1 eval ":vc"} vc1 ? {o1 eval ":vd"} {::o1: unable to dispatch method 'vd'} # # check the behavior of "private" properties and variables # ? {o1 call-local d} d1 ? {o1 call-local vd} vd1 ? {lsort [o1 info vars]} "__private a b c e va vb vc ve" ? {o1 eval "array get :__private"} "::o1,d d1 ::o1,vd vd1" # # check incremental operations for properties # ? {o1 a add x} {x a1} ? {o1 b add x} {x b1} ? {o1 c add x} {::o1: unable to dispatch method 'c'} ? {o1 eval {:c add x}} {x c1} ? {o1 d add x} {::o1: unable to dispatch method 'd'} ? {o1 eval {:d add x}} {::o1: unable to dispatch method 'd'} ? {o1 add-local d x} {x d1} ? {o1 e add x} {x e1} # # check incremental operations for variables # ? {o1 va add x} {x va1} ? {o1 vb add x} {x vb1} ? {o1 vc add x} {::o1: unable to dispatch method 'vc'} ? {o1 eval {:vc add x}} {x vc1} ? {o1 vd add x} {::o1: unable to dispatch method 'vd'} ? {o1 eval {:vd add x}} {::o1: unable to dispatch method 'vd'} ? {o1 add-local vd x} {x vd1} ? {o1 ve add x} {x ve1} # # The accessor should be a forwarder due to incremental # ? {o1 info object method definition b} {::o1 public object forward b ::o1::per-object-slot::b {%1 {get assign}} %self b} # # check error message # ? {o1 object property -accessor proceted {b b1}} {accessor value 'proceted' invalid; might be one of public|protected|private or none} # # The accessor is deleted due to the error # ? {o1 info object method definition b} {} } # # Tests for experimental "value add", "value assign" ... # nx::test case property-value-incremental { nx::Object create o1 { :object property -incremental {a a1} } ? {o1 a add x} {x a1} ? {o1 a {a1}} {a1} nsf::configure debug 2 ? {o1 a value add x } {x a1} ? {o1 a value assign {a b c}} {a b c} ? {o1 a value get } {a b c} ? {o1 a value add x } {x a b c} ? {o1 a value add z end} {x a b c z} } # # Test interactions between multiplicity and incremental # nx::test case property-incremental-multiplicity { nx::Object create o1 { :object property -incremental a:integer,0..n :object property -incremental b:integer,1..n } ? {o1 info object slots a} "::o1::per-object-slot::a" ? {[o1 info object slots a] eval {set :multiplicity}} "0..n" ? {[o1 info object slots b] eval {set :multiplicity}} "1..n" ? {o1 info variable definition [o1 info object variables a]} \ "::o1 object property -accessor public -incremental a:integer,0..n" ? {o1 info variable definition [o1 info object variables b]} \ "::o1 object property -accessor public -incremental b:integer,1..n" ? {o1 a {1 2 3}} {1 2 3} ? {o1 b {1 2 3}} {1 2 3} ? {o1 a ""} {} ? {o1 b ""} {invalid value for parameter 'value': list is not allowed to be empty} } ##################################################################### # tests with class object ##################################################################### # # check performance of class-level configure and cget # nx::test case class-object-properties { nx::Class create C { :property {a a1} :variable va va1 :object property {b b1} :object variable vb b1 :create c1 } # # just the public properties are accessible via the configure interface # ? {c1 info configure} {?-a /value/? ?-object-mixin /mixinreg .../? ?-class /class/? ?-object-filter /filterreg .../? ?/__initblock/?} ? {c1 cget -a} a1 ? {c1 configure -a a2} "" ? {C info configure} {?-b /value/? ?-superclass /class .../? ?-mixin /mixinreg .../? ?-filter /filterreg .../? ?-object-mixin /mixinreg .../? ?-class /class/? ?-object-filter /filterreg .../? ?/__initblock/?} ? {C cget -b} b1 ? {C configure -b b2} "" ? {C cget -b} b2 } ##################################################################### # performance tests ##################################################################### nx::test configure -count 10000 # # check performance of class-level configure and cget # nx::test case class-level-perf { nx::Class create C { :property {a a1} :property -accessor public {b b1} :property -accessor protected {c c1} :property -accessor private {d d1} :property -accessor none {e e1} :variable va va1 :variable -accessor public vb vb1 :variable -accessor protected vc vc1 :variable -accessor private vd vd1 :variable -accessor none ve ve1 :create c1 } nx::Class create D { :object property {cp 101} :property {a a1} :property -accessor public {b b1} :property -accessor protected {c c1} :property -accessor private {d d1} :property -accessor none {e e1} :variable va va1 :variable -accessor public vb vb1 :variable -accessor protected vc vc1 :variable -accessor private vd vd1 :variable -accessor none ve ve1 :create d1 } # # just the public properties are accessible via the configure interface # package require nx::volatile ? {c1 info configure} { ?-e /value/? ?-a /value/? ?-b /value/? ?-volatile? ?-object-mixin /mixinreg .../? ?-class /class/? ?-object-filter /filterreg .../? ?/__initblock/?} set e [C eval :__objectparameter] ? {C eval :__objectparameter} $e ? {c1 cget -a} a1 ? {c1 configure -a a2} "" ? {C configure -class ::nx::Class} "" ? {C cget -class} ::nx::Class ? {C cget -mixin} "" ? {C cget -filter} "" # ? {C cget -noinit} 0 ? {C cget -volatile} 0 # # check influence of class-level per-object properties # ? {d1 info configure} { ?-e /value/? ?-a /value/? ?-b /value/? ?-volatile? ?-object-mixin /mixinreg .../? ?-class /class/? ?-object-filter /filterreg .../? ?/__initblock/?} set e [D eval :__objectparameter] ? {D eval :__objectparameter} $e ? {d1 cget -a} a1 ? {d1 configure -a a2} "" ? {D configure -class ::nx::Class} "" ? {D cget -class} ::nx::Class ? {D cget -cp} 101 ? {D configure -cp 102} "" ? {D cget -cp} 102 } # # check performance of class-level configure and cget # nx::test case object-level-perf { nx::Object create o1 { :object property {a a1} :object property -accessor public {b b1} :object property -accessor protected {c c1} :object property -accessor private {d d1} :object property -accessor none {e e1} :object variable va va1 :object variable -accessor public vb vb1 :object variable -accessor protected vc vc1 :object variable -accessor private vd vd1 :object variable -accessor none ve ve1 } # # just the public properties are accessible via the configure interface # ? {o1 info configure} { ?-e /value/? ?-a /value/? ?-b /value/? ?-object-mixin /mixinreg .../? ?-class /class/? ?-object-filter /filterreg .../? ?/__initblock/?} set e [o1 eval :__objectparameter] ? {o1 eval :__objectparameter} $e ? {o1 cget -a} a1 ? {o1 configure -a a2} "" ? {o1 b} b1 ? {o1 b b2} "b2" ? {o1 configure -class ::nx::Object} "" ? {o1 cget -class} ::nx::Object } nx::test case extend-parent-class-info { nx::Class create Foo nx::Class create Bar -superclass Foo ? {llength [Bar info configure parameters]} 4 # # extend the superclass, subclass should become aware of this # Foo property y ? {llength [Bar info configure parameters]} 5 } nx::test case extend-parent-class-info-cache { nx::Class create Foo nx::Class create Bar -superclass Foo ? {llength [Bar info configure parameters]} 4 # # Let Bar cache the objectparameters, and extend later the # superclass # Bar new Foo property y ? {llength [Bar info configure parameters]} 5 } nx::test case extend-parent-class-info-cache-configure { nx::Class create Foo nx::Class create Bar -superclass Foo ? {llength [Bar info configure parameters]} 4 # # Let Bar cache the objectparameters, and extend later the # superclass # Bar create b1 Foo property y # access obejctparamter indirectly via configure ? {b1 configure -y 2} "" } nx::test case extend-class-mixin-info { nx::Class create Baz nx::Class create Foo -mixin Baz nx::Class create Bar -mixin Foo Bar create bar; # cache becomes hot! ? {llength [Bar info configure parameters]} 4 Foo property y ? {llength [Bar info configure parameters]} 5 Baz property z ? {llength [Bar info configure parameters]} 6 Baz delete property z ? {llength [Bar info configure parameters]} 5 Foo delete property y ? {llength [Bar info configure parameters]} 4 } nx::test case extend-class-mixin-configure { nx::Class create Baz nx::Class create Foo -mixin Baz nx::Class create Bar -mixin Foo Bar create bar; # cache becomes hot! Foo property y bar configure -y 1 ? {bar cget -y} 1 Baz property z bar configure -z 2 ? {bar cget -z} 2 bar configure -y 3 ? {bar cget -y} 3 Bar property w bar configure -w 4 ? {bar cget -w} 4 } nx::test case dynamic-transitive-mixin-info { nx::Class create Foo nx::Class create Bar nx::Class create Baz Bar create bar; # cache object parameters in class Bar Baz create baz; # cache object parameters in class Baz ? {llength [Bar info configure parameters]} 4 Foo property y ? {llength [Bar info configure parameters]} 4 Bar mixin add Foo ? {llength [Bar info configure parameters]} 5 ? {bar configure -y 1} "" ? {llength [Baz info configure parameters]} 4 Baz mixin add Bar ? {llength [Baz info configure parameters]} 5 Foo property z ? {llength [Baz info configure parameters]} 6 ? {baz configure -z 1} "" ? {bar configure -z 1} "" } nx::test case indirect-transitive-mixin-info { nx::Class create M0 nx::Class create M1 -superclass M0 nx::Class create M2 -superclass M1 nx::Class create C nx::Class create D -superclass C C create c1 D create d1 M0 create m0 M1 create m1 M2 create m2 ? {llength [C info configure parameters]} 4 ? {llength [D info configure parameters]} 4 ? {llength [M0 info configure parameters]} 4 ? {llength [M1 info configure parameters]} 4 ? {llength [M2 info configure parameters]} 4 M0 property x ? {llength [M0 info configure parameters]} 5 ? {llength [M1 info configure parameters]} 5 ? {llength [M2 info configure parameters]} 5 C mixin add M2 ? {llength [C info configure parameters]} 5 ? {llength [D info configure parameters]} 5 M1 property y ? {llength [C info configure parameters]} 6 ? {llength [D info configure parameters]} 6 ? {llength [M0 info configure parameters]} 5 ? {llength [M1 info configure parameters]} 6 ? {llength [M2 info configure parameters]} 6 } # # Local variables: # mode: tcl # tcl-indent-level: 2 # indent-tabs-mode: nil # End: