diff options
| -rw-r--r-- | tests/namespace-old.test | 169 |
1 files changed, 140 insertions, 29 deletions
diff --git a/tests/namespace-old.test b/tests/namespace-old.test index 1d8ba31..1d6a805 100644 --- a/tests/namespace-old.test +++ b/tests/namespace-old.test @@ -57,6 +57,12 @@ test namespace-old-1.9 {add elements to a namespace} { } } } {} +namespace eval test_ns_simple { + variable test_ns_x 0 + proc test {test_ns_x} { + return "test: $test_ns_x" + } +} test namespace-old-1.10 {commands in a namespace} { namespace eval test_ns_simple { info commands [namespace current]::*} } {::test_ns_simple::test} @@ -74,6 +80,12 @@ test namespace-old-1.13 {add to an existing namespace} { } } } "" +namespace eval test_ns_simple { + variable test_ns_y 123 + proc _backdoor {cmd} { + eval $cmd + } +} test namespace-old-1.14 {commands in a namespace} { lsort [namespace eval test_ns_simple {info commands [namespace current]::*}] } {::test_ns_simple::_backdoor ::test_ns_simple::test} @@ -128,6 +140,8 @@ test namespace-old-1.26 {namespace qualifiers are okay after $'s} { test namespace-old-1.27 {can create commands with null names} { proc test_ns_simple:: {args} {return $args} } {} +# Redeclare; later tests depend on it +proc test_ns_simple:: {args} {return $args} # ----------------------------------------------------------------------- # TEST: using "info" in namespace contexts @@ -212,6 +226,11 @@ test namespace-old-4.3 {command "namespace delete" doesn't support patterns} { } list [catch $cmd msg] $msg } {1 {unknown namespace "ns*" in namespace delete command}} +namespace eval test_ns_delete { + namespace eval ns1 {} + namespace eval ns2 {} + namespace eval another {} +} test namespace-old-4.4 {command "namespace delete" handles multiple args} { set cmd { namespace eval test_ns_delete { @@ -256,6 +275,24 @@ test namespace-old-5.3 {namespace qualifiers work in namespace command} { [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \ [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}] } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2} +set ::test_ns_var_global "var in ::" +proc test_ns_cmd_global {} {return "cmd in ::"} +namespace eval test_ns_hier1 { + variable test_ns_var_hier1 "particular to hier1" + proc test_ns_cmd_hier1 {} {return "particular to hier1"} + variable test_ns_level 1 + proc test_ns_show {} {return "[namespace current]: 1"} + namespace eval test_ns_hier2 { + variable test_ns_var_hier2 "particular to hier2" + proc test_ns_cmd_hier2 {} {return "particular to hier2"} + variable test_ns_level 2 + proc test_ns_show {} {return "[namespace current]: 2"} + namespace eval test_ns_hier3a {} + namespace eval test_ns_hier3b {} + } + namespace eval test_ns_hier2a {} + namespace eval test_ns_hier2b {} +} test namespace-old-5.4 {nested namespaces can access global namespace} { list [namespace eval test_ns_hier1 {set test_ns_var_global}] \ [namespace eval test_ns_hier1 {test_ns_cmd_global}] \ @@ -331,16 +368,12 @@ test namespace-old-5.21 {querying namespace parent for explicit namespace} { # ----------------------------------------------------------------------- # TEST: name resolution and caching # ----------------------------------------------------------------------- +set trigger {namespace eval test_ns_cache2 {namespace current}} +set trigger2 {namespace eval test_ns_cache2::test_ns_cache3 {namespace current}} test namespace-old-6.1 {relative ns names only looked up in current ns} { namespace eval test_ns_cache1 {} namespace eval test_ns_cache2 {} namespace eval test_ns_cache2::test_ns_cache3 {} - set trigger { - namespace eval test_ns_cache2 {namespace current} - } - set trigger2 { - namespace eval test_ns_cache2::test_ns_cache3 {namespace current} - } list [namespace eval test_ns_cache1 $trigger] \ [namespace eval test_ns_cache1 $trigger2] } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3} @@ -354,20 +387,19 @@ test namespace-old-6.3 {relative ns names only looked up in current ns} { list [namespace eval test_ns_cache1 $trigger] \ [namespace eval test_ns_cache1 $trigger2] } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3} +namespace eval test_ns_cache1::test_ns_cache2 {} test namespace-old-6.4 {relative ns names only looked up in current ns} { namespace delete test_ns_cache1::test_ns_cache2 list [namespace eval test_ns_cache1 $trigger] \ [namespace eval test_ns_cache1 $trigger2] } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3} +namespace eval test_ns_cache1 { + proc trigger {} {test_ns_cache_cmd} +} test namespace-old-6.5 {define test commands} { proc test_ns_cache_cmd {} { return "global version" } - namespace eval test_ns_cache1 { - proc trigger {} { - test_ns_cache_cmd - } - } test_ns_cache1::trigger } {global version} test namespace-old-6.6 {one-level check for command shadowing} { @@ -376,24 +408,36 @@ test namespace-old-6.6 {one-level check for command shadowing} { } test_ns_cache1::trigger } {cache1 version} -test namespace-old-6.7 {renaming commands changes command epoch} { - namespace eval test_ns_cache1 { - rename test_ns_cache_cmd test_ns_new +proc test_ns_cache_cmd {} { + return "global version" +} +test namespace-old-6.7 {renaming commands changes command epoch} -setup { + proc test_ns_cache1::test_ns_cache_cmd {} { + return "cache1 version" } - test_ns_cache1::trigger -} {global version} -test namespace-old-6.8 {renaming back handles shadowing} { - namespace eval test_ns_cache1 { - rename test_ns_new test_ns_cache_cmd +} -body { + list [test_ns_cache1::trigger] \ + [namespace eval test_ns_cache1 {rename test_ns_cache_cmd test_ns_new}]\ + [test_ns_cache1::trigger] +} -result {{cache1 version} {} {global version}} +test namespace-old-6.8 {renaming back handles shadowing} -setup { + proc test_ns_cache1::test_ns_new {} { + return "cache1 version" } - test_ns_cache1::trigger -} {cache1 version} -test namespace-old-6.9 {deleting commands changes command epoch} { - namespace eval test_ns_cache1 { - rename test_ns_cache_cmd "" +} -body { + list [test_ns_cache1::trigger] \ + [namespace eval test_ns_cache1 {rename test_ns_new test_ns_cache_cmd}]\ + [test_ns_cache1::trigger] +} -result {{global version} {} {cache1 version}} +test namespace-old-6.9 {deleting commands changes command epoch} -setup { + proc test_ns_cache1::test_ns_cache_cmd {} { + return "cache1 version" } - test_ns_cache1::trigger -} {global version} +} -body { + list [test_ns_cache1::trigger] \ + [namespace eval test_ns_cache1 {rename test_ns_cache_cmd ""}] \ + [test_ns_cache1::trigger] +} -result {{cache1 version} {} {global version}} test namespace-old-6.10 {define test namespaces} { namespace eval test_ns_cache2 { proc test_ns_cache_cmd {} { @@ -412,6 +456,12 @@ test namespace-old-6.10 {define test namespaces} { } list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger] } {{global cache2 version} {global version}} +namespace eval test_ns_cache1 { + proc trigger {} { test_ns_cache2::test_ns_cache_cmd } + namespace eval test_ns_cache2 { + proc trigger {} { test_ns_cache_cmd } + } +} test namespace-old-6.11 {commands affect all parent namespaces} { proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} { return "cache2 version" @@ -423,18 +473,22 @@ test namespace-old-6.12 {define test variables} { set trigger {set test_ns_cache_var} namespace eval test_ns_cache1 $trigger } {global version} + set trigger {set test_ns_cache_var} test namespace-old-6.13 {one-level check for variable shadowing} { namespace eval test_ns_cache1 { variable test_ns_cache_var "cache1 version" } namespace eval test_ns_cache1 $trigger } {cache1 version} +variable ::test_ns_cache_var "global version" test namespace-old-6.14 {deleting variables changes variable epoch} { namespace eval test_ns_cache1 { - unset test_ns_cache_var + variable test_ns_cache_var "cache1 version" } - namespace eval test_ns_cache1 $trigger -} {global version} + list [namespace eval test_ns_cache1 $trigger] \ + [namespace eval test_ns_cache1 {unset test_ns_cache_var}] \ + [namespace eval test_ns_cache1 $trigger] +} {{cache1 version} {} {global version}} test namespace-old-6.15 {define test namespaces} { namespace eval test_ns_cache2 { variable test_ns_cache_var "global cache2 version" @@ -443,6 +497,7 @@ test namespace-old-6.15 {define test namespaces} { list [namespace eval test_ns_cache1 $trigger2] \ [namespace eval test_ns_cache1::test_ns_cache2 $trigger] } {{global cache2 version} {global version}} +set trigger2 {set test_ns_cache2::test_ns_cache_var} test namespace-old-6.16 {public variables affect all parent namespaces} { variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version" list [namespace eval test_ns_cache1 $trigger2] \ @@ -467,6 +522,7 @@ test namespace-old-6.19 {querying: namespace which -command} { test namespace-old-6.20 {command "namespace which" may not find commands} { namespace eval test_ns_cache1 {namespace which -command xyzzy} } {} +variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version" test namespace-old-6.21 {querying: namespace which -variable} { namespace eval test_ns_cache1::test_ns_cache2 { namespace which -variable test_ns_cache_var @@ -493,6 +549,18 @@ test namespace-old-7.1 {define test namespace} { } } } {} +namespace eval test_ns_uplevel { + variable x 0 + variable y 1 + proc show_vars {num} { + return [uplevel $num {info vars}] + } + proc test_uplevel {num} { + set a 0 + set b 1 + namespace eval ::test_ns_uplevel " return \[show_vars $num\] " + } +} test namespace-old-7.2 {uplevel can access namespace call frame} { list [expr {"x" in [test_ns_uplevel::test_uplevel 1]}] \ [expr {"y" in [test_ns_uplevel::test_uplevel 1]}] @@ -526,6 +594,17 @@ test namespace-old-7.8 {namespaces are included in the call stack} { } } } {} +namespace eval test_ns_upvar { + variable scope "test_ns_upvar" + proc show_val {var num} { + upvar $num $var x + return $x + } + proc test_upvar {num} { + set scope "test_ns_upvar::test_upvar" + namespace eval ::test_ns_upvar " return \[show_val scope $num\] " + } +} test namespace-old-7.9 {upvar can access namespace call frame} { test_ns_upvar::test_upvar 1 } {test_ns_upvar} @@ -581,6 +660,15 @@ test namespace-old-9.3 {define test namespaces for import} { } lsort [info commands test_ns_export::*] } {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6} +namespace eval test_ns_export { + namespace export cmd1 cmd2 cmd3 + proc cmd1 {args} {return "cmd1: $args"} + proc cmd2 {args} {return "cmd2: $args"} + proc cmd3 {args} {return "cmd3: $args"} + proc cmd4 {args} {return "cmd4: $args"} + proc cmd5 {args} {return "cmd5: $args"} + proc cmd6 {args} {return "cmd6: $args"} +} test namespace-old-9.4 {check export status} { set x "" namespace eval test_ns_import { @@ -592,6 +680,10 @@ test namespace-old-9.4 {check export status} { } set x } {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3} +namespace eval test_ns_import { + namespace export cmd1 cmd2 + namespace import ::test_ns_export::* +} test namespace-old-9.5 {empty import list in "namespace import" command} { namespace eval test_ns_import_empty { namespace import ::test_ns_export::* @@ -615,6 +707,7 @@ test namespace-old-9.8 {only exported commands are imported} { namespace import test_ns_import::cmd* set x [lsort [info commands cmd*]] } {cmd1 cmd2} +namespace import test_ns_import::cmd* test namespace-old-9.9 {imported commands work just the same as original} { list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6] } {{cmd1: test 1 2 3} {cmd1: test 4 5 6}} @@ -629,10 +722,19 @@ test namespace-old-9.10 {commands can be imported from many namespaces} { namespace import test_ns_import2::* lsort [concat [info commands cmd*] [info commands ncmd*]] } {cmd1 cmd2 ncmd ncmd1 ncmd2} +namespace eval test_ns_import2 { + namespace export ncmd ncmd1 ncmd2 + proc ncmd {args} {return "ncmd: $args"} + proc ncmd1 {args} {return "ncmd1: $args"} + proc ncmd2 {args} {return "ncmd2: $args"} + proc ncmd3 {args} {return "ncmd3: $args"} +} +namespace import test_ns_import2::* test namespace-old-9.11 {imported commands can be removed by deleting them} { rename cmd1 "" lsort [concat [info commands cmd*] [info commands ncmd*]] } {cmd2 ncmd ncmd1 ncmd2} +catch { rename cmd1 "" } test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} { list [catch {namespace forget xyzzy::*} msg] $msg } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}} @@ -653,6 +755,7 @@ test namespace-old-9.15 {existing commands can't be overwritten} { [cmd1 3 5] } {1 {can't import command "cmd1": already exists} 8} test namespace-old-9.16 {use "-force" option to override existing commands} { + proc cmd1 {x y} { return [expr $x+$y] } list [cmd1 3 5] \ [namespace import -force test_ns_import::cmd?] \ [cmd1 3 5] @@ -711,10 +814,18 @@ test namespace-old-10.6 {with many args, each "scope" adds new args} { set sval [namespace eval test_ns_inscope {namespace code {one two}}] namespace code "$sval three" } {::namespace inscope ::test_ns_inscope {one two} three} +namespace eval test_ns_inscope { + proc show {args} { + return "show: $args" + } +} test namespace-old-10.7 {scoped commands work with eval} { set cref [namespace eval test_ns_inscope {namespace code show}] list [eval $cref "a" "b c" "d e f"] } {{show: a b c d e f}} +namespace eval test_ns_inscope { + variable x "x-value" +} test namespace-old-10.8 {scoped commands execute in namespace context} { set cref [namespace eval test_ns_inscope { namespace code {set x "some new value"} |