os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/namespace.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.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,1440 @@
1.4 +# Functionality covered: this file contains a collection of tests for the
1.5 +# procedures in tclNamesp.c that implement Tcl's basic support for
1.6 +# namespaces. Other namespace-related tests appear in variable.test.
1.7 +#
1.8 +# Sourcing this file into Tcl runs the tests and generates output for
1.9 +# errors. No output means no errors were found.
1.10 +#
1.11 +# Copyright (c) 1997 Sun Microsystems, Inc.
1.12 +# Copyright (c) 1998-2000 by Scriptics Corporation.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +# RCS: @(#) $Id: namespace.test,v 1.21.2.10 2006/10/04 17:59:06 dgp Exp $
1.18 +
1.19 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.20 + package require tcltest 2
1.21 + namespace import -force ::tcltest::*
1.22 +}
1.23 +
1.24 +# Clear out any namespaces called test_ns_*
1.25 +catch {eval namespace delete [namespace children :: test_ns_*]}
1.26 +
1.27 +test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} {
1.28 + namespace children :: test_ns_*
1.29 +} {}
1.30 +
1.31 +catch {unset l}
1.32 +test namespace-2.1 {Tcl_GetCurrentNamespace} {
1.33 + list [namespace current] [namespace eval {} {namespace current}] \
1.34 + [namespace eval {} {namespace current}]
1.35 +} {:: :: ::}
1.36 +test namespace-2.2 {Tcl_GetCurrentNamespace} {
1.37 + set l {}
1.38 + lappend l [namespace current]
1.39 + namespace eval test_ns_1 {
1.40 + lappend l [namespace current]
1.41 + namespace eval foo {
1.42 + lappend l [namespace current]
1.43 + }
1.44 + }
1.45 + lappend l [namespace current]
1.46 + set l
1.47 +} {:: ::test_ns_1 ::test_ns_1::foo ::}
1.48 +
1.49 +test namespace-3.1 {Tcl_GetGlobalNamespace} {
1.50 + namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
1.51 + # namespace children uses Tcl_GetGlobalNamespace
1.52 + namespace eval test_ns_1 {namespace children foo b*}
1.53 +} {::test_ns_1::foo::bar}
1.54 +
1.55 +test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} {
1.56 + namespace eval test_ns_1 {
1.57 + variable v 123
1.58 + proc p {} {
1.59 + variable v
1.60 + return $v
1.61 + }
1.62 + }
1.63 + test_ns_1::p ;# does Tcl_PushCallFrame to push p's namespace
1.64 +} {123}
1.65 +test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} {
1.66 + namespace eval test_ns_1::baz {} ;# does Tcl_PushCallFrame to create baz
1.67 + proc test_ns_1::baz::p {} {
1.68 + variable v
1.69 + set v 789
1.70 + set v}
1.71 + test_ns_1::baz::p
1.72 +} {789}
1.73 +
1.74 +test namespace-5.1 {Tcl_PopCallFrame, no vars} {
1.75 + namespace eval test_ns_1::blodge {} ;# pushes then pops frame
1.76 +} {}
1.77 +test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
1.78 + proc test_ns_1::r {} {
1.79 + set a 123
1.80 + }
1.81 + test_ns_1::r ;# pushes then pop's r's frame
1.82 +} {123}
1.83 +
1.84 +test namespace-6.1 {Tcl_CreateNamespace} {
1.85 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.86 + list [lsort [namespace children :: test_ns_*]] \
1.87 + [namespace eval test_ns_1 {namespace current}] \
1.88 + [namespace eval test_ns_2 {namespace current}] \
1.89 + [namespace eval ::test_ns_3 {namespace current}] \
1.90 + [namespace eval ::test_ns_4 \
1.91 + {namespace eval foo {namespace current}}] \
1.92 + [namespace eval ::test_ns_5 \
1.93 + {namespace eval ::test_ns_6 {namespace current}}] \
1.94 + [lsort [namespace children :: test_ns_*]]
1.95 +} {{} ::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4::foo ::test_ns_6 {::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4 ::test_ns_5 ::test_ns_6}}
1.96 +test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
1.97 + list [namespace eval :::test_ns_1::::foo {namespace current}] \
1.98 + [namespace eval test_ns_2:::::foo {namespace current}]
1.99 +} {::test_ns_1::foo ::test_ns_2::foo}
1.100 +test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
1.101 + list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg
1.102 +} {0 ::test_ns_7}
1.103 +test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
1.104 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.105 + namespace eval test_ns_1:: {
1.106 + namespace eval test_ns_2:: {}
1.107 + namespace eval test_ns_3:: {}
1.108 + }
1.109 + lsort [namespace children ::test_ns_1]
1.110 +} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}]
1.111 +test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} {
1.112 + set trigger {
1.113 + namespace eval test_ns_2 {namespace current}
1.114 + }
1.115 + set l {}
1.116 + lappend l [namespace eval test_ns_1 $trigger]
1.117 + namespace eval test_ns_1::test_ns_2 {}
1.118 + lappend l [namespace eval test_ns_1 $trigger]
1.119 +} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2}
1.120 +
1.121 +test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} {
1.122 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.123 + namespace eval test_ns_1 {
1.124 + proc p {} {
1.125 + namespace delete [namespace current]
1.126 + return [namespace current]
1.127 + }
1.128 + }
1.129 + list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg
1.130 +} {::test_ns_1 1 {invalid command name "test_ns_1::p"}}
1.131 +test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
1.132 + namespace eval test_ns_2 {
1.133 + proc p {} {
1.134 + return [namespace current]
1.135 + }
1.136 + }
1.137 + list [test_ns_2::p] [namespace delete test_ns_2]
1.138 +} {::test_ns_2 {}}
1.139 +test namespace-7.3 {recursive Tcl_DeleteNamespace, active call frames in ns} {
1.140 + # [Bug 1355942]
1.141 + namespace eval test_ns_2 {
1.142 + set x 1
1.143 + trace add variable x unset "namespace delete [namespace current];#"
1.144 + namespace delete [namespace current]
1.145 + }
1.146 +} {}
1.147 +test namespace-7.4 {recursive Tcl_DeleteNamespace, active call frames in ns} {
1.148 + # [Bug 1355942]
1.149 + namespace eval test_ns_2 {
1.150 + proc x {} {}
1.151 + trace add command x delete "namespace delete [namespace current];#"
1.152 + namespace delete [namespace current]
1.153 + }
1.154 +} {}
1.155 +test namespace-7.5 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
1.156 + # [Bug 1355942]
1.157 + namespace eval test_ns_2 {
1.158 + set x 1
1.159 + trace add variable x unset "namespace delete [namespace current];#"
1.160 + }
1.161 + namespace delete test_ns_2
1.162 +} {}
1.163 +test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
1.164 + # [Bug 1355942]
1.165 + namespace eval test_ns_2 {
1.166 + proc x {} {}
1.167 + trace add command x delete "namespace delete [namespace current];#"
1.168 + }
1.169 + namespace delete test_ns_2
1.170 +} {}
1.171 +
1.172 +test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
1.173 + catch {interp delete test_interp}
1.174 + interp create test_interp
1.175 + interp eval test_interp {
1.176 + namespace eval test_ns_1 {
1.177 + namespace export p
1.178 + proc p {} {
1.179 + return [namespace current]
1.180 + }
1.181 + }
1.182 + namespace eval test_ns_2 {
1.183 + namespace import ::test_ns_1::p
1.184 + variable v 27
1.185 + proc q {} {
1.186 + variable v
1.187 + return "[p] $v"
1.188 + }
1.189 + }
1.190 + set x [test_ns_2::q]
1.191 + catch {set xxxx}
1.192 + }
1.193 + list [interp eval test_interp {test_ns_2::q}] \
1.194 + [interp eval test_interp {namespace delete ::}] \
1.195 + [catch {interp eval test_interp {set a 123}} msg] $msg \
1.196 + [interp delete test_interp]
1.197 +} {{::test_ns_1 27} {} 1 {invalid command name "set"} {}}
1.198 +test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} {
1.199 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.200 + namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
1.201 + namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
1.202 + list [namespace children test_ns_1] \
1.203 + [namespace delete test_ns_1::test_ns_2] \
1.204 + [namespace children test_ns_1]
1.205 +} {::test_ns_1::test_ns_2 {} {}}
1.206 +test namespace-8.3 {TclTeardownNamespace, delete child namespaces} {
1.207 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.208 + namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
1.209 + namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
1.210 + list [namespace children test_ns_1] \
1.211 + [namespace delete test_ns_1::test_ns_2] \
1.212 + [namespace children test_ns_1] \
1.213 + [catch {namespace children test_ns_1::test_ns_2} msg] $msg \
1.214 + [info commands test_ns_1::test_ns_2::test_ns_3a::*]
1.215 +} {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}}
1.216 +test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} {
1.217 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.218 + namespace eval test_ns_export {
1.219 + namespace export cmd1 cmd2
1.220 + proc cmd1 {args} {return "cmd1: $args"}
1.221 + proc cmd2 {args} {return "cmd2: $args"}
1.222 + }
1.223 + namespace eval test_ns_import {
1.224 + namespace import ::test_ns_export::*
1.225 + proc p {} {return foo}
1.226 + }
1.227 + list [lsort [info commands test_ns_import::*]] \
1.228 + [namespace delete test_ns_export] \
1.229 + [info commands test_ns_import::*]
1.230 +} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p]
1.231 +test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
1.232 + interp create slave
1.233 + slave eval {trace add execution error leave {namespace delete :: ;#}}
1.234 + catch {slave eval error foo bar baz}
1.235 + interp delete slave
1.236 + set ::errorInfo
1.237 +} {bar
1.238 + invoked from within
1.239 +"slave eval error foo bar baz"}
1.240 +test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
1.241 + interp create slave
1.242 + slave eval {trace add variable errorCode write {namespace delete :: ;#}}
1.243 + catch {slave eval error foo bar baz}
1.244 + interp delete slave
1.245 + set ::errorInfo
1.246 +} {bar
1.247 + invoked from within
1.248 +"slave eval error foo bar baz"}
1.249 +test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
1.250 + interp create slave
1.251 + slave eval {trace add execution error leave {namespace delete :: ;#}}
1.252 + catch {slave eval error foo bar baz}
1.253 + interp delete slave
1.254 + set ::errorCode
1.255 +} baz
1.256 +
1.257 +test namespace-9.1 {Tcl_Import, empty import pattern} {
1.258 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.259 + list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg
1.260 +} {1 {empty import pattern}}
1.261 +test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} {
1.262 + list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg
1.263 +} {1 {unknown namespace in import pattern "fred::x"}}
1.264 +test namespace-9.3 {Tcl_Import, import ns == export ns} {
1.265 + list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg
1.266 +} {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}}
1.267 +test namespace-9.4 {Tcl_Import, simple import} {
1.268 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.269 + namespace eval test_ns_export {
1.270 + namespace export cmd1
1.271 + proc cmd1 {args} {return "cmd1: $args"}
1.272 + proc cmd2 {args} {return "cmd2: $args"}
1.273 + }
1.274 + namespace eval test_ns_import {
1.275 + namespace import ::test_ns_export::*
1.276 + proc p {} {return [cmd1 123]}
1.277 + }
1.278 + test_ns_import::p
1.279 +} {cmd1: 123}
1.280 +test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} {
1.281 + list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
1.282 +} {0 {}}
1.283 +test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
1.284 + namespace eval test_ns_import {
1.285 + namespace import -force ::test_ns_export::*
1.286 + cmd1 555
1.287 + }
1.288 +} {cmd1: 555}
1.289 +test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
1.290 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.291 + namespace eval test_ns_export {
1.292 + namespace export cmd1
1.293 + proc cmd1 {args} {return "cmd1: $args"}
1.294 + }
1.295 + namespace eval test_ns_import {
1.296 + namespace import -force ::test_ns_export::*
1.297 + }
1.298 + list [test_ns_import::cmd1 a b c] \
1.299 + [test_ns_export::cmd1 d e f] \
1.300 + [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \
1.301 + [namespace origin test_ns_import::cmd1] \
1.302 + [namespace origin test_ns_export::cmd1] \
1.303 + [test_ns_import::cmd1 g h i] \
1.304 + [test_ns_export::cmd1 j k l]
1.305 +} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}
1.306 +
1.307 +test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
1.308 + namespace eval one {
1.309 + namespace export cmd
1.310 + proc cmd {} {}
1.311 + }
1.312 + namespace eval two {
1.313 + namespace export cmd
1.314 + proc other args {}
1.315 + }
1.316 + namespace eval two \
1.317 + [list namespace import [namespace current]::one::cmd]
1.318 + namespace eval three \
1.319 + [list namespace import [namespace current]::two::cmd]
1.320 + namespace eval three {
1.321 + rename cmd other
1.322 + namespace export other
1.323 + }
1.324 +} -body {
1.325 + namespace eval two [list namespace import -force \
1.326 + [namespace current]::three::other]
1.327 + namespace origin two::other
1.328 +} -cleanup {
1.329 + namespace delete one two three
1.330 +} -match glob -result *::one::cmd
1.331 +
1.332 +test namespace-9.9 {Tcl_Import: Bug 1017299} -setup {
1.333 + namespace eval one {
1.334 + namespace export cmd
1.335 + proc cmd {} {}
1.336 + }
1.337 + namespace eval two namespace export cmd
1.338 + namespace eval two \
1.339 + [list namespace import [namespace current]::one::cmd]
1.340 + namespace eval three namespace export cmd
1.341 + namespace eval three \
1.342 + [list namespace import [namespace current]::two::cmd]
1.343 +} -body {
1.344 + namespace eval two [list namespace import -force \
1.345 + [namespace current]::three::cmd]
1.346 + namespace origin two::cmd
1.347 +} -cleanup {
1.348 + namespace delete one two three
1.349 +} -returnCodes error -match glob -result {import pattern * would create a loop*}
1.350 +
1.351 +test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} {
1.352 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.353 + list [catch {namespace forget xyzzy::*} msg] $msg
1.354 +} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
1.355 +test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
1.356 + namespace eval test_ns_export {
1.357 + namespace export cmd1
1.358 + proc cmd1 {args} {return "cmd1: $args"}
1.359 + proc cmd2 {args} {return "cmd2: $args"}
1.360 + }
1.361 + namespace eval test_ns_import {
1.362 + namespace forget ::test_ns_export::wombat
1.363 + }
1.364 +} {}
1.365 +test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
1.366 + namespace eval test_ns_import {
1.367 + namespace import ::test_ns_export::*
1.368 + proc p {} {return [cmd1 123]}
1.369 + set l {}
1.370 + lappend l [lsort [info commands ::test_ns_import::*]]
1.371 + namespace forget ::test_ns_export::cmd1
1.372 + lappend l [info commands ::test_ns_import::*]
1.373 + lappend l [catch {cmd1 777} msg] $msg
1.374 + }
1.375 +} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]
1.376 +
1.377 +test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
1.378 + namespace eval origin {
1.379 + namespace export cmd
1.380 + proc cmd {} {}
1.381 + }
1.382 + namespace eval unrelated {
1.383 + proc cmd {} {}
1.384 + }
1.385 + namespace eval my \
1.386 + [list namespace import [namespace current]::origin::cmd]
1.387 +} -body {
1.388 + namespace eval my \
1.389 + [list namespace forget [namespace current]::unrelated::cmd]
1.390 + my::cmd
1.391 +} -cleanup {
1.392 + namespace delete origin unrelated my
1.393 +}
1.394 +
1.395 +test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
1.396 + namespace eval origin {
1.397 + namespace export cmd
1.398 + proc cmd {} {}
1.399 + }
1.400 + namespace eval my \
1.401 + [list namespace import [namespace current]::origin::cmd]
1.402 + namespace eval my rename cmd newname
1.403 +} -body {
1.404 + namespace eval my \
1.405 + [list namespace forget [namespace current]::origin::cmd]
1.406 + my::newname
1.407 +} -cleanup {
1.408 + namespace delete origin my
1.409 +} -returnCodes error -match glob -result *
1.410 +
1.411 +test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
1.412 + namespace eval origin {
1.413 + namespace export cmd
1.414 + proc cmd {} {}
1.415 + }
1.416 + namespace eval my \
1.417 + [list namespace import [namespace current]::origin::cmd]
1.418 + namespace eval your {}
1.419 + namespace eval my \
1.420 + [list rename cmd [namespace current]::your::newname]
1.421 +} -body {
1.422 + namespace eval your namespace forget newname
1.423 + your::newname
1.424 +} -cleanup {
1.425 + namespace delete origin my your
1.426 +} -returnCodes error -match glob -result *
1.427 +
1.428 +test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
1.429 + namespace eval origin {
1.430 + namespace export cmd
1.431 + proc cmd {} {}
1.432 + }
1.433 + namespace eval link namespace export cmd
1.434 + namespace eval link \
1.435 + [list namespace import [namespace current]::origin::cmd]
1.436 + namespace eval link2 namespace export cmd
1.437 + namespace eval link2 \
1.438 + [list namespace import [namespace current]::link::cmd]
1.439 + namespace eval my \
1.440 + [list namespace import [namespace current]::link2::cmd]
1.441 +} -body {
1.442 + namespace eval my \
1.443 + [list namespace forget [namespace current]::origin::cmd]
1.444 + my::cmd
1.445 +} -cleanup {
1.446 + namespace delete origin link link2 my
1.447 +} -returnCodes error -match glob -result *
1.448 +
1.449 +test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
1.450 + namespace eval origin {
1.451 + namespace export cmd
1.452 + proc cmd {} {}
1.453 + }
1.454 + namespace eval link namespace export cmd
1.455 + namespace eval link \
1.456 + [list namespace import [namespace current]::origin::cmd]
1.457 + namespace eval link2 namespace export cmd
1.458 + namespace eval link2 \
1.459 + [list namespace import [namespace current]::link::cmd]
1.460 + namespace eval my \
1.461 + [list namespace import [namespace current]::link2::cmd]
1.462 +} -body {
1.463 + namespace eval my \
1.464 + [list namespace forget [namespace current]::link::cmd]
1.465 + my::cmd
1.466 +} -cleanup {
1.467 + namespace delete origin link link2 my
1.468 +}
1.469 +
1.470 +test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
1.471 + namespace eval origin {
1.472 + namespace export cmd
1.473 + proc cmd {} {}
1.474 + }
1.475 + namespace eval link namespace export cmd
1.476 + namespace eval link \
1.477 + [list namespace import [namespace current]::origin::cmd]
1.478 + namespace eval link2 namespace export cmd
1.479 + namespace eval link2 \
1.480 + [list namespace import [namespace current]::link::cmd]
1.481 + namespace eval my \
1.482 + [list namespace import [namespace current]::link2::cmd]
1.483 +} -body {
1.484 + namespace eval my \
1.485 + [list namespace forget [namespace current]::link2::cmd]
1.486 + my::cmd
1.487 +} -cleanup {
1.488 + namespace delete origin link link2 my
1.489 +} -returnCodes error -match glob -result *
1.490 +
1.491 +test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
1.492 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.493 + namespace eval test_ns_export {
1.494 + namespace export cmd1
1.495 + proc cmd1 {args} {return "cmd1: $args"}
1.496 + }
1.497 + list [namespace origin set] [namespace origin test_ns_export::cmd1]
1.498 +} {::set ::test_ns_export::cmd1}
1.499 +test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {
1.500 + namespace eval test_ns_import1 {
1.501 + namespace import ::test_ns_export::*
1.502 + namespace export *
1.503 + proc p {} {namespace origin cmd1}
1.504 + }
1.505 + list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
1.506 +} {::test_ns_export::cmd1 ::test_ns_export::cmd1}
1.507 +test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
1.508 + namespace eval test_ns_import2 {
1.509 + namespace import ::test_ns_import1::*
1.510 + proc q {} {return [cmd1 123]}
1.511 + }
1.512 + list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
1.513 +} {{cmd1: 123} ::test_ns_export::cmd1}
1.514 +
1.515 +test namespace-12.1 {InvokeImportedCmd} {
1.516 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.517 + namespace eval test_ns_export {
1.518 + namespace export cmd1
1.519 + proc cmd1 {args} {namespace current}
1.520 + }
1.521 + namespace eval test_ns_import {
1.522 + namespace import ::test_ns_export::*
1.523 + }
1.524 + list [test_ns_import::cmd1]
1.525 +} {::test_ns_export}
1.526 +
1.527 +test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
1.528 + namespace eval test_ns_import {
1.529 + set l {}
1.530 + lappend l [info commands ::test_ns_import::*]
1.531 + namespace forget ::test_ns_export::cmd1
1.532 + lappend l [info commands ::test_ns_import::*]
1.533 + }
1.534 +} {::test_ns_import::cmd1 {}}
1.535 +
1.536 +test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
1.537 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.538 + variable v 10
1.539 + namespace eval test_ns_1::test_ns_2 {
1.540 + variable v 20
1.541 + }
1.542 + namespace eval test_ns_2 {
1.543 + variable v 30
1.544 + }
1.545 + namespace eval test_ns_1 {
1.546 + list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
1.547 + [lsort [namespace children :: test_ns_*]]
1.548 + }
1.549 +} [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
1.550 +test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
1.551 + namespace eval test_ns_1 {
1.552 + list [catch {set ::test_ns_777::v} msg] $msg \
1.553 + [catch {namespace children test_ns_777} msg] $msg
1.554 + }
1.555 +} {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}}
1.556 +test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
1.557 + namespace eval test_ns_1 {
1.558 + list $v $test_ns_2::v
1.559 + }
1.560 +} {10 20}
1.561 +test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
1.562 + namespace eval test_ns_1::test_ns_2 {
1.563 + namespace eval foo {}
1.564 + }
1.565 + namespace eval test_ns_1 {
1.566 + list [namespace children test_ns_2] \
1.567 + [catch {namespace children test_ns_1} msg] $msg
1.568 + }
1.569 +} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
1.570 +test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
1.571 + namespace eval ::test_ns_2 {
1.572 + namespace eval bar {}
1.573 + }
1.574 + namespace eval test_ns_1 {
1.575 + set l [list [catch {namespace delete test_ns_2::bar} msg] $msg]
1.576 + }
1.577 + set l
1.578 +} {1 {unknown namespace "test_ns_2::bar" in namespace delete command}}
1.579 +test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
1.580 + namespace eval test_ns_1::test_ns_2 {
1.581 + namespace eval foo {}
1.582 + }
1.583 + namespace eval test_ns_1 {
1.584 + list [namespace children test_ns_2] \
1.585 + [catch {namespace children test_ns_1} msg] $msg
1.586 + }
1.587 +} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
1.588 +test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
1.589 + namespace children test_ns_1:::
1.590 +} {::test_ns_1::test_ns_2}
1.591 +test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
1.592 + namespace children :::test_ns_1:::::test_ns_2:::
1.593 +} {::test_ns_1::test_ns_2::foo}
1.594 +test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
1.595 + set l {}
1.596 + lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
1.597 + namespace eval test_ns_1::test_ns_2 {variable {} 2525}
1.598 + lappend l [set test_ns_1::test_ns_2::]
1.599 +} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
1.600 +test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
1.601 + catch {unset test_ns_1::test_ns_2::}
1.602 + set l {}
1.603 + lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
1.604 + set test_ns_1::test_ns_2:: 314159
1.605 + lappend l [set test_ns_1::test_ns_2::]
1.606 +} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
1.607 +test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {
1.608 + catch {rename test_ns_1::test_ns_2:: {}}
1.609 + set l {}
1.610 + lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
1.611 + proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
1.612 + lappend l [test_ns_1::test_ns_2:: hello]
1.613 +} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
1.614 +test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
1.615 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.616 + namespace eval test_ns_1 {
1.617 + variable {}
1.618 + set test_ns_1::(x) y
1.619 + }
1.620 + set test_ns_1::(x)
1.621 +} y
1.622 +test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
1.623 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.624 + list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
1.625 +} {1 {can't create namespace "": only global namespace can have empty name}}
1.626 +
1.627 +test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
1.628 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.629 + namespace eval test_ns_delete {
1.630 + namespace eval test_ns_delete2 {}
1.631 + proc cmd {args} {namespace current}
1.632 + }
1.633 + list [namespace delete ::test_ns_delete::test_ns_delete2] \
1.634 + [namespace children ::test_ns_delete]
1.635 +} {{} {}}
1.636 +test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
1.637 + list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
1.638 +} {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
1.639 +test namespace-15.3 {Tcl_FindNamespace, relative name found} {
1.640 + namespace eval test_ns_delete {
1.641 + namespace eval test_ns_delete2 {}
1.642 + namespace eval test_ns_delete3 {}
1.643 + list [namespace delete test_ns_delete2] \
1.644 + [namespace children [namespace current]]
1.645 + }
1.646 +} {{} ::test_ns_delete::test_ns_delete3}
1.647 +test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
1.648 + namespace eval test_ns_delete2 {}
1.649 + namespace eval test_ns_delete {
1.650 + list [catch {namespace delete test_ns_delete2} msg] $msg
1.651 + }
1.652 +} {1 {unknown namespace "test_ns_delete2" in namespace delete command}}
1.653 +
1.654 +test namespace-16.1 {Tcl_FindCommand, absolute name found} {
1.655 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.656 + namespace eval test_ns_1 {
1.657 + proc cmd {args} {return "[namespace current]::cmd: $args"}
1.658 + variable v "::test_ns_1::cmd"
1.659 + eval $v one
1.660 + }
1.661 +} {::test_ns_1::cmd: one}
1.662 +test namespace-16.2 {Tcl_FindCommand, absolute name found} {
1.663 + eval $test_ns_1::v two
1.664 +} {::test_ns_1::cmd: two}
1.665 +test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
1.666 + namespace eval test_ns_1 {
1.667 + variable v2 "::test_ns_1::ladidah"
1.668 + list [catch {eval $v2} msg] $msg
1.669 + }
1.670 +} {1 {invalid command name "::test_ns_1::ladidah"}}
1.671 +
1.672 +# save the "unknown" proc, which is redefined by the following two tests
1.673 +catch {rename unknown unknown.old}
1.674 +proc unknown {args} {
1.675 + return "unknown: $args"
1.676 +}
1.677 +test namespace-16.4 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
1.678 + ::test_ns_1::foobar x y z
1.679 +} {unknown: ::test_ns_1::foobar x y z}
1.680 +test namespace-16.5 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
1.681 + ::foobar 1 2 3 4 5
1.682 +} {unknown: ::foobar 1 2 3 4 5}
1.683 +test namespace-16.6 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
1.684 + test_ns_1::foobar x y z
1.685 +} {unknown: test_ns_1::foobar x y z}
1.686 +test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
1.687 + foobar 1 2 3 4 5
1.688 +} {unknown: foobar 1 2 3 4 5}
1.689 +# restore the "unknown" proc saved previously
1.690 +catch {rename unknown {}}
1.691 +catch {rename unknown.old unknown}
1.692 +
1.693 +test namespace-16.8 {Tcl_FindCommand, relative name found} {
1.694 + namespace eval test_ns_1 {
1.695 + cmd a b c
1.696 + }
1.697 +} {::test_ns_1::cmd: a b c}
1.698 +test namespace-16.9 {Tcl_FindCommand, relative name found} {
1.699 + catch {rename cmd2 {}}
1.700 + proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
1.701 + namespace eval test_ns_1 {
1.702 + cmd2 a b c
1.703 + }
1.704 +} {::::cmd2: a b c}
1.705 +test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} {
1.706 + namespace eval test_ns_1 {
1.707 + proc cmd2 {args} {
1.708 + return "[namespace current]::cmd2 in test_ns_1: $args"
1.709 + }
1.710 + namespace eval test_ns_12 {
1.711 + cmd2 a b c
1.712 + }
1.713 + }
1.714 +} {::::cmd2: a b c}
1.715 +test namespace-16.11 {Tcl_FindCommand, relative name not found} {
1.716 + namespace eval test_ns_1 {
1.717 + list [catch {cmd3 a b c} msg] $msg
1.718 + }
1.719 +} {1 {invalid command name "cmd3"}}
1.720 +
1.721 +catch {unset x}
1.722 +test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
1.723 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.724 + set x 314159
1.725 + namespace eval test_ns_1 {
1.726 + set ::x
1.727 + }
1.728 +} {314159}
1.729 +test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
1.730 + namespace eval test_ns_1 {
1.731 + variable x 777
1.732 + set ::test_ns_1::x
1.733 + }
1.734 +} {777}
1.735 +test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
1.736 + namespace eval test_ns_1 {
1.737 + namespace eval test_ns_2 {
1.738 + variable x 1111
1.739 + }
1.740 + set ::test_ns_1::test_ns_2::x
1.741 + }
1.742 +} {1111}
1.743 +test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
1.744 + namespace eval test_ns_1 {
1.745 + namespace eval test_ns_2 {
1.746 + variable x 1111
1.747 + }
1.748 + list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
1.749 + }
1.750 +} {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
1.751 +test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {
1.752 + namespace eval test_ns_1 {
1.753 + namespace eval test_ns_3 {
1.754 + variable ::test_ns_1::test_ns_2::x 2222
1.755 + }
1.756 + }
1.757 + set ::test_ns_1::test_ns_2::x
1.758 +} {2222}
1.759 +test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {
1.760 + namespace eval test_ns_1 {
1.761 + set x
1.762 + }
1.763 +} {777}
1.764 +test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
1.765 + namespace eval test_ns_1 {
1.766 + unset x
1.767 + set x ;# must be global x now
1.768 + }
1.769 +} {314159}
1.770 +test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
1.771 + namespace eval test_ns_1 {
1.772 + list [catch {set wuzzat} msg] $msg
1.773 + }
1.774 +} {1 {can't read "wuzzat": no such variable}}
1.775 +test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
1.776 + namespace eval test_ns_1 {
1.777 + variable a hello
1.778 + }
1.779 + set test_ns_1::a
1.780 +} {hello}
1.781 +catch {unset x}
1.782 +
1.783 +catch {unset l}
1.784 +catch {rename foo {}}
1.785 +test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
1.786 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.787 + proc foo {} {return "global foo"}
1.788 + namespace eval test_ns_1 {
1.789 + proc trigger {} {
1.790 + return [foo]
1.791 + }
1.792 + }
1.793 + set l ""
1.794 + lappend l [test_ns_1::trigger]
1.795 + namespace eval test_ns_1 {
1.796 + # force invalidation of cached ref to "foo" in proc trigger
1.797 + proc foo {} {return "foo in test_ns_1"}
1.798 + }
1.799 + lappend l [test_ns_1::trigger]
1.800 + set l
1.801 +} {{global foo} {foo in test_ns_1}}
1.802 +test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
1.803 + namespace eval test_ns_2 {
1.804 + proc foo {} {return "foo in ::test_ns_2"}
1.805 + }
1.806 + namespace eval test_ns_1 {
1.807 + namespace eval test_ns_2 {}
1.808 + proc trigger {} {
1.809 + return [test_ns_2::foo]
1.810 + }
1.811 + }
1.812 + set l ""
1.813 + lappend l [test_ns_1::trigger]
1.814 + namespace eval test_ns_1 {
1.815 + namespace eval test_ns_2 {
1.816 + # force invalidation of cached ref to "foo" in proc trigger
1.817 + proc foo {} {return "foo in ::test_ns_1::test_ns_2"}
1.818 + }
1.819 + }
1.820 + lappend l [test_ns_1::trigger]
1.821 + set l
1.822 +} {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
1.823 +catch {unset l}
1.824 +catch {rename foo {}}
1.825 +
1.826 +test namespace-19.1 {GetNamespaceFromObj, global name found} {
1.827 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.828 + namespace eval test_ns_1::test_ns_2 {}
1.829 + namespace children ::test_ns_1
1.830 +} {::test_ns_1::test_ns_2}
1.831 +test namespace-19.2 {GetNamespaceFromObj, relative name found} {
1.832 + namespace eval test_ns_1 {
1.833 + namespace children test_ns_2
1.834 + }
1.835 +} {}
1.836 +test namespace-19.3 {GetNamespaceFromObj, name not found} {
1.837 + namespace eval test_ns_1 {
1.838 + list [catch {namespace children test_ns_99} msg] $msg
1.839 + }
1.840 +} {1 {unknown namespace "test_ns_99" in namespace children command}}
1.841 +test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
1.842 + namespace eval test_ns_1 {
1.843 + proc foo {} {
1.844 + return [namespace children test_ns_2]
1.845 + }
1.846 + list [catch {namespace children test_ns_99} msg] $msg
1.847 + }
1.848 + set l {}
1.849 + lappend l [test_ns_1::foo]
1.850 + namespace delete test_ns_1::test_ns_2
1.851 + namespace eval test_ns_1::test_ns_2::test_ns_3 {}
1.852 + lappend l [test_ns_1::foo]
1.853 + set l
1.854 +} {{} ::test_ns_1::test_ns_2::test_ns_3}
1.855 +
1.856 +test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
1.857 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.858 + list [catch {namespace} msg] $msg
1.859 +} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
1.860 +test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} {
1.861 + list [catch {namespace wombat {}} msg] $msg
1.862 +} {1 {bad option "wombat": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
1.863 +test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
1.864 + namespace ch :: test_ns_*
1.865 +} {}
1.866 +
1.867 +test namespace-21.1 {NamespaceChildrenCmd, no args} {
1.868 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.869 + namespace eval test_ns_1::test_ns_2 {}
1.870 + expr {[string first ::test_ns_1 [namespace children]] != -1}
1.871 +} {1}
1.872 +test namespace-21.2 {NamespaceChildrenCmd, no args} {
1.873 + namespace eval test_ns_1 {
1.874 + namespace children
1.875 + }
1.876 +} {::test_ns_1::test_ns_2}
1.877 +test namespace-21.3 {NamespaceChildrenCmd, ns name given} {
1.878 + namespace children ::test_ns_1
1.879 +} {::test_ns_1::test_ns_2}
1.880 +test namespace-21.4 {NamespaceChildrenCmd, ns name given} {
1.881 + namespace eval test_ns_1 {
1.882 + namespace children test_ns_2
1.883 + }
1.884 +} {}
1.885 +test namespace-21.5 {NamespaceChildrenCmd, too many args} {
1.886 + namespace eval test_ns_1 {
1.887 + list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
1.888 + }
1.889 +} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
1.890 +test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
1.891 + namespace eval test_ns_1::test_ns_foo {}
1.892 + namespace children test_ns_1 *f*
1.893 +} {::test_ns_1::test_ns_foo}
1.894 +test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
1.895 + namespace eval test_ns_1::test_ns_foo {}
1.896 + lsort [namespace children test_ns_1 test*]
1.897 +} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
1.898 +
1.899 +test namespace-22.1 {NamespaceCodeCmd, bad args} {
1.900 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.901 + list [catch {namespace code} msg] $msg \
1.902 + [catch {namespace code xxx yyy} msg] $msg
1.903 +} {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}}
1.904 +test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} {
1.905 + namespace eval test_ns_1 {
1.906 + proc cmd {} {return "test_ns_1::cmd"}
1.907 + }
1.908 + namespace code {namespace inscope ::test_ns_1 cmd}
1.909 +} {namespace inscope ::test_ns_1 cmd}
1.910 +test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} {
1.911 + namespace code {namespace inscope ::test_ns_1 cmd}
1.912 +} {namespace inscope ::test_ns_1 cmd}
1.913 +test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {
1.914 + namespace code unknown
1.915 +} {::namespace inscope :: unknown}
1.916 +test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
1.917 + namespace eval test_ns_1 {
1.918 + namespace code cmd
1.919 + }
1.920 +} {::namespace inscope ::test_ns_1 cmd}
1.921 +test namespace-22.6 {NamespaceCodeCmd, in other namespace} {
1.922 + namespace eval test_ns_1 {
1.923 + variable v 42
1.924 + }
1.925 + namespace eval test_ns_2 {
1.926 + proc namespace args {}
1.927 + }
1.928 + namespace eval test_ns_2 [namespace eval test_ns_1 {
1.929 + namespace code {set v}
1.930 + }]
1.931 +} {42}
1.932 +
1.933 +test namespace-23.1 {NamespaceCurrentCmd, bad args} {
1.934 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.935 + list [catch {namespace current xxx} msg] $msg \
1.936 + [catch {namespace current xxx yyy} msg] $msg
1.937 +} {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}}
1.938 +test namespace-23.2 {NamespaceCurrentCmd, at global level} {
1.939 + namespace current
1.940 +} {::}
1.941 +test namespace-23.3 {NamespaceCurrentCmd, in nested ns} {
1.942 + namespace eval test_ns_1::test_ns_2 {
1.943 + namespace current
1.944 + }
1.945 +} {::test_ns_1::test_ns_2}
1.946 +
1.947 +test namespace-24.1 {NamespaceDeleteCmd, no args} {
1.948 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.949 + namespace delete
1.950 +} {}
1.951 +test namespace-24.2 {NamespaceDeleteCmd, one arg} {
1.952 + namespace eval test_ns_1::test_ns_2 {}
1.953 + namespace delete ::test_ns_1
1.954 +} {}
1.955 +test namespace-24.3 {NamespaceDeleteCmd, two args} {
1.956 + namespace eval test_ns_1::test_ns_2 {}
1.957 + list [namespace delete ::test_ns_1::test_ns_2] [namespace delete ::test_ns_1]
1.958 +} {{} {}}
1.959 +test namespace-24.4 {NamespaceDeleteCmd, unknown ns} {
1.960 + list [catch {namespace delete ::test_ns_foo} msg] $msg
1.961 +} {1 {unknown namespace "::test_ns_foo" in namespace delete command}}
1.962 +
1.963 +test namespace-25.1 {NamespaceEvalCmd, bad args} {
1.964 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.965 + list [catch {namespace eval} msg] $msg
1.966 +} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
1.967 +test namespace-25.2 {NamespaceEvalCmd, bad args} {
1.968 + list [catch {namespace test_ns_1} msg] $msg
1.969 +} {1 {bad option "test_ns_1": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
1.970 +catch {unset v}
1.971 +test namespace-25.3 {NamespaceEvalCmd, new namespace} {
1.972 + set v 123
1.973 + namespace eval test_ns_1 {
1.974 + variable v 314159
1.975 + proc p {} {
1.976 + variable v
1.977 + return $v
1.978 + }
1.979 + }
1.980 + test_ns_1::p
1.981 +} {314159}
1.982 +test namespace-25.4 {NamespaceEvalCmd, existing namespace} {
1.983 + namespace eval test_ns_1 {
1.984 + proc q {} {return [expr {[p]+1}]}
1.985 + }
1.986 + test_ns_1::q
1.987 +} {314160}
1.988 +test namespace-25.5 {NamespaceEvalCmd, multiple args} {
1.989 + namespace eval test_ns_1 "set" "v"
1.990 +} {314159}
1.991 +test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
1.992 + list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $errorInfo
1.993 +} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
1.994 + while executing
1.995 +"xxxx"
1.996 + (in namespace eval "::test_ns_1" script line 1)
1.997 + invoked from within
1.998 +"namespace eval test_ns_1 {xxxx}"}}
1.999 +test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} {
1.1000 + list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $errorInfo
1.1001 +} {1 foo {bar
1.1002 + (in namespace eval "::test_ns_1" script line 1)
1.1003 + invoked from within
1.1004 +"namespace eval test_ns_1 {error foo bar baz}"}}
1.1005 +test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} knownBug {
1.1006 + list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $errorInfo
1.1007 +} {1 foo {bar
1.1008 + (in namespace eval "::test_ns_1" script line 1)
1.1009 + invoked from within
1.1010 +"namespace eval test_ns_1 error foo bar baz"}}
1.1011 +catch {unset v}
1.1012 +test namespace-25.9 {NamespaceEvalCmd, 545325} {
1.1013 + namespace eval test_ns_1 info level 0
1.1014 +} {namespace eval test_ns_1 info level 0}
1.1015 +
1.1016 +test namespace-26.1 {NamespaceExportCmd, no args and new ns} {
1.1017 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1018 + namespace export
1.1019 +} {}
1.1020 +test namespace-26.2 {NamespaceExportCmd, just -clear arg} {
1.1021 + namespace export -clear
1.1022 +} {}
1.1023 +test namespace-26.3 {NamespaceExportCmd, pattern can't specify a namespace} {
1.1024 + namespace eval test_ns_1 {
1.1025 + list [catch {namespace export ::zzz} msg] $msg
1.1026 + }
1.1027 +} {1 {invalid export pattern "::zzz": pattern can't specify a namespace}}
1.1028 +test namespace-26.4 {NamespaceExportCmd, one pattern} {
1.1029 + namespace eval test_ns_1 {
1.1030 + namespace export cmd1
1.1031 + proc cmd1 {args} {return "cmd1: $args"}
1.1032 + proc cmd2 {args} {return "cmd2: $args"}
1.1033 + proc cmd3 {args} {return "cmd3: $args"}
1.1034 + proc cmd4 {args} {return "cmd4: $args"}
1.1035 + }
1.1036 + namespace eval test_ns_2 {
1.1037 + namespace import ::test_ns_1::*
1.1038 + }
1.1039 + list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
1.1040 +} {::test_ns_2::cmd1 {cmd1: hello}}
1.1041 +test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {
1.1042 + namespace eval test_ns_1 {
1.1043 + namespace export cmd1 cmd3
1.1044 + }
1.1045 + namespace eval test_ns_2 {
1.1046 + namespace import -force ::test_ns_1::*
1.1047 + }
1.1048 + list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello]
1.1049 +} [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}]
1.1050 +test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} {
1.1051 + namespace eval test_ns_1 {
1.1052 + namespace export
1.1053 + }
1.1054 +} {cmd1 cmd3}
1.1055 +test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
1.1056 + namespace eval test_ns_1 {
1.1057 + namespace export -clear cmd4
1.1058 + }
1.1059 + namespace eval test_ns_2 {
1.1060 + namespace import ::test_ns_1::*
1.1061 + }
1.1062 + list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
1.1063 +} [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
1.1064 +
1.1065 +test namespace-27.1 {NamespaceForgetCmd, no args} {
1.1066 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1067 + namespace forget
1.1068 +} {}
1.1069 +test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} {
1.1070 + list [catch {namespace forget ::test_ns_1::xxx} msg] $msg
1.1071 +} {1 {unknown namespace in namespace forget pattern "::test_ns_1::xxx"}}
1.1072 +test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} {
1.1073 + namespace eval test_ns_1 {
1.1074 + namespace export cmd*
1.1075 + proc cmd1 {args} {return "cmd1: $args"}
1.1076 + proc cmd2 {args} {return "cmd2: $args"}
1.1077 + }
1.1078 + namespace eval test_ns_2 {
1.1079 + namespace import ::test_ns_1::*
1.1080 + namespace forget ::test_ns_1::cmd1
1.1081 + }
1.1082 + info commands ::test_ns_2::*
1.1083 +} {::test_ns_2::cmd2}
1.1084 +
1.1085 +test namespace-28.1 {NamespaceImportCmd, no args} {
1.1086 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1087 + namespace import
1.1088 +} {}
1.1089 +test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} {
1.1090 + namespace import -force
1.1091 +} {}
1.1092 +test namespace-28.3 {NamespaceImportCmd, arg is imported} {
1.1093 + namespace eval test_ns_1 {
1.1094 + namespace export cmd2
1.1095 + proc cmd1 {args} {return "cmd1: $args"}
1.1096 + proc cmd2 {args} {return "cmd2: $args"}
1.1097 + }
1.1098 + namespace eval test_ns_2 {
1.1099 + namespace import ::test_ns_1::*
1.1100 + namespace forget ::test_ns_1::cmd1
1.1101 + }
1.1102 + info commands test_ns_2::*
1.1103 +} {::test_ns_2::cmd2}
1.1104 +
1.1105 +test namespace-29.1 {NamespaceInscopeCmd, bad args} {
1.1106 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1107 + list [catch {namespace inscope} msg] $msg
1.1108 +} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
1.1109 +test namespace-29.2 {NamespaceInscopeCmd, bad args} {
1.1110 + list [catch {namespace inscope ::} msg] $msg
1.1111 +} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
1.1112 +test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} {
1.1113 + list [catch {namespace inscope test_ns_1 {set v}} msg] $msg
1.1114 +} {1 {unknown namespace "test_ns_1" in inscope namespace command}}
1.1115 +test namespace-29.4 {NamespaceInscopeCmd, simple case} {
1.1116 + namespace eval test_ns_1 {
1.1117 + variable v 747
1.1118 + proc cmd {args} {
1.1119 + variable v
1.1120 + return "[namespace current]::cmd: v=$v, args=$args"
1.1121 + }
1.1122 + }
1.1123 + namespace inscope test_ns_1 cmd
1.1124 +} {::test_ns_1::cmd: v=747, args=}
1.1125 +test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
1.1126 + list [namespace inscope test_ns_1 cmd x y z] \
1.1127 + [namespace eval test_ns_1 [concat cmd [list x y z]]]
1.1128 +} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
1.1129 +test namespace-29.6 {NamespaceInscopeCmd, 1400572} knownBug {
1.1130 + namespace inscope test_ns_1 {info level 0}
1.1131 +} {namespace inscope test_ns_1 {info level 0}}
1.1132 +
1.1133 +
1.1134 +test namespace-30.1 {NamespaceOriginCmd, bad args} {
1.1135 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1136 + list [catch {namespace origin} msg] $msg
1.1137 +} {1 {wrong # args: should be "namespace origin name"}}
1.1138 +test namespace-30.2 {NamespaceOriginCmd, bad args} {
1.1139 + list [catch {namespace origin x y} msg] $msg
1.1140 +} {1 {wrong # args: should be "namespace origin name"}}
1.1141 +test namespace-30.3 {NamespaceOriginCmd, command not found} {
1.1142 + list [catch {namespace origin fred} msg] $msg
1.1143 +} {1 {invalid command name "fred"}}
1.1144 +test namespace-30.4 {NamespaceOriginCmd, command isn't imported} {
1.1145 + namespace origin set
1.1146 +} {::set}
1.1147 +test namespace-30.5 {NamespaceOriginCmd, imported command} {
1.1148 + namespace eval test_ns_1 {
1.1149 + namespace export cmd*
1.1150 + proc cmd1 {args} {return "cmd1: $args"}
1.1151 + proc cmd2 {args} {return "cmd2: $args"}
1.1152 + }
1.1153 + namespace eval test_ns_2 {
1.1154 + namespace export *
1.1155 + namespace import ::test_ns_1::*
1.1156 + proc p {} {}
1.1157 + }
1.1158 + namespace eval test_ns_3 {
1.1159 + namespace import ::test_ns_2::*
1.1160 + list [namespace origin foreach] \
1.1161 + [namespace origin p] \
1.1162 + [namespace origin cmd1] \
1.1163 + [namespace origin ::test_ns_2::cmd2]
1.1164 + }
1.1165 +} {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2}
1.1166 +
1.1167 +test namespace-31.1 {NamespaceParentCmd, bad args} {
1.1168 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1169 + list [catch {namespace parent a b} msg] $msg
1.1170 +} {1 {wrong # args: should be "namespace parent ?name?"}}
1.1171 +test namespace-31.2 {NamespaceParentCmd, no args} {
1.1172 + namespace parent
1.1173 +} {}
1.1174 +test namespace-31.3 {NamespaceParentCmd, namespace specified} {
1.1175 + namespace eval test_ns_1 {
1.1176 + namespace eval test_ns_2 {
1.1177 + namespace eval test_ns_3 {}
1.1178 + }
1.1179 + }
1.1180 + list [namespace parent ::] \
1.1181 + [namespace parent test_ns_1::test_ns_2] \
1.1182 + [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}]
1.1183 +} {{} ::test_ns_1 ::test_ns_1}
1.1184 +test namespace-31.4 {NamespaceParentCmd, bad namespace specified} {
1.1185 + list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg
1.1186 +} {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}}
1.1187 +
1.1188 +test namespace-32.1 {NamespaceQualifiersCmd, bad args} {
1.1189 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1190 + list [catch {namespace qualifiers} msg] $msg
1.1191 +} {1 {wrong # args: should be "namespace qualifiers string"}}
1.1192 +test namespace-32.2 {NamespaceQualifiersCmd, bad args} {
1.1193 + list [catch {namespace qualifiers x y} msg] $msg
1.1194 +} {1 {wrong # args: should be "namespace qualifiers string"}}
1.1195 +test namespace-32.3 {NamespaceQualifiersCmd, simple name} {
1.1196 + namespace qualifiers foo
1.1197 +} {}
1.1198 +test namespace-32.4 {NamespaceQualifiersCmd, leading ::} {
1.1199 + namespace qualifiers ::x::y::z
1.1200 +} {::x::y}
1.1201 +test namespace-32.5 {NamespaceQualifiersCmd, no leading ::} {
1.1202 + namespace qualifiers a::b
1.1203 +} {a}
1.1204 +test namespace-32.6 {NamespaceQualifiersCmd, :: argument} {
1.1205 + namespace qualifiers ::
1.1206 +} {}
1.1207 +test namespace-32.7 {NamespaceQualifiersCmd, odd number of :s} {
1.1208 + namespace qualifiers :::::
1.1209 +} {}
1.1210 +test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} {
1.1211 + namespace qualifiers foo:::
1.1212 +} {foo}
1.1213 +
1.1214 +test namespace-33.1 {NamespaceTailCmd, bad args} {
1.1215 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1216 + list [catch {namespace tail} msg] $msg
1.1217 +} {1 {wrong # args: should be "namespace tail string"}}
1.1218 +test namespace-33.2 {NamespaceTailCmd, bad args} {
1.1219 + list [catch {namespace tail x y} msg] $msg
1.1220 +} {1 {wrong # args: should be "namespace tail string"}}
1.1221 +test namespace-33.3 {NamespaceTailCmd, simple name} {
1.1222 + namespace tail foo
1.1223 +} {foo}
1.1224 +test namespace-33.4 {NamespaceTailCmd, leading ::} {
1.1225 + namespace tail ::x::y::z
1.1226 +} {z}
1.1227 +test namespace-33.5 {NamespaceTailCmd, no leading ::} {
1.1228 + namespace tail a::b
1.1229 +} {b}
1.1230 +test namespace-33.6 {NamespaceTailCmd, :: argument} {
1.1231 + namespace tail ::
1.1232 +} {}
1.1233 +test namespace-33.7 {NamespaceTailCmd, odd number of :s} {
1.1234 + namespace tail :::::
1.1235 +} {}
1.1236 +test namespace-33.8 {NamespaceTailCmd, odd number of :s} {
1.1237 + namespace tail foo:::
1.1238 +} {}
1.1239 +
1.1240 +test namespace-34.1 {NamespaceWhichCmd, bad args} {
1.1241 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1242 + list [catch {namespace which} msg] $msg
1.1243 +} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
1.1244 +test namespace-34.2 {NamespaceWhichCmd, bad args} {
1.1245 + list [catch {namespace which -fred} msg] $msg
1.1246 +} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
1.1247 +test namespace-34.3 {NamespaceWhichCmd, bad args} {
1.1248 + list [catch {namespace which -command} msg] $msg
1.1249 +} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
1.1250 +test namespace-34.4 {NamespaceWhichCmd, bad args} {
1.1251 + list [catch {namespace which a b} msg] $msg
1.1252 +} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
1.1253 +test namespace-34.5 {NamespaceWhichCmd, command lookup} {
1.1254 + namespace eval test_ns_1 {
1.1255 + namespace export cmd*
1.1256 + variable v1 111
1.1257 + proc cmd1 {args} {return "cmd1: $args"}
1.1258 + proc cmd2 {args} {return "cmd2: $args"}
1.1259 + }
1.1260 + namespace eval test_ns_2 {
1.1261 + namespace export *
1.1262 + namespace import ::test_ns_1::*
1.1263 + variable v2 222
1.1264 + proc p {} {}
1.1265 + }
1.1266 + namespace eval test_ns_3 {
1.1267 + namespace import ::test_ns_2::*
1.1268 + variable v3 333
1.1269 + list [namespace which -command foreach] \
1.1270 + [namespace which -command p] \
1.1271 + [namespace which -command cmd1] \
1.1272 + [namespace which -command ::test_ns_2::cmd2] \
1.1273 + [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
1.1274 + }
1.1275 +} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
1.1276 +test namespace-34.6 {NamespaceWhichCmd, -command is default} {
1.1277 + namespace eval test_ns_3 {
1.1278 + list [namespace which foreach] \
1.1279 + [namespace which p] \
1.1280 + [namespace which cmd1] \
1.1281 + [namespace which ::test_ns_2::cmd2]
1.1282 + }
1.1283 +} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
1.1284 +test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
1.1285 + namespace eval test_ns_3 {
1.1286 + list [namespace which -variable env] \
1.1287 + [namespace which -variable v3] \
1.1288 + [namespace which -variable ::test_ns_2::v2] \
1.1289 + [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
1.1290 + }
1.1291 +} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
1.1292 +
1.1293 +test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
1.1294 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1295 + namespace eval test_ns_1 {
1.1296 + proc p {} {
1.1297 + namespace delete [namespace current]
1.1298 + return [namespace current]
1.1299 + }
1.1300 + }
1.1301 + test_ns_1::p
1.1302 +} {::test_ns_1}
1.1303 +test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
1.1304 + namespace eval test_ns_1 {
1.1305 + proc q {} {
1.1306 + return [namespace current]
1.1307 + }
1.1308 + }
1.1309 + list [test_ns_1::q] \
1.1310 + [namespace delete test_ns_1] \
1.1311 + [catch {test_ns_1::q} msg] $msg
1.1312 +} {::test_ns_1 {} 1 {invalid command name "test_ns_1::q"}}
1.1313 +
1.1314 +catch {unset x}
1.1315 +catch {unset y}
1.1316 +test namespace-36.1 {DupNsNameInternalRep} {
1.1317 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1318 + namespace eval test_ns_1 {}
1.1319 + set x "::test_ns_1"
1.1320 + list [namespace parent $x] [set y $x] [namespace parent $y]
1.1321 +} {:: ::test_ns_1 ::}
1.1322 +catch {unset x}
1.1323 +catch {unset y}
1.1324 +
1.1325 +test namespace-37.1 {SetNsNameFromAny, ns name found} {
1.1326 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1327 + namespace eval test_ns_1::test_ns_2 {}
1.1328 + namespace eval test_ns_1 {
1.1329 + namespace children ::test_ns_1
1.1330 + }
1.1331 +} {::test_ns_1::test_ns_2}
1.1332 +test namespace-37.2 {SetNsNameFromAny, ns name not found} {
1.1333 + namespace eval test_ns_1 {
1.1334 + list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg
1.1335 + }
1.1336 +} {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}}
1.1337 +
1.1338 +test namespace-38.1 {UpdateStringOfNsName} {
1.1339 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1340 + ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name
1.1341 + list [namespace eval {} {namespace current}] \
1.1342 + [namespace eval {} {namespace current}]
1.1343 +} {:: ::}
1.1344 +
1.1345 +test namespace-39.1 {NamespaceExistsCmd} {
1.1346 + catch {eval namespace delete [namespace children :: test_ns_*]}
1.1347 + namespace eval ::test_ns_z::test_me { variable foo }
1.1348 + list [namespace exists ::] \
1.1349 + [namespace exists ::bogus_namespace] \
1.1350 + [namespace exists ::test_ns_z] \
1.1351 + [namespace exists test_ns_z] \
1.1352 + [namespace exists ::test_ns_z::foo] \
1.1353 + [namespace exists ::test_ns_z::test_me] \
1.1354 + [namespace eval ::test_ns_z { namespace exists ::test_me }] \
1.1355 + [namespace eval ::test_ns_z { namespace exists test_me }] \
1.1356 + [namespace exists :::::test_ns_z]
1.1357 +} {1 0 1 1 0 1 0 1 1}
1.1358 +test namespace-39.2 {NamespaceExistsCmd error} {
1.1359 + list [catch {namespace exists} msg] $msg
1.1360 +} {1 {wrong # args: should be "namespace exists name"}}
1.1361 +test namespace-39.3 {NamespaceExistsCmd error} {
1.1362 + list [catch {namespace exists a b} msg] $msg
1.1363 +} {1 {wrong # args: should be "namespace exists name"}}
1.1364 +
1.1365 +test namespace-40.1 {Ignoring namespace proc "unknown"} {
1.1366 + rename unknown _unknown
1.1367 + proc unknown args {return global}
1.1368 + namespace eval ns {proc unknown args {return local}}
1.1369 + set l [list [namespace eval ns aaa bbb] [namespace eval ns aaa]]
1.1370 + rename unknown {}
1.1371 + rename _unknown unknown
1.1372 + namespace delete ns
1.1373 + set l
1.1374 +} {global global}
1.1375 +
1.1376 +test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
1.1377 + set res {}
1.1378 + namespace eval ns {
1.1379 + set res {}
1.1380 + proc test {} {
1.1381 + set ::g 0
1.1382 + }
1.1383 + lappend ::res [test]
1.1384 + proc set {a b} {
1.1385 + ::set a [incr b]
1.1386 + }
1.1387 + lappend ::res [test]
1.1388 + }
1.1389 + namespace delete ns
1.1390 + set res
1.1391 +} {0 1}
1.1392 +
1.1393 +test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} {
1.1394 + set res {}
1.1395 + namespace eval ns {}
1.1396 + proc ns::a {i} {
1.1397 + variable b
1.1398 + proc set args {return "New proc is called"}
1.1399 + return [set b $i]
1.1400 + }
1.1401 + ns::a 1
1.1402 + set res [ns::a 2]
1.1403 + namespace delete ns
1.1404 + set res
1.1405 +} {New proc is called}
1.1406 +
1.1407 +test namespace-41.3 {Shadowing byte-compiled commands, Bug: 231259} {knownBug} {
1.1408 + set res {}
1.1409 + namespace eval ns {
1.1410 + variable b 0
1.1411 + }
1.1412 +
1.1413 + proc ns::a {i} {
1.1414 + variable b
1.1415 + proc set args {return "New proc is called"}
1.1416 + return [set b $i]
1.1417 + }
1.1418 +
1.1419 + set res [list [ns::a 1] $ns::b]
1.1420 + namespace delete ns
1.1421 + set res
1.1422 +} {{New proc is called} 0}
1.1423 +
1.1424 +# cleanup
1.1425 +catch {rename cmd1 {}}
1.1426 +catch {unset l}
1.1427 +catch {unset msg}
1.1428 +catch {unset trigger}
1.1429 +eval namespace delete [namespace children :: test_ns_*]
1.1430 +::tcltest::cleanupTests
1.1431 +return
1.1432 +
1.1433 +
1.1434 +
1.1435 +
1.1436 +
1.1437 +
1.1438 +
1.1439 +
1.1440 +
1.1441 +
1.1442 +
1.1443 +