# testing var resolution for namespace-shadowed objects package require XOTcl; xotcl::use xotcl2 package require xotcl::test Test parameter count 1 ::xotcl::alias ::xotcl2::Object eval -objscope ::eval ::xotcl::alias ::xotcl2::Object array -objscope ::array ::xotcl::alias ::xotcl2::Object lappend -objscope ::lappend ::xotcl::alias ::xotcl2::Object incr -objscope ::incr ::xotcl::alias ::xotcl2::Object set -objscope ::set ::xotcl::alias ::xotcl2::Object unset -objscope ::unset ########################################### # Basic tests for var resolution under # per-object namespaces ... ########################################### set ::globalVar 1 Object create o o requireNamespace ? {o info vars} "" ? {info exists ::globalVar} 1 ? {set ::globalVar} 1 ? {o exists globalVar} 0 ? {o array exists globalVar} 0 o array set globalVar {1 2} ? {o exists globalVar} 1 ? {o info vars} globalVar ? {o array exists globalVar} 1 ? {set ::globalVar} 1 ? {o set globalVar(1)} 2 o destroy unset ::globalVar ########################################### # scopes ########################################### Object create o o requireNamespace o eval { # TODO: the next three lines don't seem to work as expected #my requireNamespace #global z #::xotcl::importvar [self] y set x 1 set :y 2 set ::z 3 set [self]::X 4 } set ::o::Y 5 ? {info exists ::z} 1 ? {set ::z} 3 ? {lsort [o info vars]} {X Y x y} ? {o exists x} 1 ? {o exists y} 1 ? {o exists z} 0 ? {o exists X} 1 ? {o exists Y} 1 ? {o set y} 2 o destroy unset ::z ########################################### # mix & match namespace and object interfaces ########################################### Object create o o requireNamespace o set x 1 ? {namespace eval ::o set x} 1 ? {::o set x} 1 ? {namespace eval ::o set x 3} 3 ? {::o set x} 3 ? {namespace eval ::o info exists x} 1 ? {::o unset x} "" 1 ? {namespace eval ::o info exists x} 0 o lappend y 3 ? {namespace eval ::o llength y} 1 ? {namespace eval ::o unset y} "" ? {::o exists y} 0 o destroy ########################################### # array-specific tests ########################################### Object create o o requireNamespace ? {o array exists a} 0 ? {namespace eval ::o array exists a} 0 o array set a {1 2 3 4 5 6} ? {o array exists a} 1 ? {namespace eval ::o array exists a} 1 ? {namespace eval ::o array names a} [::o array names a] ? {namespace eval ::o array size a} [::o array size a] ? {o set a(1) 7} 7 ? {namespace eval ::o array get a 1} {1 7} ? {namespace eval ::o set a(1) 2} 2 ? {o array get a 1} {1 2} ? {::o unset a} "" ? {::o array unset a} "" ? {o array exists a} 0 ? {namespace eval ::o array exists a} 0 o destroy ########################################### # tests on namespace-qualified var names ########################################### Object create o o requireNamespace Object create o::oo o::oo requireNamespace ? {::o set ::x 1} 1 ? {info exists ::x} [set ::x] ? {catch {unset ::x}} 0 ? {::o set ::o::x 1} 1 ? {o exists x} [::o set ::o::x] ? {namespace eval ::o unset x} "" ? {o exists x} 0 # Note, relatively qualified var names (not prefixed with ::*) # are always resolved relative to the per-object namespace ? {catch {::o set o::x 1} msg} 1 ? {::o set oo::x 1} 1 ? {o::oo exists x} [::o set oo::x] ? {o unset oo::x} "" ? {o::oo exists x} 0 o destroy ########################################### # tests on namespace-qualified on objects # without namespaces ########################################### # the tests below fail. We could consider # to require namespaces on the fly in the future Object create o #? {::o set ::o::x 1} 1 #? {o exists x} [::o set ::o::x] #? {namespace eval ::o unset x} "" #? {o exists x} 0 #? {::o set o::x 1} 1 #? {o exists x} [::o set o::x] #? {namespace eval ::o unset x} "" #? {o exists x} 0 o destroy ############################################### # tests for the compiled var resolver on Object ############################################### Object create o o method foo {x} {set :y 2; return ${:x},${:y}} o method bar {} {return ${:x},${:y}} o set x 1 ? {o foo 1} "1,2" "create var y and fetch var x" ? {o bar} "1,2" "fetch two instance variables" ? {o info vars} "x y" # recreate object, check var caching; # we have to recreate bar, so no problem Object create o o set x 1 o method bar {} {return ${:x},${:y}} ? {catch {o bar}} "1" "compiled var y should not exist" o destroy ############################################### # tests for the compiled var resolver on Class ############################################### Class create C -parameter {{x 1}} C create c1 C method foo {x} {set :y 2; return ${:x},${:y}} C method bar {} {return ${:x},${:y}} ? {c1 info vars} "x" ? {c1 foo 1} "1,2" "create var y and fetch var x" ? {c1 bar} "1,2" "fetch two instance variables" ? {c1 info vars} "x y" # recreate object, check var caching; # we do not have to recreate bar, compiled var persists, # change must be detected C create c1 #puts stderr "after recreate" ? {catch {c1 bar}} "1" "compiled var y should not exist" ? {c1 info vars} "x" c1 destroy C destroy ############################################### # tests for the compiled var resolver with eval ############################################### Class create C -parameter {{x 1}} C create c1 C method foo {x} { set :y 2; eval "set :z 3" return ${:x},${:y},${:z} } ? {c1 info vars} "x" ? {c1 foo 1} "1,2,3" ? {c1 info vars} "x y z" C create c1 ? {c1 info vars} "x" C method foo {x} { set cmd set lappend cmd :y lappend cmd 100 eval $cmd return $x,${:y} } C method bar {} {puts ${:x};return [info exists :x],[info exists :y]} C method bar2 {} {if {[info exists :x]} {set :x 1000}; return [info exists :x],[info exists :y]} ? {c1 foo 1} "1,100" ? {c1 bar} "1,1" ? {c1 bar2} "1,1" c1 unset x ? {c1 bar2} "0,1" c1 destroy C destroy ############################################### # tests for the compiled var resolver with eval ############################################### puts "array tests" Class create C C create c1 C method foo {} { array set :a {a 1 b 2 c 3} set :z 100 } ? {c1 info vars} "" c1 foo ? {c1 info vars} "a z" ############################################### # tests for the var resolver ############################################### Class create C C method bar0 {} {return ${:x}} C method bar1 {} {set a ${:x}; return [info exists :x],[info exists :y]} C method bar2 {} {return [info exists :x],[info exists :y]} C method foo {} { array set :a {a 1 b 2 c 3} set :z 100 } C create c1 c1 set x 100 ? {c1 bar0} 100 "single compiled local" ? {c1 bar1} 1,0 "lookup one compiled var and one non-existing" ? {c1 bar2} 1,0 "lookup one non compiled var and one non-existing" C create c2 ? {c2 bar2} 0,0 "lookup two one non-existing, first access to varTable" c1 foo ? {lsort [c1 info vars]} "a x z" "array variable set via resolver" ? {lsort [c1 array names a]} "a b c" "array looks ok" ############################################### # first tests for the cmd resolver ############################################### Class create C C method bar {args} { #puts stderr "[self] bar called with [list $args]" return $args } C forward test %self bar C method foo {} { # this works lappend :r [:bar x 1] lappend :r [:test a b c] # these kind of works, but vars are nowhere.... :set x 1 :incr x 1 :incr x 1 return [lappend :r ${:x}] } C create c3 ? {c3 foo} "{x 1} {a b c} 3" ############################################### # refined tests for the var resolver under # Tcl namespaces parallelling XOTcl objects # (! not declared through requireNamespace !) # e.g., "info hasnamespace" reports 0 rather # than 1 as under "requireNamespace" ############################################### set ::w 1 array set ::tmpArray {key value} Class create ::C ::xotcl::alias ::C Set -objscope ::set ::xotcl::alias ::C Unset -objscope ::unset ::C create ::c namespace eval ::c {} ? {namespace exists ::c} 1 ? {::xotcl::is ::c object} 1 ? {::c info hasnamespace} 0 ? {::c Set w 2; expr {[::c Set w] == $::w}} 0 ? {::c Unset w; info exists ::w} 1 ? {::c Set tmpArray(key) value2; expr {[::c Set tmpArray(key)] == $::tmpArray(key)}} 0 ? {::c Unset tmpArray(key); info exists ::tmpArray(key)} 1 ::c destroy ::C destroy unset ::w unset ::tmpArray ################################################## # Testing aliases for eval with and without flags # # -objscope, # -nonleaf # # with a required namespace and without ################################################## Test case eval-variants ::xotcl::alias ::xotcl2::Object eval -objscope ::eval ::xotcl::alias ::xotcl2::Object softeval -nonleaf ::eval ::xotcl::alias ::xotcl2::Object softeval2 ::eval Object create o { set xxx 1 set :x 1 } ? {o exists x} 1 ? {o exists xxx} 0 # eval does an objcope, all vars are instance variables o eval { set aaa 1 set :a 1 } ? {o exists a} 1 ? {o exists aaa} 1 # softeval should behave like the creation initcmd (just set dot vars) o softeval { set bbb 1 set :b 1 } ? {o exists b} 1 ? {o exists bbb} 0 # softeval2 never sets variables o softeval2 { set zzz 1 set :z 1 } ? {o exists z} 0 ? {o exists zzz} 0 ? {lsort [o info vars]} "a aaa b x" o destroy # now with namespace Object create o o requireNamespace # eval does an objcope, all vars are instance variables o eval { set ccc 1 set :c 1 } ? {o exists c} 1 ? {o exists ccc} 1 # softeval2 should behave like the creation initcmd (just set dot vars) o softeval { set ddd 1 set :d 1 } ? {o exists d} 1 ? {o exists ddd} 1 ;# TODO: should be 0 # softeval2 never sets variables o softeval2 { set zzz 1 set :z 1 } ? {o exists z} 0 ? {o exists zzz} 0 ? {lsort [o info vars]} "c ccc d ddd" o destroy ################################################## # The same as above, but with some global vars. # The global vars should not influence the behavior. ################################################## Test case with-global-vars foreach var {.x x xxx :a a aaa :b b bbb :c c ccc :d d ddd :z z zzz} {set $var 1} Object create o { set xxx 1 set :x 1 } ? {o exists x} 1 ? {o exists xxx} 0 # eval does an objcope, all vars are instance variables o eval { set aaa 1 set :a 1 } ? {o exists a} 1 ? {o exists aaa} 1 # softeval should behave like the creation initcmd (just set dot vars) o softeval { set bbb 1 set :b 1 } ? {o exists b} 1 ? {o exists bbb} 0 # softeval2 never sets variables o softeval2 { set zzz 1 set :z 1 } ? {o exists z} 0 ? {o exists zzz} 0 ? {lsort [o info vars]} "a aaa b x" o destroy # now with namespace Object create o o requireNamespace # eval does an objcope, all vars are instance variables o eval { set ccc 1 set :c 1 } ? {o exists c} 1 ? {o exists ccc} 1 # softeval2 should behave like the creation initcmd (just set dot vars) o softeval { set ddd 1 set :d 1 } ? {o exists d} 1 ? {o exists ddd} 0 # softeval2 never sets variables o softeval2 { set zzz 1 set :z 1 } ? {o exists z} 0 ? {o exists zzz} 0 ? {lsort [o info vars]} "c ccc d" o destroy ################################################## # dotCmd tests ################################################## Test case dotcmd set C 0 proc bar {} {incr ::C} Class create Foo { :method init {} {set :c 0} :method callDot1 {} {:bar} :method callDot2 {} {:bar} :method callDot3 {} {:bar; ::bar; :bar} :method bar {} {incr :c} } Foo create f1 f1 callDot1 ? {set ::C} 0 ? {f1 eval {set :c}} 1 # call via callback after 1 {f1 callDot2} after 10 {set ::X 1} vwait X ? {set ::C} 0 ? {f1 eval {set :c}} 2 # call via callback, call :bar via .. from method after 1 {f1 callDot3} after 10 {set ::X 2} vwait X ? {set ::C} 1 ? {f1 eval {set :c}} 4 ################################################## # test for namespace resolver ################################################## Test case nsresolver namespace eval module { Class create C Class create M1 Class create M2 C mixin M1 ? {::xotcl::relation C class-mixin} "::module::M1" puts stderr "mixin add M" C mixin add M2 ? {::xotcl::relation C class-mixin} "::module::M2 ::module::M1" }