| 1 |
578 |
markom |
# Functionality covered: this file contains slightly modified versions of
|
| 2 |
|
|
# the original tests written by Mike McLennan of Lucent Technologies for
|
| 3 |
|
|
# the procedures in tclNamesp.c that implement Tcl's basic support for
|
| 4 |
|
|
# namespaces. Other namespace-related tests appear in namespace.test
|
| 5 |
|
|
# and variable.test.
|
| 6 |
|
|
#
|
| 7 |
|
|
# Sourcing this file into Tcl runs the tests and generates output for
|
| 8 |
|
|
# errors. No output means no errors were found.
|
| 9 |
|
|
#
|
| 10 |
|
|
# Copyright (c) 1997 Sun Microsystems, Inc.
|
| 11 |
|
|
# Copyright (c) 1997 Lucent Technologies
|
| 12 |
|
|
#
|
| 13 |
|
|
# See the file "license.terms" for information on usage and redistribution
|
| 14 |
|
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
| 15 |
|
|
#
|
| 16 |
|
|
# RCS: @(#) $Id: namespace-old.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
|
| 17 |
|
|
|
| 18 |
|
|
if {[string compare test [info procs test]] == 1} then {source defs}
|
| 19 |
|
|
|
| 20 |
|
|
# Clear out any namespaces called test_ns_*
|
| 21 |
|
|
catch {eval namespace delete [namespace children :: test_ns_*]}
|
| 22 |
|
|
|
| 23 |
|
|
test namespace-old-1.1 {usage for "namespace" command} {
|
| 24 |
|
|
list [catch {namespace} msg] $msg
|
| 25 |
|
|
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
|
| 26 |
|
|
|
| 27 |
|
|
test namespace-old-1.2 {global namespace's name is "::" or {}} {
|
| 28 |
|
|
list [namespace current] [namespace eval {} {namespace current}]
|
| 29 |
|
|
} {:: ::}
|
| 30 |
|
|
|
| 31 |
|
|
test namespace-old-1.3 {usage for "namespace eval"} {
|
| 32 |
|
|
list [catch {namespace eval} msg] $msg
|
| 33 |
|
|
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
|
| 34 |
|
|
|
| 35 |
|
|
test namespace-old-1.4 {create new namespaces} {
|
| 36 |
|
|
list [lsort [namespace children :: test_ns_simple*]] \
|
| 37 |
|
|
[namespace eval test_ns_simple {}] \
|
| 38 |
|
|
[namespace eval test_ns_simple2 {}] \
|
| 39 |
|
|
[lsort [namespace children :: test_ns_simple*]]
|
| 40 |
|
|
} {{} {} {} {::test_ns_simple ::test_ns_simple2}}
|
| 41 |
|
|
|
| 42 |
|
|
test namespace-old-1.5 {access a new namespace} {
|
| 43 |
|
|
namespace eval test_ns_simple { namespace current }
|
| 44 |
|
|
} {::test_ns_simple}
|
| 45 |
|
|
|
| 46 |
|
|
test namespace-old-1.6 {usage for "namespace eval"} {
|
| 47 |
|
|
list [catch {namespace eval} msg] $msg
|
| 48 |
|
|
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
|
| 49 |
|
|
|
| 50 |
|
|
test namespace-old-1.7 {usage for "namespace eval"} {
|
| 51 |
|
|
list [catch {namespace eval test_ns_xyzzy} msg] $msg
|
| 52 |
|
|
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
|
| 53 |
|
|
|
| 54 |
|
|
test namespace-old-1.8 {command "namespace eval" concatenates args} {
|
| 55 |
|
|
namespace eval test_ns_simple namespace current
|
| 56 |
|
|
} {::test_ns_simple}
|
| 57 |
|
|
|
| 58 |
|
|
test namespace-old-1.9 {add elements to a namespace} {
|
| 59 |
|
|
namespace eval test_ns_simple {
|
| 60 |
|
|
variable test_ns_x 0
|
| 61 |
|
|
proc test {test_ns_x} {
|
| 62 |
|
|
return "test: $test_ns_x"
|
| 63 |
|
|
}
|
| 64 |
|
|
}
|
| 65 |
|
|
} {}
|
| 66 |
|
|
|
| 67 |
|
|
test namespace-old-1.10 {commands in a namespace} {
|
| 68 |
|
|
namespace eval test_ns_simple { info commands [namespace current]::*}
|
| 69 |
|
|
} {::test_ns_simple::test}
|
| 70 |
|
|
|
| 71 |
|
|
test namespace-old-1.11 {variables in a namespace} {
|
| 72 |
|
|
namespace eval test_ns_simple { info vars [namespace current]::* }
|
| 73 |
|
|
} {::test_ns_simple::test_ns_x}
|
| 74 |
|
|
|
| 75 |
|
|
test namespace-old-1.12 {global vars are separate from locals vars} {
|
| 76 |
|
|
list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]
|
| 77 |
|
|
} {{test: 123} 0}
|
| 78 |
|
|
|
| 79 |
|
|
test namespace-old-1.13 {add to an existing namespace} {
|
| 80 |
|
|
namespace eval test_ns_simple {
|
| 81 |
|
|
variable test_ns_y 123
|
| 82 |
|
|
proc _backdoor {cmd} {
|
| 83 |
|
|
eval $cmd
|
| 84 |
|
|
}
|
| 85 |
|
|
}
|
| 86 |
|
|
} ""
|
| 87 |
|
|
|
| 88 |
|
|
test namespace-old-1.14 {commands in a namespace} {
|
| 89 |
|
|
lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
|
| 90 |
|
|
} {::test_ns_simple::_backdoor ::test_ns_simple::test}
|
| 91 |
|
|
|
| 92 |
|
|
test namespace-old-1.15 {variables in a namespace} {
|
| 93 |
|
|
lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]
|
| 94 |
|
|
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
|
| 95 |
|
|
test namespace-old-1.16 {variables in a namespace} {
|
| 96 |
|
|
lsort [info vars test_ns_simple::*]
|
| 97 |
|
|
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
|
| 98 |
|
|
|
| 99 |
|
|
test namespace-old-1.17 {commands in a namespace are hidden} {
|
| 100 |
|
|
list [catch "_backdoor {return yes!}" msg] $msg
|
| 101 |
|
|
} {1 {invalid command name "_backdoor"}}
|
| 102 |
|
|
test namespace-old-1.18 {using namespace qualifiers} {
|
| 103 |
|
|
list [catch "test_ns_simple::_backdoor {return yes!}" msg] $msg
|
| 104 |
|
|
} {0 yes!}
|
| 105 |
|
|
test namespace-old-1.19 {using absolute namespace qualifiers} {
|
| 106 |
|
|
list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg
|
| 107 |
|
|
} {0 yes!}
|
| 108 |
|
|
|
| 109 |
|
|
test namespace-old-1.20 {variables in a namespace are hidden} {
|
| 110 |
|
|
list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg
|
| 111 |
|
|
} {1 {can't read "test_ns_x": no such variable} 1 {can't read "test_ns_y": no such variable}}
|
| 112 |
|
|
test namespace-old-1.21 {using namespace qualifiers} {
|
| 113 |
|
|
list [catch "set test_ns_simple::test_ns_x" msg] $msg \
|
| 114 |
|
|
[catch "set test_ns_simple::test_ns_y" msg] $msg
|
| 115 |
|
|
} {0 0 0 123}
|
| 116 |
|
|
test namespace-old-1.22 {using absolute namespace qualifiers} {
|
| 117 |
|
|
list [catch "set ::test_ns_simple::test_ns_x" msg] $msg \
|
| 118 |
|
|
[catch "set ::test_ns_simple::test_ns_y" msg] $msg
|
| 119 |
|
|
} {0 0 0 123}
|
| 120 |
|
|
test namespace-old-1.23 {variables can be accessed within a namespace} {
|
| 121 |
|
|
test_ns_simple::_backdoor {
|
| 122 |
|
|
variable test_ns_x
|
| 123 |
|
|
variable test_ns_y
|
| 124 |
|
|
return "$test_ns_x $test_ns_y"
|
| 125 |
|
|
}
|
| 126 |
|
|
} {0 123}
|
| 127 |
|
|
|
| 128 |
|
|
test namespace-old-1.24 {setting global variables} {
|
| 129 |
|
|
test_ns_simple::_backdoor {variable test_ns_x; set test_ns_x "new val"}
|
| 130 |
|
|
namespace eval test_ns_simple {set test_ns_x}
|
| 131 |
|
|
} {new val}
|
| 132 |
|
|
|
| 133 |
|
|
test namespace-old-1.25 {qualified variables don't need a global declaration} {
|
| 134 |
|
|
namespace eval test_ns_another { variable test_ns_x 456 }
|
| 135 |
|
|
set cmd {set ::test_ns_another::test_ns_x}
|
| 136 |
|
|
list [catch {test_ns_simple::_backdoor "$cmd some-value"} msg] $msg \
|
| 137 |
|
|
[eval $cmd]
|
| 138 |
|
|
} {0 some-value some-value}
|
| 139 |
|
|
|
| 140 |
|
|
test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
|
| 141 |
|
|
namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }
|
| 142 |
|
|
set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}
|
| 143 |
|
|
list [test_ns_simple::_backdoor $cmd] [eval $cmd]
|
| 144 |
|
|
} {{12 34} {12 34}}
|
| 145 |
|
|
|
| 146 |
|
|
test namespace-old-1.27 {can create commands with null names} {
|
| 147 |
|
|
proc test_ns_simple:: {args} {return $args}
|
| 148 |
|
|
} {}
|
| 149 |
|
|
|
| 150 |
|
|
# -----------------------------------------------------------------------
|
| 151 |
|
|
# TEST: using "info" in namespace contexts
|
| 152 |
|
|
# -----------------------------------------------------------------------
|
| 153 |
|
|
test namespace-old-2.1 {querying: info commands} {
|
| 154 |
|
|
lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]
|
| 155 |
|
|
} {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}
|
| 156 |
|
|
|
| 157 |
|
|
test namespace-old-2.2 {querying: info procs} {
|
| 158 |
|
|
lsort [test_ns_simple::_backdoor {info procs}]
|
| 159 |
|
|
} {{} _backdoor test}
|
| 160 |
|
|
|
| 161 |
|
|
test namespace-old-2.3 {querying: info vars} {
|
| 162 |
|
|
lsort [info vars test_ns_simple::*]
|
| 163 |
|
|
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
|
| 164 |
|
|
|
| 165 |
|
|
test namespace-old-2.4 {querying: info vars} {
|
| 166 |
|
|
lsort [test_ns_simple::_backdoor {info vars [namespace current]::*}]
|
| 167 |
|
|
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
|
| 168 |
|
|
|
| 169 |
|
|
test namespace-old-2.5 {querying: info locals} {
|
| 170 |
|
|
lsort [test_ns_simple::_backdoor {info locals}]
|
| 171 |
|
|
} {cmd}
|
| 172 |
|
|
|
| 173 |
|
|
test namespace-old-2.6 {querying: info exists} {
|
| 174 |
|
|
test_ns_simple::_backdoor {info exists test_ns_x}
|
| 175 |
|
|
} {0}
|
| 176 |
|
|
|
| 177 |
|
|
test namespace-old-2.7 {querying: info exists} {
|
| 178 |
|
|
test_ns_simple::_backdoor {info exists cmd}
|
| 179 |
|
|
} {1}
|
| 180 |
|
|
|
| 181 |
|
|
test namespace-old-2.8 {querying: info args} {
|
| 182 |
|
|
info args test_ns_simple::_backdoor
|
| 183 |
|
|
} {cmd}
|
| 184 |
|
|
|
| 185 |
|
|
test namespace-old-2.9 {querying: info body} {
|
| 186 |
|
|
string trim [info body test_ns_simple::test]
|
| 187 |
|
|
} {return "test: $test_ns_x"}
|
| 188 |
|
|
|
| 189 |
|
|
# -----------------------------------------------------------------------
|
| 190 |
|
|
# TEST: namespace qualifiers, namespace tail
|
| 191 |
|
|
# -----------------------------------------------------------------------
|
| 192 |
|
|
test namespace-old-3.1 {usage for "namespace qualifiers"} {
|
| 193 |
|
|
list [catch "namespace qualifiers" msg] $msg
|
| 194 |
|
|
} {1 {wrong # args: should be "namespace qualifiers string"}}
|
| 195 |
|
|
|
| 196 |
|
|
test namespace-old-3.2 {querying: namespace qualifiers} {
|
| 197 |
|
|
list [namespace qualifiers ""] \
|
| 198 |
|
|
[namespace qualifiers ::] \
|
| 199 |
|
|
[namespace qualifiers x] \
|
| 200 |
|
|
[namespace qualifiers ::x] \
|
| 201 |
|
|
[namespace qualifiers foo::x] \
|
| 202 |
|
|
[namespace qualifiers ::foo::bar::xyz]
|
| 203 |
|
|
} {{} {} {} {} foo ::foo::bar}
|
| 204 |
|
|
|
| 205 |
|
|
test namespace-old-3.3 {usage for "namespace tail"} {
|
| 206 |
|
|
list [catch "namespace tail" msg] $msg
|
| 207 |
|
|
} {1 {wrong # args: should be "namespace tail string"}}
|
| 208 |
|
|
|
| 209 |
|
|
test namespace-old-3.4 {querying: namespace tail} {
|
| 210 |
|
|
list [namespace tail ""] \
|
| 211 |
|
|
[namespace tail ::] \
|
| 212 |
|
|
[namespace tail x] \
|
| 213 |
|
|
[namespace tail ::x] \
|
| 214 |
|
|
[namespace tail foo::x] \
|
| 215 |
|
|
[namespace tail ::foo::bar::xyz]
|
| 216 |
|
|
} {{} {} x x x xyz}
|
| 217 |
|
|
|
| 218 |
|
|
# -----------------------------------------------------------------------
|
| 219 |
|
|
# TEST: delete commands and namespaces
|
| 220 |
|
|
# -----------------------------------------------------------------------
|
| 221 |
|
|
test namespace-old-4.1 {define test namespaces} {
|
| 222 |
|
|
namespace eval test_ns_delete {
|
| 223 |
|
|
namespace eval ns1 {
|
| 224 |
|
|
variable var1 1
|
| 225 |
|
|
proc cmd1 {} {return "cmd1"}
|
| 226 |
|
|
}
|
| 227 |
|
|
namespace eval ns2 {
|
| 228 |
|
|
variable var2 2
|
| 229 |
|
|
proc cmd2 {} {return "cmd2"}
|
| 230 |
|
|
}
|
| 231 |
|
|
namespace eval another {}
|
| 232 |
|
|
lsort [namespace children]
|
| 233 |
|
|
}
|
| 234 |
|
|
} {::test_ns_delete::another ::test_ns_delete::ns1 ::test_ns_delete::ns2}
|
| 235 |
|
|
|
| 236 |
|
|
test namespace-old-4.2 {it's okay to invoke "namespace delete" with no args} {
|
| 237 |
|
|
list [catch {namespace delete} msg] $msg
|
| 238 |
|
|
} {0 {}}
|
| 239 |
|
|
|
| 240 |
|
|
test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
|
| 241 |
|
|
set cmd {
|
| 242 |
|
|
namespace eval test_ns_delete {namespace delete ns*}
|
| 243 |
|
|
}
|
| 244 |
|
|
list [catch $cmd msg] $msg
|
| 245 |
|
|
} {1 {unknown namespace "ns*" in namespace delete command}}
|
| 246 |
|
|
|
| 247 |
|
|
test namespace-old-4.4 {command "namespace delete" handles multiple args} {
|
| 248 |
|
|
set cmd {
|
| 249 |
|
|
namespace eval test_ns_delete {
|
| 250 |
|
|
eval namespace delete \
|
| 251 |
|
|
[namespace children [namespace current] ns?]
|
| 252 |
|
|
}
|
| 253 |
|
|
}
|
| 254 |
|
|
list [catch $cmd msg] $msg [namespace children test_ns_delete]
|
| 255 |
|
|
} {0 {} ::test_ns_delete::another}
|
| 256 |
|
|
|
| 257 |
|
|
# -----------------------------------------------------------------------
|
| 258 |
|
|
# TEST: namespace hierarchy
|
| 259 |
|
|
# -----------------------------------------------------------------------
|
| 260 |
|
|
test namespace-old-5.1 {define nested namespaces} {
|
| 261 |
|
|
set test_ns_var_global "var in ::"
|
| 262 |
|
|
proc test_ns_cmd_global {} {return "cmd in ::"}
|
| 263 |
|
|
|
| 264 |
|
|
namespace eval test_ns_hier1 {
|
| 265 |
|
|
set test_ns_var_hier1 "particular to hier1"
|
| 266 |
|
|
proc test_ns_cmd_hier1 {} {return "particular to hier1"}
|
| 267 |
|
|
|
| 268 |
|
|
set test_ns_level 1
|
| 269 |
|
|
proc test_ns_show {} {return "[namespace current]: 1"}
|
| 270 |
|
|
|
| 271 |
|
|
namespace eval test_ns_hier2 {
|
| 272 |
|
|
set test_ns_var_hier2 "particular to hier2"
|
| 273 |
|
|
proc test_ns_cmd_hier2 {} {return "particular to hier2"}
|
| 274 |
|
|
|
| 275 |
|
|
set test_ns_level 2
|
| 276 |
|
|
proc test_ns_show {} {return "[namespace current]: 2"}
|
| 277 |
|
|
|
| 278 |
|
|
namespace eval test_ns_hier3a {}
|
| 279 |
|
|
namespace eval test_ns_hier3b {}
|
| 280 |
|
|
}
|
| 281 |
|
|
|
| 282 |
|
|
namespace eval test_ns_hier2a {}
|
| 283 |
|
|
namespace eval test_ns_hier2b {}
|
| 284 |
|
|
}
|
| 285 |
|
|
} {}
|
| 286 |
|
|
|
| 287 |
|
|
test namespace-old-5.2 {namespaces can be nested} {
|
| 288 |
|
|
list [namespace eval test_ns_hier1 {namespace current}] \
|
| 289 |
|
|
[namespace eval test_ns_hier1 {
|
| 290 |
|
|
namespace eval test_ns_hier2 {namespace current}
|
| 291 |
|
|
}]
|
| 292 |
|
|
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
|
| 293 |
|
|
|
| 294 |
|
|
test namespace-old-5.3 {namespace qualifiers work in namespace command} {
|
| 295 |
|
|
list [namespace eval ::test_ns_hier1 {namespace current}] \
|
| 296 |
|
|
[namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
|
| 297 |
|
|
[namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
|
| 298 |
|
|
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
|
| 299 |
|
|
|
| 300 |
|
|
test namespace-old-5.4 {nested namespaces can access global namespace} {
|
| 301 |
|
|
list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
|
| 302 |
|
|
[namespace eval test_ns_hier1 {test_ns_cmd_global}] \
|
| 303 |
|
|
[namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
|
| 304 |
|
|
[namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
|
| 305 |
|
|
} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
|
| 306 |
|
|
|
| 307 |
|
|
test namespace-old-5.5 {variables in different namespaces don't conflict} {
|
| 308 |
|
|
list [set test_ns_hier1::test_ns_level] \
|
| 309 |
|
|
[set test_ns_hier1::test_ns_hier2::test_ns_level]
|
| 310 |
|
|
} {1 2}
|
| 311 |
|
|
|
| 312 |
|
|
test namespace-old-5.6 {commands in different namespaces don't conflict} {
|
| 313 |
|
|
list [test_ns_hier1::test_ns_show] \
|
| 314 |
|
|
[test_ns_hier1::test_ns_hier2::test_ns_show]
|
| 315 |
|
|
} {{::test_ns_hier1: 1} {::test_ns_hier1::test_ns_hier2: 2}}
|
| 316 |
|
|
|
| 317 |
|
|
test namespace-old-5.7 {nested namespaces don't see variables in parent} {
|
| 318 |
|
|
set cmd {
|
| 319 |
|
|
namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_hier1}
|
| 320 |
|
|
}
|
| 321 |
|
|
list [catch $cmd msg] $msg
|
| 322 |
|
|
} {1 {can't read "test_ns_var_hier1": no such variable}}
|
| 323 |
|
|
|
| 324 |
|
|
test namespace-old-5.8 {nested namespaces don't see commands in parent} {
|
| 325 |
|
|
set cmd {
|
| 326 |
|
|
namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_hier1}
|
| 327 |
|
|
}
|
| 328 |
|
|
list [catch $cmd msg] $msg
|
| 329 |
|
|
} {1 {invalid command name "test_ns_cmd_hier1"}}
|
| 330 |
|
|
|
| 331 |
|
|
test namespace-old-5.9 {usage for "namespace children"} {
|
| 332 |
|
|
list [catch {namespace children test_ns_hier1 y z} msg] $msg
|
| 333 |
|
|
} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
|
| 334 |
|
|
|
| 335 |
|
|
test namespace-old-5.10 {command "namespace children" must get valid namespace} {
|
| 336 |
|
|
list [catch {namespace children xyzzy} msg] $msg
|
| 337 |
|
|
} {1 {unknown namespace "xyzzy" in namespace children command}}
|
| 338 |
|
|
|
| 339 |
|
|
test namespace-old-5.11 {querying namespace children} {
|
| 340 |
|
|
lsort [namespace children :: test_ns_hier*]
|
| 341 |
|
|
} {::test_ns_hier1}
|
| 342 |
|
|
|
| 343 |
|
|
test namespace-old-5.12 {querying namespace children} {
|
| 344 |
|
|
lsort [namespace children test_ns_hier1]
|
| 345 |
|
|
} {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
|
| 346 |
|
|
|
| 347 |
|
|
test namespace-old-5.13 {querying namespace children} {
|
| 348 |
|
|
lsort [namespace eval test_ns_hier1 {namespace children}]
|
| 349 |
|
|
} {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
|
| 350 |
|
|
|
| 351 |
|
|
test namespace-old-5.14 {querying namespace children} {
|
| 352 |
|
|
lsort [namespace children test_ns_hier1::test_ns_hier2]
|
| 353 |
|
|
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
|
| 354 |
|
|
|
| 355 |
|
|
test namespace-old-5.15 {querying namespace children} {
|
| 356 |
|
|
lsort [namespace eval test_ns_hier1::test_ns_hier2 {namespace children}]
|
| 357 |
|
|
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
|
| 358 |
|
|
|
| 359 |
|
|
test namespace-old-5.16 {querying namespace children with patterns} {
|
| 360 |
|
|
lsort [namespace children test_ns_hier1::test_ns_hier2 test_ns_*]
|
| 361 |
|
|
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
|
| 362 |
|
|
|
| 363 |
|
|
test namespace-old-5.17 {querying namespace children with patterns} {
|
| 364 |
|
|
lsort [namespace children test_ns_hier1::test_ns_hier2 *b]
|
| 365 |
|
|
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
|
| 366 |
|
|
|
| 367 |
|
|
test namespace-old-5.18 {usage for "namespace parent"} {
|
| 368 |
|
|
list [catch {namespace parent x y} msg] $msg
|
| 369 |
|
|
} {1 {wrong # args: should be "namespace parent ?name?"}}
|
| 370 |
|
|
|
| 371 |
|
|
test namespace-old-5.19 {command "namespace parent" must get valid namespace} {
|
| 372 |
|
|
list [catch {namespace parent xyzzy} msg] $msg
|
| 373 |
|
|
} {1 {unknown namespace "xyzzy" in namespace parent command}}
|
| 374 |
|
|
|
| 375 |
|
|
test namespace-old-5.20 {querying namespace parent} {
|
| 376 |
|
|
list [namespace eval :: {namespace parent}] \
|
| 377 |
|
|
[namespace eval test_ns_hier1 {namespace parent}] \
|
| 378 |
|
|
[namespace eval test_ns_hier1::test_ns_hier2 {namespace parent}] \
|
| 379 |
|
|
[namespace eval test_ns_hier1::test_ns_hier2::test_ns_hier3a {namespace parent}] \
|
| 380 |
|
|
} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
|
| 381 |
|
|
|
| 382 |
|
|
test namespace-old-5.21 {querying namespace parent for explicit namespace} {
|
| 383 |
|
|
list [namespace parent ::] \
|
| 384 |
|
|
[namespace parent test_ns_hier1] \
|
| 385 |
|
|
[namespace parent test_ns_hier1::test_ns_hier2] \
|
| 386 |
|
|
[namespace parent test_ns_hier1::test_ns_hier2::test_ns_hier3a]
|
| 387 |
|
|
} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
|
| 388 |
|
|
|
| 389 |
|
|
# -----------------------------------------------------------------------
|
| 390 |
|
|
# TEST: name resolution and caching
|
| 391 |
|
|
# -----------------------------------------------------------------------
|
| 392 |
|
|
test namespace-old-6.1 {relative ns names only looked up in current ns} {
|
| 393 |
|
|
namespace eval test_ns_cache1 {}
|
| 394 |
|
|
namespace eval test_ns_cache2 {}
|
| 395 |
|
|
namespace eval test_ns_cache2::test_ns_cache3 {}
|
| 396 |
|
|
set trigger {
|
| 397 |
|
|
namespace eval test_ns_cache2 {namespace current}
|
| 398 |
|
|
}
|
| 399 |
|
|
set trigger2 {
|
| 400 |
|
|
namespace eval test_ns_cache2::test_ns_cache3 {namespace current}
|
| 401 |
|
|
}
|
| 402 |
|
|
list [namespace eval test_ns_cache1 $trigger] \
|
| 403 |
|
|
[namespace eval test_ns_cache1 $trigger2]
|
| 404 |
|
|
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
|
| 405 |
|
|
|
| 406 |
|
|
test namespace-old-6.2 {relative ns names only looked up in current ns} {
|
| 407 |
|
|
namespace eval test_ns_cache1::test_ns_cache2 {}
|
| 408 |
|
|
list [namespace eval test_ns_cache1 $trigger] \
|
| 409 |
|
|
[namespace eval test_ns_cache1 $trigger2]
|
| 410 |
|
|
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
|
| 411 |
|
|
|
| 412 |
|
|
test namespace-old-6.3 {relative ns names only looked up in current ns} {
|
| 413 |
|
|
namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {}
|
| 414 |
|
|
list [namespace eval test_ns_cache1 $trigger] \
|
| 415 |
|
|
[namespace eval test_ns_cache1 $trigger2]
|
| 416 |
|
|
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
|
| 417 |
|
|
|
| 418 |
|
|
test namespace-old-6.4 {relative ns names only looked up in current ns} {
|
| 419 |
|
|
namespace delete test_ns_cache1::test_ns_cache2
|
| 420 |
|
|
list [namespace eval test_ns_cache1 $trigger] \
|
| 421 |
|
|
[namespace eval test_ns_cache1 $trigger2]
|
| 422 |
|
|
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
|
| 423 |
|
|
|
| 424 |
|
|
test namespace-old-6.5 {define test commands} {
|
| 425 |
|
|
proc test_ns_cache_cmd {} {
|
| 426 |
|
|
return "global version"
|
| 427 |
|
|
}
|
| 428 |
|
|
namespace eval test_ns_cache1 {
|
| 429 |
|
|
proc trigger {} {
|
| 430 |
|
|
test_ns_cache_cmd
|
| 431 |
|
|
}
|
| 432 |
|
|
}
|
| 433 |
|
|
test_ns_cache1::trigger
|
| 434 |
|
|
} {global version}
|
| 435 |
|
|
|
| 436 |
|
|
test namespace-old-6.6 {one-level check for command shadowing} {
|
| 437 |
|
|
proc test_ns_cache1::test_ns_cache_cmd {} {
|
| 438 |
|
|
return "cache1 version"
|
| 439 |
|
|
}
|
| 440 |
|
|
test_ns_cache1::trigger
|
| 441 |
|
|
} {cache1 version}
|
| 442 |
|
|
|
| 443 |
|
|
test namespace-old-6.7 {renaming commands changes command epoch} {
|
| 444 |
|
|
namespace eval test_ns_cache1 {
|
| 445 |
|
|
rename test_ns_cache_cmd test_ns_new
|
| 446 |
|
|
}
|
| 447 |
|
|
test_ns_cache1::trigger
|
| 448 |
|
|
} {global version}
|
| 449 |
|
|
|
| 450 |
|
|
test namespace-old-6.8 {renaming back handles shadowing} {
|
| 451 |
|
|
namespace eval test_ns_cache1 {
|
| 452 |
|
|
rename test_ns_new test_ns_cache_cmd
|
| 453 |
|
|
}
|
| 454 |
|
|
test_ns_cache1::trigger
|
| 455 |
|
|
} {cache1 version}
|
| 456 |
|
|
|
| 457 |
|
|
test namespace-old-6.9 {deleting commands changes command epoch} {
|
| 458 |
|
|
namespace eval test_ns_cache1 {
|
| 459 |
|
|
rename test_ns_cache_cmd ""
|
| 460 |
|
|
}
|
| 461 |
|
|
test_ns_cache1::trigger
|
| 462 |
|
|
} {global version}
|
| 463 |
|
|
|
| 464 |
|
|
test namespace-old-6.10 {define test namespaces} {
|
| 465 |
|
|
namespace eval test_ns_cache2 {
|
| 466 |
|
|
proc test_ns_cache_cmd {} {
|
| 467 |
|
|
return "global cache2 version"
|
| 468 |
|
|
}
|
| 469 |
|
|
}
|
| 470 |
|
|
namespace eval test_ns_cache1 {
|
| 471 |
|
|
proc trigger {} {
|
| 472 |
|
|
test_ns_cache2::test_ns_cache_cmd
|
| 473 |
|
|
}
|
| 474 |
|
|
}
|
| 475 |
|
|
namespace eval test_ns_cache1::test_ns_cache2 {
|
| 476 |
|
|
proc trigger {} {
|
| 477 |
|
|
test_ns_cache_cmd
|
| 478 |
|
|
}
|
| 479 |
|
|
}
|
| 480 |
|
|
list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
|
| 481 |
|
|
} {{global cache2 version} {global version}}
|
| 482 |
|
|
|
| 483 |
|
|
test namespace-old-6.11 {commands affect all parent namespaces} {
|
| 484 |
|
|
proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
|
| 485 |
|
|
return "cache2 version"
|
| 486 |
|
|
}
|
| 487 |
|
|
list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
|
| 488 |
|
|
} {{cache2 version} {cache2 version}}
|
| 489 |
|
|
|
| 490 |
|
|
test namespace-old-6.12 {define test variables} {
|
| 491 |
|
|
variable test_ns_cache_var "global version"
|
| 492 |
|
|
set trigger {set test_ns_cache_var}
|
| 493 |
|
|
namespace eval test_ns_cache1 $trigger
|
| 494 |
|
|
} {global version}
|
| 495 |
|
|
|
| 496 |
|
|
test namespace-old-6.13 {one-level check for variable shadowing} {
|
| 497 |
|
|
namespace eval test_ns_cache1 {
|
| 498 |
|
|
variable test_ns_cache_var "cache1 version"
|
| 499 |
|
|
}
|
| 500 |
|
|
namespace eval test_ns_cache1 $trigger
|
| 501 |
|
|
} {cache1 version}
|
| 502 |
|
|
|
| 503 |
|
|
test namespace-old-6.14 {deleting variables changes variable epoch} {
|
| 504 |
|
|
namespace eval test_ns_cache1 {
|
| 505 |
|
|
unset test_ns_cache_var
|
| 506 |
|
|
}
|
| 507 |
|
|
namespace eval test_ns_cache1 $trigger
|
| 508 |
|
|
} {global version}
|
| 509 |
|
|
|
| 510 |
|
|
test namespace-old-6.15 {define test namespaces} {
|
| 511 |
|
|
namespace eval test_ns_cache2 {
|
| 512 |
|
|
variable test_ns_cache_var "global cache2 version"
|
| 513 |
|
|
}
|
| 514 |
|
|
set trigger2 {set test_ns_cache2::test_ns_cache_var}
|
| 515 |
|
|
list [namespace eval test_ns_cache1 $trigger2] \
|
| 516 |
|
|
[namespace eval test_ns_cache1::test_ns_cache2 $trigger]
|
| 517 |
|
|
} {{global cache2 version} {global version}}
|
| 518 |
|
|
|
| 519 |
|
|
test namespace-old-6.16 {public variables affect all parent namespaces} {
|
| 520 |
|
|
variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
|
| 521 |
|
|
list [namespace eval test_ns_cache1 $trigger2] \
|
| 522 |
|
|
[namespace eval test_ns_cache1::test_ns_cache2 $trigger]
|
| 523 |
|
|
} {{cache2 version} {cache2 version}}
|
| 524 |
|
|
|
| 525 |
|
|
test namespace-old-6.17 {usage for "namespace which"} {
|
| 526 |
|
|
list [catch "namespace which -baz" msg] $msg
|
| 527 |
|
|
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
|
| 528 |
|
|
test namespace-old-6.18 {usage for "namespace which"} {
|
| 529 |
|
|
list [catch "namespace which -command" msg] $msg
|
| 530 |
|
|
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
|
| 531 |
|
|
|
| 532 |
|
|
test namespace-old-6.19 {querying: namespace which -command} {
|
| 533 |
|
|
proc test_ns_cache1::test_ns_cache_cmd {} {
|
| 534 |
|
|
return "cache1 version"
|
| 535 |
|
|
}
|
| 536 |
|
|
list [namespace eval :: {namespace which test_ns_cache_cmd}] \
|
| 537 |
|
|
[namespace eval test_ns_cache1 {namespace which test_ns_cache_cmd}] \
|
| 538 |
|
|
[namespace eval :: {namespace which -command test_ns_cache_cmd}] \
|
| 539 |
|
|
[namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}]
|
| 540 |
|
|
} {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd}
|
| 541 |
|
|
|
| 542 |
|
|
test namespace-old-6.20 {command "namespace which" may not find commands} {
|
| 543 |
|
|
namespace eval test_ns_cache1 {namespace which -command xyzzy}
|
| 544 |
|
|
} {}
|
| 545 |
|
|
|
| 546 |
|
|
test namespace-old-6.21 {querying: namespace which -variable} {
|
| 547 |
|
|
namespace eval test_ns_cache1::test_ns_cache2 {
|
| 548 |
|
|
namespace which -variable test_ns_cache_var
|
| 549 |
|
|
}
|
| 550 |
|
|
} {::test_ns_cache1::test_ns_cache2::test_ns_cache_var}
|
| 551 |
|
|
|
| 552 |
|
|
test namespace-old-6.22 {command "namespace which" may not find variables} {
|
| 553 |
|
|
namespace eval test_ns_cache1 {namespace which -variable xyzzy}
|
| 554 |
|
|
} {}
|
| 555 |
|
|
|
| 556 |
|
|
# -----------------------------------------------------------------------
|
| 557 |
|
|
# TEST: uplevel/upvar across namespace boundaries
|
| 558 |
|
|
# -----------------------------------------------------------------------
|
| 559 |
|
|
test namespace-old-7.1 {define test namespace} {
|
| 560 |
|
|
namespace eval test_ns_uplevel {
|
| 561 |
|
|
variable x 0
|
| 562 |
|
|
variable y 1
|
| 563 |
|
|
|
| 564 |
|
|
proc show_vars {num} {
|
| 565 |
|
|
return [uplevel $num {info vars}]
|
| 566 |
|
|
}
|
| 567 |
|
|
proc test_uplevel {num} {
|
| 568 |
|
|
set a 0
|
| 569 |
|
|
set b 1
|
| 570 |
|
|
namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
|
| 571 |
|
|
}
|
| 572 |
|
|
}
|
| 573 |
|
|
} {}
|
| 574 |
|
|
test namespace-old-7.2 {uplevel can access namespace call frame} {
|
| 575 |
|
|
list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] x]>=0}] \
|
| 576 |
|
|
[expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] y]>=0}]
|
| 577 |
|
|
} {1 1}
|
| 578 |
|
|
test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
|
| 579 |
|
|
lsort [test_ns_uplevel::test_uplevel 2]
|
| 580 |
|
|
} {a b num}
|
| 581 |
|
|
test namespace-old-7.4 {uplevel can go up to global context} {
|
| 582 |
|
|
expr {[test_ns_uplevel::test_uplevel 3] == [info globals]}
|
| 583 |
|
|
} {1}
|
| 584 |
|
|
|
| 585 |
|
|
test namespace-old-7.5 {absolute call frame references work too} {
|
| 586 |
|
|
list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] x]>=0}] \
|
| 587 |
|
|
[expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] y]>=0}]
|
| 588 |
|
|
} {1 1}
|
| 589 |
|
|
test namespace-old-7.6 {absolute call frame references work too} {
|
| 590 |
|
|
lsort [test_ns_uplevel::test_uplevel #1]
|
| 591 |
|
|
} {a b num}
|
| 592 |
|
|
test namespace-old-7.7 {absolute call frame references work too} {
|
| 593 |
|
|
expr {[test_ns_uplevel::test_uplevel #0] == [info globals]}
|
| 594 |
|
|
} {1}
|
| 595 |
|
|
|
| 596 |
|
|
test namespace-old-7.8 {namespaces are included in the call stack} {
|
| 597 |
|
|
namespace eval test_ns_upvar {
|
| 598 |
|
|
variable scope "test_ns_upvar"
|
| 599 |
|
|
|
| 600 |
|
|
proc show_val {var num} {
|
| 601 |
|
|
upvar $num $var x
|
| 602 |
|
|
return $x
|
| 603 |
|
|
}
|
| 604 |
|
|
proc test_upvar {num} {
|
| 605 |
|
|
set scope "test_ns_upvar::test_upvar"
|
| 606 |
|
|
namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
|
| 607 |
|
|
}
|
| 608 |
|
|
}
|
| 609 |
|
|
} {}
|
| 610 |
|
|
test namespace-old-7.9 {upvar can access namespace call frame} {
|
| 611 |
|
|
test_ns_upvar::test_upvar 1
|
| 612 |
|
|
} {test_ns_upvar}
|
| 613 |
|
|
test namespace-old-7.10 {upvar can go beyond namespace call frame} {
|
| 614 |
|
|
test_ns_upvar::test_upvar 2
|
| 615 |
|
|
} {test_ns_upvar::test_upvar}
|
| 616 |
|
|
test namespace-old-7.11 {absolute call frame references work too} {
|
| 617 |
|
|
test_ns_upvar::test_upvar #2
|
| 618 |
|
|
} {test_ns_upvar}
|
| 619 |
|
|
test namespace-old-7.12 {absolute call frame references work too} {
|
| 620 |
|
|
test_ns_upvar::test_upvar #1
|
| 621 |
|
|
} {test_ns_upvar::test_upvar}
|
| 622 |
|
|
|
| 623 |
|
|
# -----------------------------------------------------------------------
|
| 624 |
|
|
# TEST: variable traces across namespace boundaries
|
| 625 |
|
|
# -----------------------------------------------------------------------
|
| 626 |
|
|
test namespace-old-8.1 {traces work across namespace boundaries} {
|
| 627 |
|
|
namespace eval test_ns_trace {
|
| 628 |
|
|
namespace eval foo {
|
| 629 |
|
|
variable x ""
|
| 630 |
|
|
}
|
| 631 |
|
|
|
| 632 |
|
|
variable status ""
|
| 633 |
|
|
proc monitor {name1 name2 op} {
|
| 634 |
|
|
variable status
|
| 635 |
|
|
lappend status "$op: $name1"
|
| 636 |
|
|
}
|
| 637 |
|
|
trace variable foo::x rwu [namespace code monitor]
|
| 638 |
|
|
}
|
| 639 |
|
|
set test_ns_trace::foo::x "yes!"
|
| 640 |
|
|
set test_ns_trace::foo::x
|
| 641 |
|
|
unset test_ns_trace::foo::x
|
| 642 |
|
|
|
| 643 |
|
|
namespace eval test_ns_trace { set status }
|
| 644 |
|
|
} {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}}
|
| 645 |
|
|
|
| 646 |
|
|
# -----------------------------------------------------------------------
|
| 647 |
|
|
# TEST: imported commands
|
| 648 |
|
|
# -----------------------------------------------------------------------
|
| 649 |
|
|
test namespace-old-9.1 {empty "namespace export" list} {
|
| 650 |
|
|
list [catch "namespace export" msg] $msg
|
| 651 |
|
|
} {0 {}}
|
| 652 |
|
|
test namespace-old-9.2 {usage for "namespace export" command} {
|
| 653 |
|
|
list [catch "namespace export test_ns_trace::zzz" msg] $msg
|
| 654 |
|
|
} {1 {invalid export pattern "test_ns_trace::zzz": pattern can't specify a namespace}}
|
| 655 |
|
|
|
| 656 |
|
|
test namespace-old-9.3 {define test namespaces for import} {
|
| 657 |
|
|
namespace eval test_ns_export {
|
| 658 |
|
|
namespace export cmd1 cmd2 cmd3
|
| 659 |
|
|
proc cmd1 {args} {return "cmd1: $args"}
|
| 660 |
|
|
proc cmd2 {args} {return "cmd2: $args"}
|
| 661 |
|
|
proc cmd3 {args} {return "cmd3: $args"}
|
| 662 |
|
|
proc cmd4 {args} {return "cmd4: $args"}
|
| 663 |
|
|
proc cmd5 {args} {return "cmd5: $args"}
|
| 664 |
|
|
proc cmd6 {args} {return "cmd6: $args"}
|
| 665 |
|
|
}
|
| 666 |
|
|
lsort [info commands test_ns_export::*]
|
| 667 |
|
|
} {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
|
| 668 |
|
|
|
| 669 |
|
|
test namespace-old-9.4 {check export status} {
|
| 670 |
|
|
set x ""
|
| 671 |
|
|
namespace eval test_ns_import {
|
| 672 |
|
|
namespace export cmd1 cmd2
|
| 673 |
|
|
namespace import ::test_ns_export::*
|
| 674 |
|
|
}
|
| 675 |
|
|
foreach cmd [lsort [info commands test_ns_import::*]] {
|
| 676 |
|
|
lappend x $cmd
|
| 677 |
|
|
}
|
| 678 |
|
|
set x
|
| 679 |
|
|
} {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
|
| 680 |
|
|
|
| 681 |
|
|
test namespace-old-9.5 {empty import list in "namespace import" command} {
|
| 682 |
|
|
namespace import
|
| 683 |
|
|
} {}
|
| 684 |
|
|
|
| 685 |
|
|
test namespace-old-9.6 {empty import list for "namespace import" command} {
|
| 686 |
|
|
namespace import
|
| 687 |
|
|
} {}
|
| 688 |
|
|
|
| 689 |
|
|
test namespace-old-9.7 {empty forget list for "namespace forget" command} {
|
| 690 |
|
|
namespace forget
|
| 691 |
|
|
} {}
|
| 692 |
|
|
|
| 693 |
|
|
catch {rename cmd1 {}}
|
| 694 |
|
|
catch {rename cmd2 {}}
|
| 695 |
|
|
catch {rename ncmd {}}
|
| 696 |
|
|
catch {rename ncmd1 {}}
|
| 697 |
|
|
catch {rename ncmd2 {}}
|
| 698 |
|
|
test namespace-old-9.8 {only exported commands are imported} {
|
| 699 |
|
|
namespace import test_ns_import::cmd*
|
| 700 |
|
|
set x [lsort [info commands cmd*]]
|
| 701 |
|
|
} {cmd1 cmd2}
|
| 702 |
|
|
|
| 703 |
|
|
test namespace-old-9.9 {imported commands work just the same as original} {
|
| 704 |
|
|
list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
|
| 705 |
|
|
} {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
|
| 706 |
|
|
|
| 707 |
|
|
test namespace-old-9.10 {commands can be imported from many namespaces} {
|
| 708 |
|
|
namespace eval test_ns_import2 {
|
| 709 |
|
|
namespace export ncmd ncmd1 ncmd2
|
| 710 |
|
|
proc ncmd {args} {return "ncmd: $args"}
|
| 711 |
|
|
proc ncmd1 {args} {return "ncmd1: $args"}
|
| 712 |
|
|
proc ncmd2 {args} {return "ncmd2: $args"}
|
| 713 |
|
|
proc ncmd3 {args} {return "ncmd3: $args"}
|
| 714 |
|
|
}
|
| 715 |
|
|
namespace import test_ns_import2::*
|
| 716 |
|
|
lsort [concat [info commands cmd*] [info commands ncmd*]]
|
| 717 |
|
|
} {cmd1 cmd2 ncmd ncmd1 ncmd2}
|
| 718 |
|
|
|
| 719 |
|
|
test namespace-old-9.11 {imported commands can be removed by deleting them} {
|
| 720 |
|
|
rename cmd1 ""
|
| 721 |
|
|
lsort [concat [info commands cmd*] [info commands ncmd*]]
|
| 722 |
|
|
} {cmd2 ncmd ncmd1 ncmd2}
|
| 723 |
|
|
|
| 724 |
|
|
test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
|
| 725 |
|
|
list [catch {namespace forget xyzzy::*} msg] $msg
|
| 726 |
|
|
} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
|
| 727 |
|
|
|
| 728 |
|
|
test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} {
|
| 729 |
|
|
list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \
|
| 730 |
|
|
[lsort [info commands cmd?]]
|
| 731 |
|
|
} {0 {} cmd2}
|
| 732 |
|
|
|
| 733 |
|
|
test namespace-old-9.14 {imported commands can be removed} {
|
| 734 |
|
|
namespace forget test_ns_import::cmd?
|
| 735 |
|
|
list [lsort [info commands cmd?]] \
|
| 736 |
|
|
[catch {cmd1 another test} msg] $msg
|
| 737 |
|
|
} {{} 1 {invalid command name "cmd1"}}
|
| 738 |
|
|
|
| 739 |
|
|
test namespace-old-9.15 {existing commands can't be overwritten} {
|
| 740 |
|
|
proc cmd1 {x y} {
|
| 741 |
|
|
return [expr $x+$y]
|
| 742 |
|
|
}
|
| 743 |
|
|
list [catch {namespace import test_ns_import::cmd?} msg] $msg \
|
| 744 |
|
|
[cmd1 3 5]
|
| 745 |
|
|
} {1 {can't import command "cmd1": already exists} 8}
|
| 746 |
|
|
|
| 747 |
|
|
test namespace-old-9.16 {use "-force" option to override existing commands} {
|
| 748 |
|
|
list [cmd1 3 5] \
|
| 749 |
|
|
[namespace import -force test_ns_import::cmd?] \
|
| 750 |
|
|
[cmd1 3 5]
|
| 751 |
|
|
} {8 {} {cmd1: 3 5}}
|
| 752 |
|
|
|
| 753 |
|
|
test namespace-old-9.17 {commands can be imported into many namespaces} {
|
| 754 |
|
|
namespace eval test_ns_import_use {
|
| 755 |
|
|
namespace import ::test_ns_import::* ::test_ns_import2::ncmd?
|
| 756 |
|
|
lsort [concat [info commands ::test_ns_import_use::cmd*] \
|
| 757 |
|
|
[info commands ::test_ns_import_use::ncmd*]]
|
| 758 |
|
|
}
|
| 759 |
|
|
} {::test_ns_import_use::cmd1 ::test_ns_import_use::cmd2 ::test_ns_import_use::ncmd1 ::test_ns_import_use::ncmd2}
|
| 760 |
|
|
|
| 761 |
|
|
test namespace-old-9.18 {when command is deleted, imported commands go away} {
|
| 762 |
|
|
namespace eval test_ns_import { rename cmd1 "" }
|
| 763 |
|
|
list [info commands cmd1] \
|
| 764 |
|
|
[namespace eval test_ns_import_use {info commands cmd1}]
|
| 765 |
|
|
} {{} {}}
|
| 766 |
|
|
|
| 767 |
|
|
test namespace-old-9.19 {when namesp is deleted, all imported commands go away} {
|
| 768 |
|
|
namespace delete test_ns_import test_ns_import2
|
| 769 |
|
|
list [info commands cmd*] \
|
| 770 |
|
|
[info commands ncmd*] \
|
| 771 |
|
|
[namespace eval test_ns_import_use {info commands cmd*}] \
|
| 772 |
|
|
[namespace eval test_ns_import_use {info commands ncmd*}] \
|
| 773 |
|
|
} {{} {} {} {}}
|
| 774 |
|
|
|
| 775 |
|
|
# -----------------------------------------------------------------------
|
| 776 |
|
|
# TEST: scoped values
|
| 777 |
|
|
# -----------------------------------------------------------------------
|
| 778 |
|
|
test namespace-old-10.1 {define namespace for scope test} {
|
| 779 |
|
|
namespace eval test_ns_inscope {
|
| 780 |
|
|
variable x "x-value"
|
| 781 |
|
|
proc show {args} {
|
| 782 |
|
|
return "show: $args"
|
| 783 |
|
|
}
|
| 784 |
|
|
proc do {args} {
|
| 785 |
|
|
return [eval $args]
|
| 786 |
|
|
}
|
| 787 |
|
|
list [set x] [show test]
|
| 788 |
|
|
}
|
| 789 |
|
|
} {x-value {show: test}}
|
| 790 |
|
|
|
| 791 |
|
|
test namespace-old-10.2 {command "namespace code" requires one argument} {
|
| 792 |
|
|
list [catch {namespace code} msg] $msg
|
| 793 |
|
|
} {1 {wrong # args: should be "namespace code arg"}}
|
| 794 |
|
|
|
| 795 |
|
|
test namespace-old-10.3 {command "namespace code" requires one argument} {
|
| 796 |
|
|
list [catch {namespace code first "second arg" third} msg] $msg
|
| 797 |
|
|
} {1 {wrong # args: should be "namespace code arg"}}
|
| 798 |
|
|
|
| 799 |
|
|
test namespace-old-10.4 {command "namespace code" gets current namesp context} {
|
| 800 |
|
|
namespace eval test_ns_inscope {
|
| 801 |
|
|
namespace code {"1 2 3" "4 5" 6}
|
| 802 |
|
|
}
|
| 803 |
|
|
} {namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}}
|
| 804 |
|
|
|
| 805 |
|
|
test namespace-old-10.5 {with one arg, first "scope" sticks} {
|
| 806 |
|
|
set sval [namespace eval test_ns_inscope {namespace code {one two}}]
|
| 807 |
|
|
namespace code $sval
|
| 808 |
|
|
} {namespace inscope ::test_ns_inscope {one two}}
|
| 809 |
|
|
|
| 810 |
|
|
test namespace-old-10.6 {with many args, each "scope" adds new args} {
|
| 811 |
|
|
set sval [namespace eval test_ns_inscope {namespace code {one two}}]
|
| 812 |
|
|
namespace code "$sval three"
|
| 813 |
|
|
} {namespace inscope ::test_ns_inscope {one two} three}
|
| 814 |
|
|
|
| 815 |
|
|
test namespace-old-10.7 {scoped commands work with eval} {
|
| 816 |
|
|
set cref [namespace eval test_ns_inscope {namespace code show}]
|
| 817 |
|
|
list [eval $cref "a" "b c" "d e f"]
|
| 818 |
|
|
} {{show: a b c d e f}}
|
| 819 |
|
|
|
| 820 |
|
|
test namespace-old-10.8 {scoped commands execute in namespace context} {
|
| 821 |
|
|
set cref [namespace eval test_ns_inscope {
|
| 822 |
|
|
namespace code {set x "some new value"}
|
| 823 |
|
|
}]
|
| 824 |
|
|
list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x]
|
| 825 |
|
|
} {x-value {some new value} {some new value}}
|
| 826 |
|
|
|
| 827 |
|
|
foreach cmd [info commands test_ns_*] {
|
| 828 |
|
|
rename $cmd ""
|
| 829 |
|
|
}
|
| 830 |
|
|
catch {rename cmd {}}
|
| 831 |
|
|
catch {rename cmd1 {}}
|
| 832 |
|
|
catch {rename cmd2 {}}
|
| 833 |
|
|
catch {rename ncmd {}}
|
| 834 |
|
|
catch {rename ncmd1 {}}
|
| 835 |
|
|
catch {rename ncmd2 {}}
|
| 836 |
|
|
catch {unset cref}
|
| 837 |
|
|
catch {unset trigger}
|
| 838 |
|
|
catch {unset trigger2}
|
| 839 |
|
|
catch {unset sval}
|
| 840 |
|
|
catch {unset msg}
|
| 841 |
|
|
catch {unset x}
|
| 842 |
|
|
catch {unset test_ns_var_global}
|
| 843 |
|
|
catch {unset cmd}
|
| 844 |
|
|
eval namespace delete [namespace children :: test_ns_*]
|
