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