os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/namespace-old.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/namespace-old.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,864 @@
1.4 +# Functionality covered: this file contains slightly modified versions of
1.5 +# the original tests written by Mike McLennan of Lucent Technologies for
1.6 +# the procedures in tclNamesp.c that implement Tcl's basic support for
1.7 +# namespaces. Other namespace-related tests appear in namespace.test
1.8 +# and variable.test.
1.9 +#
1.10 +# Sourcing this file into Tcl runs the tests and generates output for
1.11 +# errors. No output means no errors were found.
1.12 +#
1.13 +# Copyright (c) 1997 Sun Microsystems, Inc.
1.14 +# Copyright (c) 1997 Lucent Technologies
1.15 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.16 +#
1.17 +# See the file "license.terms" for information on usage and redistribution
1.18 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.19 +#
1.20 +# RCS: @(#) $Id: namespace-old.test,v 1.6 2001/04/07 02:11:19 msofer Exp $
1.21 +
1.22 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.23 + package require tcltest
1.24 + namespace import -force ::tcltest::*
1.25 +}
1.26 +
1.27 +# Clear out any namespaces called test_ns_*
1.28 +catch {eval namespace delete [namespace children :: test_ns_*]}
1.29 +
1.30 +test namespace-old-1.1 {usage for "namespace" command} {
1.31 + list [catch {namespace} msg] $msg
1.32 +} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
1.33 +
1.34 +test namespace-old-1.2 {global namespace's name is "::" or {}} {
1.35 + list [namespace current] [namespace eval {} {namespace current}]
1.36 +} {:: ::}
1.37 +
1.38 +test namespace-old-1.3 {usage for "namespace eval"} {
1.39 + list [catch {namespace eval} msg] $msg
1.40 +} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
1.41 +
1.42 +test namespace-old-1.4 {create new namespaces} {
1.43 + list [lsort [namespace children :: test_ns_simple*]] \
1.44 + [namespace eval test_ns_simple {}] \
1.45 + [namespace eval test_ns_simple2 {}] \
1.46 + [lsort [namespace children :: test_ns_simple*]]
1.47 +} {{} {} {} {::test_ns_simple ::test_ns_simple2}}
1.48 +
1.49 +test namespace-old-1.5 {access a new namespace} {
1.50 + namespace eval test_ns_simple { namespace current }
1.51 +} {::test_ns_simple}
1.52 +
1.53 +test namespace-old-1.6 {usage for "namespace eval"} {
1.54 + list [catch {namespace eval} msg] $msg
1.55 +} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
1.56 +
1.57 +test namespace-old-1.7 {usage for "namespace eval"} {
1.58 + list [catch {namespace eval test_ns_xyzzy} msg] $msg
1.59 +} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
1.60 +
1.61 +test namespace-old-1.8 {command "namespace eval" concatenates args} {
1.62 + namespace eval test_ns_simple namespace current
1.63 +} {::test_ns_simple}
1.64 +
1.65 +test namespace-old-1.9 {add elements to a namespace} {
1.66 + namespace eval test_ns_simple {
1.67 + variable test_ns_x 0
1.68 + proc test {test_ns_x} {
1.69 + return "test: $test_ns_x"
1.70 + }
1.71 + }
1.72 +} {}
1.73 +
1.74 +test namespace-old-1.10 {commands in a namespace} {
1.75 + namespace eval test_ns_simple { info commands [namespace current]::*}
1.76 +} {::test_ns_simple::test}
1.77 +
1.78 +test namespace-old-1.11 {variables in a namespace} {
1.79 + namespace eval test_ns_simple { info vars [namespace current]::* }
1.80 +} {::test_ns_simple::test_ns_x}
1.81 +
1.82 +test namespace-old-1.12 {global vars are separate from locals vars} {
1.83 + list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]
1.84 +} {{test: 123} 0}
1.85 +
1.86 +test namespace-old-1.13 {add to an existing namespace} {
1.87 + namespace eval test_ns_simple {
1.88 + variable test_ns_y 123
1.89 + proc _backdoor {cmd} {
1.90 + eval $cmd
1.91 + }
1.92 + }
1.93 +} ""
1.94 +
1.95 +test namespace-old-1.14 {commands in a namespace} {
1.96 + lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
1.97 +} {::test_ns_simple::_backdoor ::test_ns_simple::test}
1.98 +
1.99 +test namespace-old-1.15 {variables in a namespace} {
1.100 + lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]
1.101 +} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
1.102 +test namespace-old-1.16 {variables in a namespace} {
1.103 + lsort [info vars test_ns_simple::*]
1.104 +} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
1.105 +
1.106 +test namespace-old-1.17 {commands in a namespace are hidden} {
1.107 + list [catch "_backdoor {return yes!}" msg] $msg
1.108 +} {1 {invalid command name "_backdoor"}}
1.109 +test namespace-old-1.18 {using namespace qualifiers} {
1.110 + list [catch "test_ns_simple::_backdoor {return yes!}" msg] $msg
1.111 +} {0 yes!}
1.112 +test namespace-old-1.19 {using absolute namespace qualifiers} {
1.113 + list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg
1.114 +} {0 yes!}
1.115 +
1.116 +test namespace-old-1.20 {variables in a namespace are hidden} {
1.117 + list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg
1.118 +} {1 {can't read "test_ns_x": no such variable} 1 {can't read "test_ns_y": no such variable}}
1.119 +test namespace-old-1.21 {using namespace qualifiers} {
1.120 + list [catch "set test_ns_simple::test_ns_x" msg] $msg \
1.121 + [catch "set test_ns_simple::test_ns_y" msg] $msg
1.122 +} {0 0 0 123}
1.123 +test namespace-old-1.22 {using absolute namespace qualifiers} {
1.124 + list [catch "set ::test_ns_simple::test_ns_x" msg] $msg \
1.125 + [catch "set ::test_ns_simple::test_ns_y" msg] $msg
1.126 +} {0 0 0 123}
1.127 +test namespace-old-1.23 {variables can be accessed within a namespace} {
1.128 + test_ns_simple::_backdoor {
1.129 + variable test_ns_x
1.130 + variable test_ns_y
1.131 + return "$test_ns_x $test_ns_y"
1.132 + }
1.133 +} {0 123}
1.134 +
1.135 +test namespace-old-1.24 {setting global variables} {
1.136 + test_ns_simple::_backdoor {variable test_ns_x; set test_ns_x "new val"}
1.137 + namespace eval test_ns_simple {set test_ns_x}
1.138 +} {new val}
1.139 +
1.140 +test namespace-old-1.25 {qualified variables don't need a global declaration} {
1.141 + namespace eval test_ns_another { variable test_ns_x 456 }
1.142 + set cmd {set ::test_ns_another::test_ns_x}
1.143 + list [catch {test_ns_simple::_backdoor "$cmd some-value"} msg] $msg \
1.144 + [eval $cmd]
1.145 +} {0 some-value some-value}
1.146 +
1.147 +test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
1.148 + namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }
1.149 + set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}
1.150 + list [test_ns_simple::_backdoor $cmd] [eval $cmd]
1.151 +} {{12 34} {12 34}}
1.152 +
1.153 +test namespace-old-1.27 {can create commands with null names} {
1.154 + proc test_ns_simple:: {args} {return $args}
1.155 +} {}
1.156 +
1.157 +# -----------------------------------------------------------------------
1.158 +# TEST: using "info" in namespace contexts
1.159 +# -----------------------------------------------------------------------
1.160 +test namespace-old-2.1 {querying: info commands} {
1.161 + lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]
1.162 +} {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}
1.163 +
1.164 +test namespace-old-2.2 {querying: info procs} {
1.165 + lsort [test_ns_simple::_backdoor {info procs}]
1.166 +} {{} _backdoor test}
1.167 +
1.168 +test namespace-old-2.3 {querying: info vars} {
1.169 + lsort [info vars test_ns_simple::*]
1.170 +} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
1.171 +
1.172 +test namespace-old-2.4 {querying: info vars} {
1.173 + lsort [test_ns_simple::_backdoor {info vars [namespace current]::*}]
1.174 +} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
1.175 +
1.176 +test namespace-old-2.5 {querying: info locals} {
1.177 + lsort [test_ns_simple::_backdoor {info locals}]
1.178 +} {cmd}
1.179 +
1.180 +test namespace-old-2.6 {querying: info exists} {
1.181 + test_ns_simple::_backdoor {info exists test_ns_x}
1.182 +} {0}
1.183 +
1.184 +test namespace-old-2.7 {querying: info exists} {
1.185 + test_ns_simple::_backdoor {info exists cmd}
1.186 +} {1}
1.187 +
1.188 +test namespace-old-2.8 {querying: info args} {
1.189 + info args test_ns_simple::_backdoor
1.190 +} {cmd}
1.191 +
1.192 +test namespace-old-2.9 {querying: info body} {
1.193 + string trim [info body test_ns_simple::test]
1.194 +} {return "test: $test_ns_x"}
1.195 +
1.196 +# -----------------------------------------------------------------------
1.197 +# TEST: namespace qualifiers, namespace tail
1.198 +# -----------------------------------------------------------------------
1.199 +test namespace-old-3.1 {usage for "namespace qualifiers"} {
1.200 + list [catch "namespace qualifiers" msg] $msg
1.201 +} {1 {wrong # args: should be "namespace qualifiers string"}}
1.202 +
1.203 +test namespace-old-3.2 {querying: namespace qualifiers} {
1.204 + list [namespace qualifiers ""] \
1.205 + [namespace qualifiers ::] \
1.206 + [namespace qualifiers x] \
1.207 + [namespace qualifiers ::x] \
1.208 + [namespace qualifiers foo::x] \
1.209 + [namespace qualifiers ::foo::bar::xyz]
1.210 +} {{} {} {} {} foo ::foo::bar}
1.211 +
1.212 +test namespace-old-3.3 {usage for "namespace tail"} {
1.213 + list [catch "namespace tail" msg] $msg
1.214 +} {1 {wrong # args: should be "namespace tail string"}}
1.215 +
1.216 +test namespace-old-3.4 {querying: namespace tail} {
1.217 + list [namespace tail ""] \
1.218 + [namespace tail ::] \
1.219 + [namespace tail x] \
1.220 + [namespace tail ::x] \
1.221 + [namespace tail foo::x] \
1.222 + [namespace tail ::foo::bar::xyz]
1.223 +} {{} {} x x x xyz}
1.224 +
1.225 +# -----------------------------------------------------------------------
1.226 +# TEST: delete commands and namespaces
1.227 +# -----------------------------------------------------------------------
1.228 +test namespace-old-4.1 {define test namespaces} {
1.229 + namespace eval test_ns_delete {
1.230 + namespace eval ns1 {
1.231 + variable var1 1
1.232 + proc cmd1 {} {return "cmd1"}
1.233 + }
1.234 + namespace eval ns2 {
1.235 + variable var2 2
1.236 + proc cmd2 {} {return "cmd2"}
1.237 + }
1.238 + namespace eval another {}
1.239 + lsort [namespace children]
1.240 + }
1.241 +} {::test_ns_delete::another ::test_ns_delete::ns1 ::test_ns_delete::ns2}
1.242 +
1.243 +test namespace-old-4.2 {it's okay to invoke "namespace delete" with no args} {
1.244 + list [catch {namespace delete} msg] $msg
1.245 +} {0 {}}
1.246 +
1.247 +test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
1.248 + set cmd {
1.249 + namespace eval test_ns_delete {namespace delete ns*}
1.250 + }
1.251 + list [catch $cmd msg] $msg
1.252 +} {1 {unknown namespace "ns*" in namespace delete command}}
1.253 +
1.254 +test namespace-old-4.4 {command "namespace delete" handles multiple args} {
1.255 + set cmd {
1.256 + namespace eval test_ns_delete {
1.257 + eval namespace delete \
1.258 + [namespace children [namespace current] ns?]
1.259 + }
1.260 + }
1.261 + list [catch $cmd msg] $msg [namespace children test_ns_delete]
1.262 +} {0 {} ::test_ns_delete::another}
1.263 +
1.264 +# -----------------------------------------------------------------------
1.265 +# TEST: namespace hierarchy
1.266 +# -----------------------------------------------------------------------
1.267 +test namespace-old-5.1 {define nested namespaces} {
1.268 + set test_ns_var_global "var in ::"
1.269 + proc test_ns_cmd_global {} {return "cmd in ::"}
1.270 +
1.271 + namespace eval test_ns_hier1 {
1.272 + set test_ns_var_hier1 "particular to hier1"
1.273 + proc test_ns_cmd_hier1 {} {return "particular to hier1"}
1.274 +
1.275 + set test_ns_level 1
1.276 + proc test_ns_show {} {return "[namespace current]: 1"}
1.277 +
1.278 + namespace eval test_ns_hier2 {
1.279 + set test_ns_var_hier2 "particular to hier2"
1.280 + proc test_ns_cmd_hier2 {} {return "particular to hier2"}
1.281 +
1.282 + set test_ns_level 2
1.283 + proc test_ns_show {} {return "[namespace current]: 2"}
1.284 +
1.285 + namespace eval test_ns_hier3a {}
1.286 + namespace eval test_ns_hier3b {}
1.287 + }
1.288 +
1.289 + namespace eval test_ns_hier2a {}
1.290 + namespace eval test_ns_hier2b {}
1.291 + }
1.292 +} {}
1.293 +
1.294 +test namespace-old-5.2 {namespaces can be nested} {
1.295 + list [namespace eval test_ns_hier1 {namespace current}] \
1.296 + [namespace eval test_ns_hier1 {
1.297 + namespace eval test_ns_hier2 {namespace current}
1.298 + }]
1.299 +} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
1.300 +
1.301 +test namespace-old-5.3 {namespace qualifiers work in namespace command} {
1.302 + list [namespace eval ::test_ns_hier1 {namespace current}] \
1.303 + [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
1.304 + [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
1.305 +} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
1.306 +
1.307 +test namespace-old-5.4 {nested namespaces can access global namespace} {
1.308 + list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
1.309 + [namespace eval test_ns_hier1 {test_ns_cmd_global}] \
1.310 + [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
1.311 + [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
1.312 +} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
1.313 +
1.314 +test namespace-old-5.5 {variables in different namespaces don't conflict} {
1.315 + list [set test_ns_hier1::test_ns_level] \
1.316 + [set test_ns_hier1::test_ns_hier2::test_ns_level]
1.317 +} {1 2}
1.318 +
1.319 +test namespace-old-5.6 {commands in different namespaces don't conflict} {
1.320 + list [test_ns_hier1::test_ns_show] \
1.321 + [test_ns_hier1::test_ns_hier2::test_ns_show]
1.322 +} {{::test_ns_hier1: 1} {::test_ns_hier1::test_ns_hier2: 2}}
1.323 +
1.324 +test namespace-old-5.7 {nested namespaces don't see variables in parent} {
1.325 + set cmd {
1.326 + namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_hier1}
1.327 + }
1.328 + list [catch $cmd msg] $msg
1.329 +} {1 {can't read "test_ns_var_hier1": no such variable}}
1.330 +
1.331 +test namespace-old-5.8 {nested namespaces don't see commands in parent} {
1.332 + set cmd {
1.333 + namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_hier1}
1.334 + }
1.335 + list [catch $cmd msg] $msg
1.336 +} {1 {invalid command name "test_ns_cmd_hier1"}}
1.337 +
1.338 +test namespace-old-5.9 {usage for "namespace children"} {
1.339 + list [catch {namespace children test_ns_hier1 y z} msg] $msg
1.340 +} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
1.341 +
1.342 +test namespace-old-5.10 {command "namespace children" must get valid namespace} {
1.343 + list [catch {namespace children xyzzy} msg] $msg
1.344 +} {1 {unknown namespace "xyzzy" in namespace children command}}
1.345 +
1.346 +test namespace-old-5.11 {querying namespace children} {
1.347 + lsort [namespace children :: test_ns_hier*]
1.348 +} {::test_ns_hier1}
1.349 +
1.350 +test namespace-old-5.12 {querying namespace children} {
1.351 + lsort [namespace children test_ns_hier1]
1.352 +} {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
1.353 +
1.354 +test namespace-old-5.13 {querying namespace children} {
1.355 + lsort [namespace eval test_ns_hier1 {namespace children}]
1.356 +} {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
1.357 +
1.358 +test namespace-old-5.14 {querying namespace children} {
1.359 + lsort [namespace children test_ns_hier1::test_ns_hier2]
1.360 +} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
1.361 +
1.362 +test namespace-old-5.15 {querying namespace children} {
1.363 + lsort [namespace eval test_ns_hier1::test_ns_hier2 {namespace children}]
1.364 +} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
1.365 +
1.366 +test namespace-old-5.16 {querying namespace children with patterns} {
1.367 + lsort [namespace children test_ns_hier1::test_ns_hier2 test_ns_*]
1.368 +} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
1.369 +
1.370 +test namespace-old-5.17 {querying namespace children with patterns} {
1.371 + lsort [namespace children test_ns_hier1::test_ns_hier2 *b]
1.372 +} {::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
1.373 +
1.374 +test namespace-old-5.18 {usage for "namespace parent"} {
1.375 + list [catch {namespace parent x y} msg] $msg
1.376 +} {1 {wrong # args: should be "namespace parent ?name?"}}
1.377 +
1.378 +test namespace-old-5.19 {command "namespace parent" must get valid namespace} {
1.379 + list [catch {namespace parent xyzzy} msg] $msg
1.380 +} {1 {unknown namespace "xyzzy" in namespace parent command}}
1.381 +
1.382 +test namespace-old-5.20 {querying namespace parent} {
1.383 + list [namespace eval :: {namespace parent}] \
1.384 + [namespace eval test_ns_hier1 {namespace parent}] \
1.385 + [namespace eval test_ns_hier1::test_ns_hier2 {namespace parent}] \
1.386 + [namespace eval test_ns_hier1::test_ns_hier2::test_ns_hier3a {namespace parent}] \
1.387 +} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
1.388 +
1.389 +test namespace-old-5.21 {querying namespace parent for explicit namespace} {
1.390 + list [namespace parent ::] \
1.391 + [namespace parent test_ns_hier1] \
1.392 + [namespace parent test_ns_hier1::test_ns_hier2] \
1.393 + [namespace parent test_ns_hier1::test_ns_hier2::test_ns_hier3a]
1.394 +} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
1.395 +
1.396 +# -----------------------------------------------------------------------
1.397 +# TEST: name resolution and caching
1.398 +# -----------------------------------------------------------------------
1.399 +test namespace-old-6.1 {relative ns names only looked up in current ns} {
1.400 + namespace eval test_ns_cache1 {}
1.401 + namespace eval test_ns_cache2 {}
1.402 + namespace eval test_ns_cache2::test_ns_cache3 {}
1.403 + set trigger {
1.404 + namespace eval test_ns_cache2 {namespace current}
1.405 + }
1.406 + set trigger2 {
1.407 + namespace eval test_ns_cache2::test_ns_cache3 {namespace current}
1.408 + }
1.409 + list [namespace eval test_ns_cache1 $trigger] \
1.410 + [namespace eval test_ns_cache1 $trigger2]
1.411 +} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
1.412 +
1.413 +test namespace-old-6.2 {relative ns names only looked up in current ns} {
1.414 + namespace eval test_ns_cache1::test_ns_cache2 {}
1.415 + list [namespace eval test_ns_cache1 $trigger] \
1.416 + [namespace eval test_ns_cache1 $trigger2]
1.417 +} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
1.418 +
1.419 +test namespace-old-6.3 {relative ns names only looked up in current ns} {
1.420 + namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {}
1.421 + list [namespace eval test_ns_cache1 $trigger] \
1.422 + [namespace eval test_ns_cache1 $trigger2]
1.423 +} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
1.424 +
1.425 +test namespace-old-6.4 {relative ns names only looked up in current ns} {
1.426 + namespace delete test_ns_cache1::test_ns_cache2
1.427 + list [namespace eval test_ns_cache1 $trigger] \
1.428 + [namespace eval test_ns_cache1 $trigger2]
1.429 +} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
1.430 +
1.431 +test namespace-old-6.5 {define test commands} {
1.432 + proc test_ns_cache_cmd {} {
1.433 + return "global version"
1.434 + }
1.435 + namespace eval test_ns_cache1 {
1.436 + proc trigger {} {
1.437 + test_ns_cache_cmd
1.438 + }
1.439 + }
1.440 + test_ns_cache1::trigger
1.441 +} {global version}
1.442 +
1.443 +test namespace-old-6.6 {one-level check for command shadowing} {
1.444 + proc test_ns_cache1::test_ns_cache_cmd {} {
1.445 + return "cache1 version"
1.446 + }
1.447 + test_ns_cache1::trigger
1.448 +} {cache1 version}
1.449 +
1.450 +test namespace-old-6.7 {renaming commands changes command epoch} {
1.451 + namespace eval test_ns_cache1 {
1.452 + rename test_ns_cache_cmd test_ns_new
1.453 + }
1.454 + test_ns_cache1::trigger
1.455 +} {global version}
1.456 +
1.457 +test namespace-old-6.8 {renaming back handles shadowing} {
1.458 + namespace eval test_ns_cache1 {
1.459 + rename test_ns_new test_ns_cache_cmd
1.460 + }
1.461 + test_ns_cache1::trigger
1.462 +} {cache1 version}
1.463 +
1.464 +test namespace-old-6.9 {deleting commands changes command epoch} {
1.465 + namespace eval test_ns_cache1 {
1.466 + rename test_ns_cache_cmd ""
1.467 + }
1.468 + test_ns_cache1::trigger
1.469 +} {global version}
1.470 +
1.471 +test namespace-old-6.10 {define test namespaces} {
1.472 + namespace eval test_ns_cache2 {
1.473 + proc test_ns_cache_cmd {} {
1.474 + return "global cache2 version"
1.475 + }
1.476 + }
1.477 + namespace eval test_ns_cache1 {
1.478 + proc trigger {} {
1.479 + test_ns_cache2::test_ns_cache_cmd
1.480 + }
1.481 + }
1.482 + namespace eval test_ns_cache1::test_ns_cache2 {
1.483 + proc trigger {} {
1.484 + test_ns_cache_cmd
1.485 + }
1.486 + }
1.487 + list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
1.488 +} {{global cache2 version} {global version}}
1.489 +
1.490 +test namespace-old-6.11 {commands affect all parent namespaces} {
1.491 + proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
1.492 + return "cache2 version"
1.493 + }
1.494 + list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
1.495 +} {{cache2 version} {cache2 version}}
1.496 +
1.497 +test namespace-old-6.12 {define test variables} {
1.498 + variable test_ns_cache_var "global version"
1.499 + set trigger {set test_ns_cache_var}
1.500 + namespace eval test_ns_cache1 $trigger
1.501 +} {global version}
1.502 +
1.503 +test namespace-old-6.13 {one-level check for variable shadowing} {
1.504 + namespace eval test_ns_cache1 {
1.505 + variable test_ns_cache_var "cache1 version"
1.506 + }
1.507 + namespace eval test_ns_cache1 $trigger
1.508 +} {cache1 version}
1.509 +
1.510 +test namespace-old-6.14 {deleting variables changes variable epoch} {
1.511 + namespace eval test_ns_cache1 {
1.512 + unset test_ns_cache_var
1.513 + }
1.514 + namespace eval test_ns_cache1 $trigger
1.515 +} {global version}
1.516 +
1.517 +test namespace-old-6.15 {define test namespaces} {
1.518 + namespace eval test_ns_cache2 {
1.519 + variable test_ns_cache_var "global cache2 version"
1.520 + }
1.521 + set trigger2 {set test_ns_cache2::test_ns_cache_var}
1.522 + list [namespace eval test_ns_cache1 $trigger2] \
1.523 + [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
1.524 +} {{global cache2 version} {global version}}
1.525 +
1.526 +test namespace-old-6.16 {public variables affect all parent namespaces} {
1.527 + variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
1.528 + list [namespace eval test_ns_cache1 $trigger2] \
1.529 + [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
1.530 +} {{cache2 version} {cache2 version}}
1.531 +
1.532 +test namespace-old-6.17 {usage for "namespace which"} {
1.533 + list [catch "namespace which -baz" msg] $msg
1.534 +} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
1.535 +test namespace-old-6.18 {usage for "namespace which"} {
1.536 + list [catch "namespace which -command" msg] $msg
1.537 +} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
1.538 +
1.539 +test namespace-old-6.19 {querying: namespace which -command} {
1.540 + proc test_ns_cache1::test_ns_cache_cmd {} {
1.541 + return "cache1 version"
1.542 + }
1.543 + list [namespace eval :: {namespace which test_ns_cache_cmd}] \
1.544 + [namespace eval test_ns_cache1 {namespace which test_ns_cache_cmd}] \
1.545 + [namespace eval :: {namespace which -command test_ns_cache_cmd}] \
1.546 + [namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}]
1.547 +} {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd}
1.548 +
1.549 +test namespace-old-6.20 {command "namespace which" may not find commands} {
1.550 + namespace eval test_ns_cache1 {namespace which -command xyzzy}
1.551 +} {}
1.552 +
1.553 +test namespace-old-6.21 {querying: namespace which -variable} {
1.554 + namespace eval test_ns_cache1::test_ns_cache2 {
1.555 + namespace which -variable test_ns_cache_var
1.556 + }
1.557 +} {::test_ns_cache1::test_ns_cache2::test_ns_cache_var}
1.558 +
1.559 +test namespace-old-6.22 {command "namespace which" may not find variables} {
1.560 + namespace eval test_ns_cache1 {namespace which -variable xyzzy}
1.561 +} {}
1.562 +
1.563 +# -----------------------------------------------------------------------
1.564 +# TEST: uplevel/upvar across namespace boundaries
1.565 +# -----------------------------------------------------------------------
1.566 +test namespace-old-7.1 {define test namespace} {
1.567 + namespace eval test_ns_uplevel {
1.568 + variable x 0
1.569 + variable y 1
1.570 +
1.571 + proc show_vars {num} {
1.572 + return [uplevel $num {info vars}]
1.573 + }
1.574 + proc test_uplevel {num} {
1.575 + set a 0
1.576 + set b 1
1.577 + namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
1.578 + }
1.579 + }
1.580 +} {}
1.581 +test namespace-old-7.2 {uplevel can access namespace call frame} {
1.582 + list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] x]>=0}] \
1.583 + [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] y]>=0}]
1.584 +} {1 1}
1.585 +test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
1.586 + lsort [test_ns_uplevel::test_uplevel 2]
1.587 +} {a b num}
1.588 +test namespace-old-7.4 {uplevel can go up to global context} {
1.589 + expr {[test_ns_uplevel::test_uplevel 3] == [info globals]}
1.590 +} {1}
1.591 +
1.592 +test namespace-old-7.5 {absolute call frame references work too} {
1.593 + list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] x]>=0}] \
1.594 + [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] y]>=0}]
1.595 +} {1 1}
1.596 +test namespace-old-7.6 {absolute call frame references work too} {
1.597 + lsort [test_ns_uplevel::test_uplevel #1]
1.598 +} {a b num}
1.599 +test namespace-old-7.7 {absolute call frame references work too} {
1.600 + expr {[test_ns_uplevel::test_uplevel #0] == [info globals]}
1.601 +} {1}
1.602 +
1.603 +test namespace-old-7.8 {namespaces are included in the call stack} {
1.604 + namespace eval test_ns_upvar {
1.605 + variable scope "test_ns_upvar"
1.606 +
1.607 + proc show_val {var num} {
1.608 + upvar $num $var x
1.609 + return $x
1.610 + }
1.611 + proc test_upvar {num} {
1.612 + set scope "test_ns_upvar::test_upvar"
1.613 + namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
1.614 + }
1.615 + }
1.616 +} {}
1.617 +test namespace-old-7.9 {upvar can access namespace call frame} {
1.618 + test_ns_upvar::test_upvar 1
1.619 +} {test_ns_upvar}
1.620 +test namespace-old-7.10 {upvar can go beyond namespace call frame} {
1.621 + test_ns_upvar::test_upvar 2
1.622 +} {test_ns_upvar::test_upvar}
1.623 +test namespace-old-7.11 {absolute call frame references work too} {
1.624 + test_ns_upvar::test_upvar #2
1.625 +} {test_ns_upvar}
1.626 +test namespace-old-7.12 {absolute call frame references work too} {
1.627 + test_ns_upvar::test_upvar #1
1.628 +} {test_ns_upvar::test_upvar}
1.629 +
1.630 +# -----------------------------------------------------------------------
1.631 +# TEST: variable traces across namespace boundaries
1.632 +# -----------------------------------------------------------------------
1.633 +test namespace-old-8.1 {traces work across namespace boundaries} {
1.634 + namespace eval test_ns_trace {
1.635 + namespace eval foo {
1.636 + variable x ""
1.637 + }
1.638 +
1.639 + variable status ""
1.640 + proc monitor {name1 name2 op} {
1.641 + variable status
1.642 + lappend status "$op: $name1"
1.643 + }
1.644 + trace variable foo::x rwu [namespace code monitor]
1.645 + }
1.646 + set test_ns_trace::foo::x "yes!"
1.647 + set test_ns_trace::foo::x
1.648 + unset test_ns_trace::foo::x
1.649 +
1.650 + namespace eval test_ns_trace { set status }
1.651 +} {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}}
1.652 +
1.653 +# -----------------------------------------------------------------------
1.654 +# TEST: imported commands
1.655 +# -----------------------------------------------------------------------
1.656 +test namespace-old-9.1 {empty "namespace export" list} {
1.657 + list [catch "namespace export" msg] $msg
1.658 +} {0 {}}
1.659 +test namespace-old-9.2 {usage for "namespace export" command} {
1.660 + list [catch "namespace export test_ns_trace::zzz" msg] $msg
1.661 +} {1 {invalid export pattern "test_ns_trace::zzz": pattern can't specify a namespace}}
1.662 +
1.663 +test namespace-old-9.3 {define test namespaces for import} {
1.664 + namespace eval test_ns_export {
1.665 + namespace export cmd1 cmd2 cmd3
1.666 + proc cmd1 {args} {return "cmd1: $args"}
1.667 + proc cmd2 {args} {return "cmd2: $args"}
1.668 + proc cmd3 {args} {return "cmd3: $args"}
1.669 + proc cmd4 {args} {return "cmd4: $args"}
1.670 + proc cmd5 {args} {return "cmd5: $args"}
1.671 + proc cmd6 {args} {return "cmd6: $args"}
1.672 + }
1.673 + lsort [info commands test_ns_export::*]
1.674 +} {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
1.675 +
1.676 +test namespace-old-9.4 {check export status} {
1.677 + set x ""
1.678 + namespace eval test_ns_import {
1.679 + namespace export cmd1 cmd2
1.680 + namespace import ::test_ns_export::*
1.681 + }
1.682 + foreach cmd [lsort [info commands test_ns_import::*]] {
1.683 + lappend x $cmd
1.684 + }
1.685 + set x
1.686 +} {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
1.687 +
1.688 +test namespace-old-9.5 {empty import list in "namespace import" command} {
1.689 + namespace import
1.690 +} {}
1.691 +
1.692 +test namespace-old-9.6 {empty import list for "namespace import" command} {
1.693 + namespace import
1.694 +} {}
1.695 +
1.696 +test namespace-old-9.7 {empty forget list for "namespace forget" command} {
1.697 + namespace forget
1.698 +} {}
1.699 +
1.700 +catch {rename cmd1 {}}
1.701 +catch {rename cmd2 {}}
1.702 +catch {rename ncmd {}}
1.703 +catch {rename ncmd1 {}}
1.704 +catch {rename ncmd2 {}}
1.705 +test namespace-old-9.8 {only exported commands are imported} {
1.706 + namespace import test_ns_import::cmd*
1.707 + set x [lsort [info commands cmd*]]
1.708 +} {cmd1 cmd2}
1.709 +
1.710 +test namespace-old-9.9 {imported commands work just the same as original} {
1.711 + list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
1.712 +} {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
1.713 +
1.714 +test namespace-old-9.10 {commands can be imported from many namespaces} {
1.715 + namespace eval test_ns_import2 {
1.716 + namespace export ncmd ncmd1 ncmd2
1.717 + proc ncmd {args} {return "ncmd: $args"}
1.718 + proc ncmd1 {args} {return "ncmd1: $args"}
1.719 + proc ncmd2 {args} {return "ncmd2: $args"}
1.720 + proc ncmd3 {args} {return "ncmd3: $args"}
1.721 + }
1.722 + namespace import test_ns_import2::*
1.723 + lsort [concat [info commands cmd*] [info commands ncmd*]]
1.724 +} {cmd1 cmd2 ncmd ncmd1 ncmd2}
1.725 +
1.726 +test namespace-old-9.11 {imported commands can be removed by deleting them} {
1.727 + rename cmd1 ""
1.728 + lsort [concat [info commands cmd*] [info commands ncmd*]]
1.729 +} {cmd2 ncmd ncmd1 ncmd2}
1.730 +
1.731 +test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
1.732 + list [catch {namespace forget xyzzy::*} msg] $msg
1.733 +} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
1.734 +
1.735 +test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} {
1.736 + list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \
1.737 + [lsort [info commands cmd?]]
1.738 +} {0 {} cmd2}
1.739 +
1.740 +test namespace-old-9.14 {imported commands can be removed} {
1.741 + namespace forget test_ns_import::cmd?
1.742 + list [lsort [info commands cmd?]] \
1.743 + [catch {cmd1 another test} msg] $msg
1.744 +} {{} 1 {invalid command name "cmd1"}}
1.745 +
1.746 +test namespace-old-9.15 {existing commands can't be overwritten} {
1.747 + proc cmd1 {x y} {
1.748 + return [expr $x+$y]
1.749 + }
1.750 + list [catch {namespace import test_ns_import::cmd?} msg] $msg \
1.751 + [cmd1 3 5]
1.752 +} {1 {can't import command "cmd1": already exists} 8}
1.753 +
1.754 +test namespace-old-9.16 {use "-force" option to override existing commands} {
1.755 + list [cmd1 3 5] \
1.756 + [namespace import -force test_ns_import::cmd?] \
1.757 + [cmd1 3 5]
1.758 +} {8 {} {cmd1: 3 5}}
1.759 +
1.760 +test namespace-old-9.17 {commands can be imported into many namespaces} {
1.761 + namespace eval test_ns_import_use {
1.762 + namespace import ::test_ns_import::* ::test_ns_import2::ncmd?
1.763 + lsort [concat [info commands ::test_ns_import_use::cmd*] \
1.764 + [info commands ::test_ns_import_use::ncmd*]]
1.765 + }
1.766 +} {::test_ns_import_use::cmd1 ::test_ns_import_use::cmd2 ::test_ns_import_use::ncmd1 ::test_ns_import_use::ncmd2}
1.767 +
1.768 +test namespace-old-9.18 {when command is deleted, imported commands go away} {
1.769 + namespace eval test_ns_import { rename cmd1 "" }
1.770 + list [info commands cmd1] \
1.771 + [namespace eval test_ns_import_use {info commands cmd1}]
1.772 +} {{} {}}
1.773 +
1.774 +test namespace-old-9.19 {when namesp is deleted, all imported commands go away} {
1.775 + namespace delete test_ns_import test_ns_import2
1.776 + list [info commands cmd*] \
1.777 + [info commands ncmd*] \
1.778 + [namespace eval test_ns_import_use {info commands cmd*}] \
1.779 + [namespace eval test_ns_import_use {info commands ncmd*}] \
1.780 +} {{} {} {} {}}
1.781 +
1.782 +# -----------------------------------------------------------------------
1.783 +# TEST: scoped values
1.784 +# -----------------------------------------------------------------------
1.785 +test namespace-old-10.1 {define namespace for scope test} {
1.786 + namespace eval test_ns_inscope {
1.787 + variable x "x-value"
1.788 + proc show {args} {
1.789 + return "show: $args"
1.790 + }
1.791 + proc do {args} {
1.792 + return [eval $args]
1.793 + }
1.794 + list [set x] [show test]
1.795 + }
1.796 +} {x-value {show: test}}
1.797 +
1.798 +test namespace-old-10.2 {command "namespace code" requires one argument} {
1.799 + list [catch {namespace code} msg] $msg
1.800 +} {1 {wrong # args: should be "namespace code arg"}}
1.801 +
1.802 +test namespace-old-10.3 {command "namespace code" requires one argument} {
1.803 + list [catch {namespace code first "second arg" third} msg] $msg
1.804 +} {1 {wrong # args: should be "namespace code arg"}}
1.805 +
1.806 +test namespace-old-10.4 {command "namespace code" gets current namesp context} {
1.807 + namespace eval test_ns_inscope {
1.808 + namespace code {"1 2 3" "4 5" 6}
1.809 + }
1.810 +} {::namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}}
1.811 +
1.812 +test namespace-old-10.5 {with one arg, first "scope" sticks} {
1.813 + set sval [namespace eval test_ns_inscope {namespace code {one two}}]
1.814 + namespace code $sval
1.815 +} {::namespace inscope ::test_ns_inscope {one two}}
1.816 +
1.817 +test namespace-old-10.6 {with many args, each "scope" adds new args} {
1.818 + set sval [namespace eval test_ns_inscope {namespace code {one two}}]
1.819 + namespace code "$sval three"
1.820 +} {::namespace inscope ::test_ns_inscope {one two} three}
1.821 +
1.822 +test namespace-old-10.7 {scoped commands work with eval} {
1.823 + set cref [namespace eval test_ns_inscope {namespace code show}]
1.824 + list [eval $cref "a" "b c" "d e f"]
1.825 +} {{show: a b c d e f}}
1.826 +
1.827 +test namespace-old-10.8 {scoped commands execute in namespace context} {
1.828 + set cref [namespace eval test_ns_inscope {
1.829 + namespace code {set x "some new value"}
1.830 + }]
1.831 + list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x]
1.832 +} {x-value {some new value} {some new value}}
1.833 +
1.834 +foreach cmd [info commands test_ns_*] {
1.835 + rename $cmd ""
1.836 +}
1.837 +catch {rename cmd {}}
1.838 +catch {rename cmd1 {}}
1.839 +catch {rename cmd2 {}}
1.840 +catch {rename ncmd {}}
1.841 +catch {rename ncmd1 {}}
1.842 +catch {rename ncmd2 {}}
1.843 +catch {unset cref}
1.844 +catch {unset trigger}
1.845 +catch {unset trigger2}
1.846 +catch {unset sval}
1.847 +catch {unset msg}
1.848 +catch {unset x}
1.849 +catch {unset test_ns_var_global}
1.850 +catch {unset cmd}
1.851 +eval namespace delete [namespace children :: test_ns_*]
1.852 +
1.853 +# cleanup
1.854 +::tcltest::cleanupTests
1.855 +return
1.856 +
1.857 +
1.858 +
1.859 +
1.860 +
1.861 +
1.862 +
1.863 +
1.864 +
1.865 +
1.866 +
1.867 +