|
sl@0
|
1 |
# Functionality covered: this file contains a collection of tests for the
|
|
sl@0
|
2 |
# procedures in tclNamesp.c that implement Tcl's basic support for
|
|
sl@0
|
3 |
# namespaces. Other namespace-related tests appear in variable.test.
|
|
sl@0
|
4 |
#
|
|
sl@0
|
5 |
# Sourcing this file into Tcl runs the tests and generates output for
|
|
sl@0
|
6 |
# errors. No output means no errors were found.
|
|
sl@0
|
7 |
#
|
|
sl@0
|
8 |
# Copyright (c) 1997 Sun Microsystems, Inc.
|
|
sl@0
|
9 |
# Copyright (c) 1998-2000 by Scriptics Corporation.
|
|
sl@0
|
10 |
#
|
|
sl@0
|
11 |
# See the file "license.terms" for information on usage and redistribution
|
|
sl@0
|
12 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
sl@0
|
13 |
#
|
|
sl@0
|
14 |
# RCS: @(#) $Id: namespace.test,v 1.21.2.10 2006/10/04 17:59:06 dgp Exp $
|
|
sl@0
|
15 |
|
|
sl@0
|
16 |
if {[lsearch [namespace children] ::tcltest] == -1} {
|
|
sl@0
|
17 |
package require tcltest 2
|
|
sl@0
|
18 |
namespace import -force ::tcltest::*
|
|
sl@0
|
19 |
}
|
|
sl@0
|
20 |
|
|
sl@0
|
21 |
# Clear out any namespaces called test_ns_*
|
|
sl@0
|
22 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
23 |
|
|
sl@0
|
24 |
test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} {
|
|
sl@0
|
25 |
namespace children :: test_ns_*
|
|
sl@0
|
26 |
} {}
|
|
sl@0
|
27 |
|
|
sl@0
|
28 |
catch {unset l}
|
|
sl@0
|
29 |
test namespace-2.1 {Tcl_GetCurrentNamespace} {
|
|
sl@0
|
30 |
list [namespace current] [namespace eval {} {namespace current}] \
|
|
sl@0
|
31 |
[namespace eval {} {namespace current}]
|
|
sl@0
|
32 |
} {:: :: ::}
|
|
sl@0
|
33 |
test namespace-2.2 {Tcl_GetCurrentNamespace} {
|
|
sl@0
|
34 |
set l {}
|
|
sl@0
|
35 |
lappend l [namespace current]
|
|
sl@0
|
36 |
namespace eval test_ns_1 {
|
|
sl@0
|
37 |
lappend l [namespace current]
|
|
sl@0
|
38 |
namespace eval foo {
|
|
sl@0
|
39 |
lappend l [namespace current]
|
|
sl@0
|
40 |
}
|
|
sl@0
|
41 |
}
|
|
sl@0
|
42 |
lappend l [namespace current]
|
|
sl@0
|
43 |
set l
|
|
sl@0
|
44 |
} {:: ::test_ns_1 ::test_ns_1::foo ::}
|
|
sl@0
|
45 |
|
|
sl@0
|
46 |
test namespace-3.1 {Tcl_GetGlobalNamespace} {
|
|
sl@0
|
47 |
namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
|
|
sl@0
|
48 |
# namespace children uses Tcl_GetGlobalNamespace
|
|
sl@0
|
49 |
namespace eval test_ns_1 {namespace children foo b*}
|
|
sl@0
|
50 |
} {::test_ns_1::foo::bar}
|
|
sl@0
|
51 |
|
|
sl@0
|
52 |
test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} {
|
|
sl@0
|
53 |
namespace eval test_ns_1 {
|
|
sl@0
|
54 |
variable v 123
|
|
sl@0
|
55 |
proc p {} {
|
|
sl@0
|
56 |
variable v
|
|
sl@0
|
57 |
return $v
|
|
sl@0
|
58 |
}
|
|
sl@0
|
59 |
}
|
|
sl@0
|
60 |
test_ns_1::p ;# does Tcl_PushCallFrame to push p's namespace
|
|
sl@0
|
61 |
} {123}
|
|
sl@0
|
62 |
test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} {
|
|
sl@0
|
63 |
namespace eval test_ns_1::baz {} ;# does Tcl_PushCallFrame to create baz
|
|
sl@0
|
64 |
proc test_ns_1::baz::p {} {
|
|
sl@0
|
65 |
variable v
|
|
sl@0
|
66 |
set v 789
|
|
sl@0
|
67 |
set v}
|
|
sl@0
|
68 |
test_ns_1::baz::p
|
|
sl@0
|
69 |
} {789}
|
|
sl@0
|
70 |
|
|
sl@0
|
71 |
test namespace-5.1 {Tcl_PopCallFrame, no vars} {
|
|
sl@0
|
72 |
namespace eval test_ns_1::blodge {} ;# pushes then pops frame
|
|
sl@0
|
73 |
} {}
|
|
sl@0
|
74 |
test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
|
|
sl@0
|
75 |
proc test_ns_1::r {} {
|
|
sl@0
|
76 |
set a 123
|
|
sl@0
|
77 |
}
|
|
sl@0
|
78 |
test_ns_1::r ;# pushes then pop's r's frame
|
|
sl@0
|
79 |
} {123}
|
|
sl@0
|
80 |
|
|
sl@0
|
81 |
test namespace-6.1 {Tcl_CreateNamespace} {
|
|
sl@0
|
82 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
83 |
list [lsort [namespace children :: test_ns_*]] \
|
|
sl@0
|
84 |
[namespace eval test_ns_1 {namespace current}] \
|
|
sl@0
|
85 |
[namespace eval test_ns_2 {namespace current}] \
|
|
sl@0
|
86 |
[namespace eval ::test_ns_3 {namespace current}] \
|
|
sl@0
|
87 |
[namespace eval ::test_ns_4 \
|
|
sl@0
|
88 |
{namespace eval foo {namespace current}}] \
|
|
sl@0
|
89 |
[namespace eval ::test_ns_5 \
|
|
sl@0
|
90 |
{namespace eval ::test_ns_6 {namespace current}}] \
|
|
sl@0
|
91 |
[lsort [namespace children :: test_ns_*]]
|
|
sl@0
|
92 |
} {{} ::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}}
|
|
sl@0
|
93 |
test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
|
|
sl@0
|
94 |
list [namespace eval :::test_ns_1::::foo {namespace current}] \
|
|
sl@0
|
95 |
[namespace eval test_ns_2:::::foo {namespace current}]
|
|
sl@0
|
96 |
} {::test_ns_1::foo ::test_ns_2::foo}
|
|
sl@0
|
97 |
test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
|
|
sl@0
|
98 |
list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg
|
|
sl@0
|
99 |
} {0 ::test_ns_7}
|
|
sl@0
|
100 |
test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
|
|
sl@0
|
101 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
102 |
namespace eval test_ns_1:: {
|
|
sl@0
|
103 |
namespace eval test_ns_2:: {}
|
|
sl@0
|
104 |
namespace eval test_ns_3:: {}
|
|
sl@0
|
105 |
}
|
|
sl@0
|
106 |
lsort [namespace children ::test_ns_1]
|
|
sl@0
|
107 |
} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}]
|
|
sl@0
|
108 |
test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} {
|
|
sl@0
|
109 |
set trigger {
|
|
sl@0
|
110 |
namespace eval test_ns_2 {namespace current}
|
|
sl@0
|
111 |
}
|
|
sl@0
|
112 |
set l {}
|
|
sl@0
|
113 |
lappend l [namespace eval test_ns_1 $trigger]
|
|
sl@0
|
114 |
namespace eval test_ns_1::test_ns_2 {}
|
|
sl@0
|
115 |
lappend l [namespace eval test_ns_1 $trigger]
|
|
sl@0
|
116 |
} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2}
|
|
sl@0
|
117 |
|
|
sl@0
|
118 |
test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} {
|
|
sl@0
|
119 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
120 |
namespace eval test_ns_1 {
|
|
sl@0
|
121 |
proc p {} {
|
|
sl@0
|
122 |
namespace delete [namespace current]
|
|
sl@0
|
123 |
return [namespace current]
|
|
sl@0
|
124 |
}
|
|
sl@0
|
125 |
}
|
|
sl@0
|
126 |
list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg
|
|
sl@0
|
127 |
} {::test_ns_1 1 {invalid command name "test_ns_1::p"}}
|
|
sl@0
|
128 |
test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
|
|
sl@0
|
129 |
namespace eval test_ns_2 {
|
|
sl@0
|
130 |
proc p {} {
|
|
sl@0
|
131 |
return [namespace current]
|
|
sl@0
|
132 |
}
|
|
sl@0
|
133 |
}
|
|
sl@0
|
134 |
list [test_ns_2::p] [namespace delete test_ns_2]
|
|
sl@0
|
135 |
} {::test_ns_2 {}}
|
|
sl@0
|
136 |
test namespace-7.3 {recursive Tcl_DeleteNamespace, active call frames in ns} {
|
|
sl@0
|
137 |
# [Bug 1355942]
|
|
sl@0
|
138 |
namespace eval test_ns_2 {
|
|
sl@0
|
139 |
set x 1
|
|
sl@0
|
140 |
trace add variable x unset "namespace delete [namespace current];#"
|
|
sl@0
|
141 |
namespace delete [namespace current]
|
|
sl@0
|
142 |
}
|
|
sl@0
|
143 |
} {}
|
|
sl@0
|
144 |
test namespace-7.4 {recursive Tcl_DeleteNamespace, active call frames in ns} {
|
|
sl@0
|
145 |
# [Bug 1355942]
|
|
sl@0
|
146 |
namespace eval test_ns_2 {
|
|
sl@0
|
147 |
proc x {} {}
|
|
sl@0
|
148 |
trace add command x delete "namespace delete [namespace current];#"
|
|
sl@0
|
149 |
namespace delete [namespace current]
|
|
sl@0
|
150 |
}
|
|
sl@0
|
151 |
} {}
|
|
sl@0
|
152 |
test namespace-7.5 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
|
|
sl@0
|
153 |
# [Bug 1355942]
|
|
sl@0
|
154 |
namespace eval test_ns_2 {
|
|
sl@0
|
155 |
set x 1
|
|
sl@0
|
156 |
trace add variable x unset "namespace delete [namespace current];#"
|
|
sl@0
|
157 |
}
|
|
sl@0
|
158 |
namespace delete test_ns_2
|
|
sl@0
|
159 |
} {}
|
|
sl@0
|
160 |
test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
|
|
sl@0
|
161 |
# [Bug 1355942]
|
|
sl@0
|
162 |
namespace eval test_ns_2 {
|
|
sl@0
|
163 |
proc x {} {}
|
|
sl@0
|
164 |
trace add command x delete "namespace delete [namespace current];#"
|
|
sl@0
|
165 |
}
|
|
sl@0
|
166 |
namespace delete test_ns_2
|
|
sl@0
|
167 |
} {}
|
|
sl@0
|
168 |
|
|
sl@0
|
169 |
test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
|
|
sl@0
|
170 |
catch {interp delete test_interp}
|
|
sl@0
|
171 |
interp create test_interp
|
|
sl@0
|
172 |
interp eval test_interp {
|
|
sl@0
|
173 |
namespace eval test_ns_1 {
|
|
sl@0
|
174 |
namespace export p
|
|
sl@0
|
175 |
proc p {} {
|
|
sl@0
|
176 |
return [namespace current]
|
|
sl@0
|
177 |
}
|
|
sl@0
|
178 |
}
|
|
sl@0
|
179 |
namespace eval test_ns_2 {
|
|
sl@0
|
180 |
namespace import ::test_ns_1::p
|
|
sl@0
|
181 |
variable v 27
|
|
sl@0
|
182 |
proc q {} {
|
|
sl@0
|
183 |
variable v
|
|
sl@0
|
184 |
return "[p] $v"
|
|
sl@0
|
185 |
}
|
|
sl@0
|
186 |
}
|
|
sl@0
|
187 |
set x [test_ns_2::q]
|
|
sl@0
|
188 |
catch {set xxxx}
|
|
sl@0
|
189 |
}
|
|
sl@0
|
190 |
list [interp eval test_interp {test_ns_2::q}] \
|
|
sl@0
|
191 |
[interp eval test_interp {namespace delete ::}] \
|
|
sl@0
|
192 |
[catch {interp eval test_interp {set a 123}} msg] $msg \
|
|
sl@0
|
193 |
[interp delete test_interp]
|
|
sl@0
|
194 |
} {{::test_ns_1 27} {} 1 {invalid command name "set"} {}}
|
|
sl@0
|
195 |
test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} {
|
|
sl@0
|
196 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
197 |
namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
|
|
sl@0
|
198 |
namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
|
|
sl@0
|
199 |
list [namespace children test_ns_1] \
|
|
sl@0
|
200 |
[namespace delete test_ns_1::test_ns_2] \
|
|
sl@0
|
201 |
[namespace children test_ns_1]
|
|
sl@0
|
202 |
} {::test_ns_1::test_ns_2 {} {}}
|
|
sl@0
|
203 |
test namespace-8.3 {TclTeardownNamespace, delete child namespaces} {
|
|
sl@0
|
204 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
205 |
namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
|
|
sl@0
|
206 |
namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
|
|
sl@0
|
207 |
list [namespace children test_ns_1] \
|
|
sl@0
|
208 |
[namespace delete test_ns_1::test_ns_2] \
|
|
sl@0
|
209 |
[namespace children test_ns_1] \
|
|
sl@0
|
210 |
[catch {namespace children test_ns_1::test_ns_2} msg] $msg \
|
|
sl@0
|
211 |
[info commands test_ns_1::test_ns_2::test_ns_3a::*]
|
|
sl@0
|
212 |
} {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}}
|
|
sl@0
|
213 |
test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} {
|
|
sl@0
|
214 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
215 |
namespace eval test_ns_export {
|
|
sl@0
|
216 |
namespace export cmd1 cmd2
|
|
sl@0
|
217 |
proc cmd1 {args} {return "cmd1: $args"}
|
|
sl@0
|
218 |
proc cmd2 {args} {return "cmd2: $args"}
|
|
sl@0
|
219 |
}
|
|
sl@0
|
220 |
namespace eval test_ns_import {
|
|
sl@0
|
221 |
namespace import ::test_ns_export::*
|
|
sl@0
|
222 |
proc p {} {return foo}
|
|
sl@0
|
223 |
}
|
|
sl@0
|
224 |
list [lsort [info commands test_ns_import::*]] \
|
|
sl@0
|
225 |
[namespace delete test_ns_export] \
|
|
sl@0
|
226 |
[info commands test_ns_import::*]
|
|
sl@0
|
227 |
} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p]
|
|
sl@0
|
228 |
test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
|
|
sl@0
|
229 |
interp create slave
|
|
sl@0
|
230 |
slave eval {trace add execution error leave {namespace delete :: ;#}}
|
|
sl@0
|
231 |
catch {slave eval error foo bar baz}
|
|
sl@0
|
232 |
interp delete slave
|
|
sl@0
|
233 |
set ::errorInfo
|
|
sl@0
|
234 |
} {bar
|
|
sl@0
|
235 |
invoked from within
|
|
sl@0
|
236 |
"slave eval error foo bar baz"}
|
|
sl@0
|
237 |
test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
|
|
sl@0
|
238 |
interp create slave
|
|
sl@0
|
239 |
slave eval {trace add variable errorCode write {namespace delete :: ;#}}
|
|
sl@0
|
240 |
catch {slave eval error foo bar baz}
|
|
sl@0
|
241 |
interp delete slave
|
|
sl@0
|
242 |
set ::errorInfo
|
|
sl@0
|
243 |
} {bar
|
|
sl@0
|
244 |
invoked from within
|
|
sl@0
|
245 |
"slave eval error foo bar baz"}
|
|
sl@0
|
246 |
test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
|
|
sl@0
|
247 |
interp create slave
|
|
sl@0
|
248 |
slave eval {trace add execution error leave {namespace delete :: ;#}}
|
|
sl@0
|
249 |
catch {slave eval error foo bar baz}
|
|
sl@0
|
250 |
interp delete slave
|
|
sl@0
|
251 |
set ::errorCode
|
|
sl@0
|
252 |
} baz
|
|
sl@0
|
253 |
|
|
sl@0
|
254 |
test namespace-9.1 {Tcl_Import, empty import pattern} {
|
|
sl@0
|
255 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
256 |
list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg
|
|
sl@0
|
257 |
} {1 {empty import pattern}}
|
|
sl@0
|
258 |
test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} {
|
|
sl@0
|
259 |
list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg
|
|
sl@0
|
260 |
} {1 {unknown namespace in import pattern "fred::x"}}
|
|
sl@0
|
261 |
test namespace-9.3 {Tcl_Import, import ns == export ns} {
|
|
sl@0
|
262 |
list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg
|
|
sl@0
|
263 |
} {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}}
|
|
sl@0
|
264 |
test namespace-9.4 {Tcl_Import, simple import} {
|
|
sl@0
|
265 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
266 |
namespace eval test_ns_export {
|
|
sl@0
|
267 |
namespace export cmd1
|
|
sl@0
|
268 |
proc cmd1 {args} {return "cmd1: $args"}
|
|
sl@0
|
269 |
proc cmd2 {args} {return "cmd2: $args"}
|
|
sl@0
|
270 |
}
|
|
sl@0
|
271 |
namespace eval test_ns_import {
|
|
sl@0
|
272 |
namespace import ::test_ns_export::*
|
|
sl@0
|
273 |
proc p {} {return [cmd1 123]}
|
|
sl@0
|
274 |
}
|
|
sl@0
|
275 |
test_ns_import::p
|
|
sl@0
|
276 |
} {cmd1: 123}
|
|
sl@0
|
277 |
test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} {
|
|
sl@0
|
278 |
list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
|
|
sl@0
|
279 |
} {0 {}}
|
|
sl@0
|
280 |
test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
|
|
sl@0
|
281 |
namespace eval test_ns_import {
|
|
sl@0
|
282 |
namespace import -force ::test_ns_export::*
|
|
sl@0
|
283 |
cmd1 555
|
|
sl@0
|
284 |
}
|
|
sl@0
|
285 |
} {cmd1: 555}
|
|
sl@0
|
286 |
test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
|
|
sl@0
|
287 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
288 |
namespace eval test_ns_export {
|
|
sl@0
|
289 |
namespace export cmd1
|
|
sl@0
|
290 |
proc cmd1 {args} {return "cmd1: $args"}
|
|
sl@0
|
291 |
}
|
|
sl@0
|
292 |
namespace eval test_ns_import {
|
|
sl@0
|
293 |
namespace import -force ::test_ns_export::*
|
|
sl@0
|
294 |
}
|
|
sl@0
|
295 |
list [test_ns_import::cmd1 a b c] \
|
|
sl@0
|
296 |
[test_ns_export::cmd1 d e f] \
|
|
sl@0
|
297 |
[proc test_ns_export::cmd1 {args} {return "new1: $args"}] \
|
|
sl@0
|
298 |
[namespace origin test_ns_import::cmd1] \
|
|
sl@0
|
299 |
[namespace origin test_ns_export::cmd1] \
|
|
sl@0
|
300 |
[test_ns_import::cmd1 g h i] \
|
|
sl@0
|
301 |
[test_ns_export::cmd1 j k l]
|
|
sl@0
|
302 |
} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}
|
|
sl@0
|
303 |
|
|
sl@0
|
304 |
test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
|
|
sl@0
|
305 |
namespace eval one {
|
|
sl@0
|
306 |
namespace export cmd
|
|
sl@0
|
307 |
proc cmd {} {}
|
|
sl@0
|
308 |
}
|
|
sl@0
|
309 |
namespace eval two {
|
|
sl@0
|
310 |
namespace export cmd
|
|
sl@0
|
311 |
proc other args {}
|
|
sl@0
|
312 |
}
|
|
sl@0
|
313 |
namespace eval two \
|
|
sl@0
|
314 |
[list namespace import [namespace current]::one::cmd]
|
|
sl@0
|
315 |
namespace eval three \
|
|
sl@0
|
316 |
[list namespace import [namespace current]::two::cmd]
|
|
sl@0
|
317 |
namespace eval three {
|
|
sl@0
|
318 |
rename cmd other
|
|
sl@0
|
319 |
namespace export other
|
|
sl@0
|
320 |
}
|
|
sl@0
|
321 |
} -body {
|
|
sl@0
|
322 |
namespace eval two [list namespace import -force \
|
|
sl@0
|
323 |
[namespace current]::three::other]
|
|
sl@0
|
324 |
namespace origin two::other
|
|
sl@0
|
325 |
} -cleanup {
|
|
sl@0
|
326 |
namespace delete one two three
|
|
sl@0
|
327 |
} -match glob -result *::one::cmd
|
|
sl@0
|
328 |
|
|
sl@0
|
329 |
test namespace-9.9 {Tcl_Import: Bug 1017299} -setup {
|
|
sl@0
|
330 |
namespace eval one {
|
|
sl@0
|
331 |
namespace export cmd
|
|
sl@0
|
332 |
proc cmd {} {}
|
|
sl@0
|
333 |
}
|
|
sl@0
|
334 |
namespace eval two namespace export cmd
|
|
sl@0
|
335 |
namespace eval two \
|
|
sl@0
|
336 |
[list namespace import [namespace current]::one::cmd]
|
|
sl@0
|
337 |
namespace eval three namespace export cmd
|
|
sl@0
|
338 |
namespace eval three \
|
|
sl@0
|
339 |
[list namespace import [namespace current]::two::cmd]
|
|
sl@0
|
340 |
} -body {
|
|
sl@0
|
341 |
namespace eval two [list namespace import -force \
|
|
sl@0
|
342 |
[namespace current]::three::cmd]
|
|
sl@0
|
343 |
namespace origin two::cmd
|
|
sl@0
|
344 |
} -cleanup {
|
|
sl@0
|
345 |
namespace delete one two three
|
|
sl@0
|
346 |
} -returnCodes error -match glob -result {import pattern * would create a loop*}
|
|
sl@0
|
347 |
|
|
sl@0
|
348 |
test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} {
|
|
sl@0
|
349 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
350 |
list [catch {namespace forget xyzzy::*} msg] $msg
|
|
sl@0
|
351 |
} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
|
|
sl@0
|
352 |
test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
|
|
sl@0
|
353 |
namespace eval test_ns_export {
|
|
sl@0
|
354 |
namespace export cmd1
|
|
sl@0
|
355 |
proc cmd1 {args} {return "cmd1: $args"}
|
|
sl@0
|
356 |
proc cmd2 {args} {return "cmd2: $args"}
|
|
sl@0
|
357 |
}
|
|
sl@0
|
358 |
namespace eval test_ns_import {
|
|
sl@0
|
359 |
namespace forget ::test_ns_export::wombat
|
|
sl@0
|
360 |
}
|
|
sl@0
|
361 |
} {}
|
|
sl@0
|
362 |
test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
|
|
sl@0
|
363 |
namespace eval test_ns_import {
|
|
sl@0
|
364 |
namespace import ::test_ns_export::*
|
|
sl@0
|
365 |
proc p {} {return [cmd1 123]}
|
|
sl@0
|
366 |
set l {}
|
|
sl@0
|
367 |
lappend l [lsort [info commands ::test_ns_import::*]]
|
|
sl@0
|
368 |
namespace forget ::test_ns_export::cmd1
|
|
sl@0
|
369 |
lappend l [info commands ::test_ns_import::*]
|
|
sl@0
|
370 |
lappend l [catch {cmd1 777} msg] $msg
|
|
sl@0
|
371 |
}
|
|
sl@0
|
372 |
} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]
|
|
sl@0
|
373 |
|
|
sl@0
|
374 |
test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
|
|
sl@0
|
375 |
namespace eval origin {
|
|
sl@0
|
376 |
namespace export cmd
|
|
sl@0
|
377 |
proc cmd {} {}
|
|
sl@0
|
378 |
}
|
|
sl@0
|
379 |
namespace eval unrelated {
|
|
sl@0
|
380 |
proc cmd {} {}
|
|
sl@0
|
381 |
}
|
|
sl@0
|
382 |
namespace eval my \
|
|
sl@0
|
383 |
[list namespace import [namespace current]::origin::cmd]
|
|
sl@0
|
384 |
} -body {
|
|
sl@0
|
385 |
namespace eval my \
|
|
sl@0
|
386 |
[list namespace forget [namespace current]::unrelated::cmd]
|
|
sl@0
|
387 |
my::cmd
|
|
sl@0
|
388 |
} -cleanup {
|
|
sl@0
|
389 |
namespace delete origin unrelated my
|
|
sl@0
|
390 |
}
|
|
sl@0
|
391 |
|
|
sl@0
|
392 |
test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
|
|
sl@0
|
393 |
namespace eval origin {
|
|
sl@0
|
394 |
namespace export cmd
|
|
sl@0
|
395 |
proc cmd {} {}
|
|
sl@0
|
396 |
}
|
|
sl@0
|
397 |
namespace eval my \
|
|
sl@0
|
398 |
[list namespace import [namespace current]::origin::cmd]
|
|
sl@0
|
399 |
namespace eval my rename cmd newname
|
|
sl@0
|
400 |
} -body {
|
|
sl@0
|
401 |
namespace eval my \
|
|
sl@0
|
402 |
[list namespace forget [namespace current]::origin::cmd]
|
|
sl@0
|
403 |
my::newname
|
|
sl@0
|
404 |
} -cleanup {
|
|
sl@0
|
405 |
namespace delete origin my
|
|
sl@0
|
406 |
} -returnCodes error -match glob -result *
|
|
sl@0
|
407 |
|
|
sl@0
|
408 |
test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
|
|
sl@0
|
409 |
namespace eval origin {
|
|
sl@0
|
410 |
namespace export cmd
|
|
sl@0
|
411 |
proc cmd {} {}
|
|
sl@0
|
412 |
}
|
|
sl@0
|
413 |
namespace eval my \
|
|
sl@0
|
414 |
[list namespace import [namespace current]::origin::cmd]
|
|
sl@0
|
415 |
namespace eval your {}
|
|
sl@0
|
416 |
namespace eval my \
|
|
sl@0
|
417 |
[list rename cmd [namespace current]::your::newname]
|
|
sl@0
|
418 |
} -body {
|
|
sl@0
|
419 |
namespace eval your namespace forget newname
|
|
sl@0
|
420 |
your::newname
|
|
sl@0
|
421 |
} -cleanup {
|
|
sl@0
|
422 |
namespace delete origin my your
|
|
sl@0
|
423 |
} -returnCodes error -match glob -result *
|
|
sl@0
|
424 |
|
|
sl@0
|
425 |
test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
|
|
sl@0
|
426 |
namespace eval origin {
|
|
sl@0
|
427 |
namespace export cmd
|
|
sl@0
|
428 |
proc cmd {} {}
|
|
sl@0
|
429 |
}
|
|
sl@0
|
430 |
namespace eval link namespace export cmd
|
|
sl@0
|
431 |
namespace eval link \
|
|
sl@0
|
432 |
[list namespace import [namespace current]::origin::cmd]
|
|
sl@0
|
433 |
namespace eval link2 namespace export cmd
|
|
sl@0
|
434 |
namespace eval link2 \
|
|
sl@0
|
435 |
[list namespace import [namespace current]::link::cmd]
|
|
sl@0
|
436 |
namespace eval my \
|
|
sl@0
|
437 |
[list namespace import [namespace current]::link2::cmd]
|
|
sl@0
|
438 |
} -body {
|
|
sl@0
|
439 |
namespace eval my \
|
|
sl@0
|
440 |
[list namespace forget [namespace current]::origin::cmd]
|
|
sl@0
|
441 |
my::cmd
|
|
sl@0
|
442 |
} -cleanup {
|
|
sl@0
|
443 |
namespace delete origin link link2 my
|
|
sl@0
|
444 |
} -returnCodes error -match glob -result *
|
|
sl@0
|
445 |
|
|
sl@0
|
446 |
test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
|
|
sl@0
|
447 |
namespace eval origin {
|
|
sl@0
|
448 |
namespace export cmd
|
|
sl@0
|
449 |
proc cmd {} {}
|
|
sl@0
|
450 |
}
|
|
sl@0
|
451 |
namespace eval link namespace export cmd
|
|
sl@0
|
452 |
namespace eval link \
|
|
sl@0
|
453 |
[list namespace import [namespace current]::origin::cmd]
|
|
sl@0
|
454 |
namespace eval link2 namespace export cmd
|
|
sl@0
|
455 |
namespace eval link2 \
|
|
sl@0
|
456 |
[list namespace import [namespace current]::link::cmd]
|
|
sl@0
|
457 |
namespace eval my \
|
|
sl@0
|
458 |
[list namespace import [namespace current]::link2::cmd]
|
|
sl@0
|
459 |
} -body {
|
|
sl@0
|
460 |
namespace eval my \
|
|
sl@0
|
461 |
[list namespace forget [namespace current]::link::cmd]
|
|
sl@0
|
462 |
my::cmd
|
|
sl@0
|
463 |
} -cleanup {
|
|
sl@0
|
464 |
namespace delete origin link link2 my
|
|
sl@0
|
465 |
}
|
|
sl@0
|
466 |
|
|
sl@0
|
467 |
test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
|
|
sl@0
|
468 |
namespace eval origin {
|
|
sl@0
|
469 |
namespace export cmd
|
|
sl@0
|
470 |
proc cmd {} {}
|
|
sl@0
|
471 |
}
|
|
sl@0
|
472 |
namespace eval link namespace export cmd
|
|
sl@0
|
473 |
namespace eval link \
|
|
sl@0
|
474 |
[list namespace import [namespace current]::origin::cmd]
|
|
sl@0
|
475 |
namespace eval link2 namespace export cmd
|
|
sl@0
|
476 |
namespace eval link2 \
|
|
sl@0
|
477 |
[list namespace import [namespace current]::link::cmd]
|
|
sl@0
|
478 |
namespace eval my \
|
|
sl@0
|
479 |
[list namespace import [namespace current]::link2::cmd]
|
|
sl@0
|
480 |
} -body {
|
|
sl@0
|
481 |
namespace eval my \
|
|
sl@0
|
482 |
[list namespace forget [namespace current]::link2::cmd]
|
|
sl@0
|
483 |
my::cmd
|
|
sl@0
|
484 |
} -cleanup {
|
|
sl@0
|
485 |
namespace delete origin link link2 my
|
|
sl@0
|
486 |
} -returnCodes error -match glob -result *
|
|
sl@0
|
487 |
|
|
sl@0
|
488 |
test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
|
|
sl@0
|
489 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
490 |
namespace eval test_ns_export {
|
|
sl@0
|
491 |
namespace export cmd1
|
|
sl@0
|
492 |
proc cmd1 {args} {return "cmd1: $args"}
|
|
sl@0
|
493 |
}
|
|
sl@0
|
494 |
list [namespace origin set] [namespace origin test_ns_export::cmd1]
|
|
sl@0
|
495 |
} {::set ::test_ns_export::cmd1}
|
|
sl@0
|
496 |
test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {
|
|
sl@0
|
497 |
namespace eval test_ns_import1 {
|
|
sl@0
|
498 |
namespace import ::test_ns_export::*
|
|
sl@0
|
499 |
namespace export *
|
|
sl@0
|
500 |
proc p {} {namespace origin cmd1}
|
|
sl@0
|
501 |
}
|
|
sl@0
|
502 |
list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
|
|
sl@0
|
503 |
} {::test_ns_export::cmd1 ::test_ns_export::cmd1}
|
|
sl@0
|
504 |
test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
|
|
sl@0
|
505 |
namespace eval test_ns_import2 {
|
|
sl@0
|
506 |
namespace import ::test_ns_import1::*
|
|
sl@0
|
507 |
proc q {} {return [cmd1 123]}
|
|
sl@0
|
508 |
}
|
|
sl@0
|
509 |
list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
|
|
sl@0
|
510 |
} {{cmd1: 123} ::test_ns_export::cmd1}
|
|
sl@0
|
511 |
|
|
sl@0
|
512 |
test namespace-12.1 {InvokeImportedCmd} {
|
|
sl@0
|
513 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
514 |
namespace eval test_ns_export {
|
|
sl@0
|
515 |
namespace export cmd1
|
|
sl@0
|
516 |
proc cmd1 {args} {namespace current}
|
|
sl@0
|
517 |
}
|
|
sl@0
|
518 |
namespace eval test_ns_import {
|
|
sl@0
|
519 |
namespace import ::test_ns_export::*
|
|
sl@0
|
520 |
}
|
|
sl@0
|
521 |
list [test_ns_import::cmd1]
|
|
sl@0
|
522 |
} {::test_ns_export}
|
|
sl@0
|
523 |
|
|
sl@0
|
524 |
test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
|
|
sl@0
|
525 |
namespace eval test_ns_import {
|
|
sl@0
|
526 |
set l {}
|
|
sl@0
|
527 |
lappend l [info commands ::test_ns_import::*]
|
|
sl@0
|
528 |
namespace forget ::test_ns_export::cmd1
|
|
sl@0
|
529 |
lappend l [info commands ::test_ns_import::*]
|
|
sl@0
|
530 |
}
|
|
sl@0
|
531 |
} {::test_ns_import::cmd1 {}}
|
|
sl@0
|
532 |
|
|
sl@0
|
533 |
test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
|
|
sl@0
|
534 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
535 |
variable v 10
|
|
sl@0
|
536 |
namespace eval test_ns_1::test_ns_2 {
|
|
sl@0
|
537 |
variable v 20
|
|
sl@0
|
538 |
}
|
|
sl@0
|
539 |
namespace eval test_ns_2 {
|
|
sl@0
|
540 |
variable v 30
|
|
sl@0
|
541 |
}
|
|
sl@0
|
542 |
namespace eval test_ns_1 {
|
|
sl@0
|
543 |
list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
|
|
sl@0
|
544 |
[lsort [namespace children :: test_ns_*]]
|
|
sl@0
|
545 |
}
|
|
sl@0
|
546 |
} [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
|
|
sl@0
|
547 |
test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
|
|
sl@0
|
548 |
namespace eval test_ns_1 {
|
|
sl@0
|
549 |
list [catch {set ::test_ns_777::v} msg] $msg \
|
|
sl@0
|
550 |
[catch {namespace children test_ns_777} msg] $msg
|
|
sl@0
|
551 |
}
|
|
sl@0
|
552 |
} {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}}
|
|
sl@0
|
553 |
test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
|
|
sl@0
|
554 |
namespace eval test_ns_1 {
|
|
sl@0
|
555 |
list $v $test_ns_2::v
|
|
sl@0
|
556 |
}
|
|
sl@0
|
557 |
} {10 20}
|
|
sl@0
|
558 |
test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
|
|
sl@0
|
559 |
namespace eval test_ns_1::test_ns_2 {
|
|
sl@0
|
560 |
namespace eval foo {}
|
|
sl@0
|
561 |
}
|
|
sl@0
|
562 |
namespace eval test_ns_1 {
|
|
sl@0
|
563 |
list [namespace children test_ns_2] \
|
|
sl@0
|
564 |
[catch {namespace children test_ns_1} msg] $msg
|
|
sl@0
|
565 |
}
|
|
sl@0
|
566 |
} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
|
|
sl@0
|
567 |
test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
|
|
sl@0
|
568 |
namespace eval ::test_ns_2 {
|
|
sl@0
|
569 |
namespace eval bar {}
|
|
sl@0
|
570 |
}
|
|
sl@0
|
571 |
namespace eval test_ns_1 {
|
|
sl@0
|
572 |
set l [list [catch {namespace delete test_ns_2::bar} msg] $msg]
|
|
sl@0
|
573 |
}
|
|
sl@0
|
574 |
set l
|
|
sl@0
|
575 |
} {1 {unknown namespace "test_ns_2::bar" in namespace delete command}}
|
|
sl@0
|
576 |
test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
|
|
sl@0
|
577 |
namespace eval test_ns_1::test_ns_2 {
|
|
sl@0
|
578 |
namespace eval foo {}
|
|
sl@0
|
579 |
}
|
|
sl@0
|
580 |
namespace eval test_ns_1 {
|
|
sl@0
|
581 |
list [namespace children test_ns_2] \
|
|
sl@0
|
582 |
[catch {namespace children test_ns_1} msg] $msg
|
|
sl@0
|
583 |
}
|
|
sl@0
|
584 |
} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
|
|
sl@0
|
585 |
test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
|
|
sl@0
|
586 |
namespace children test_ns_1:::
|
|
sl@0
|
587 |
} {::test_ns_1::test_ns_2}
|
|
sl@0
|
588 |
test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
|
|
sl@0
|
589 |
namespace children :::test_ns_1:::::test_ns_2:::
|
|
sl@0
|
590 |
} {::test_ns_1::test_ns_2::foo}
|
|
sl@0
|
591 |
test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
|
|
sl@0
|
592 |
set l {}
|
|
sl@0
|
593 |
lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
|
|
sl@0
|
594 |
namespace eval test_ns_1::test_ns_2 {variable {} 2525}
|
|
sl@0
|
595 |
lappend l [set test_ns_1::test_ns_2::]
|
|
sl@0
|
596 |
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
|
|
sl@0
|
597 |
test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
|
|
sl@0
|
598 |
catch {unset test_ns_1::test_ns_2::}
|
|
sl@0
|
599 |
set l {}
|
|
sl@0
|
600 |
lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
|
|
sl@0
|
601 |
set test_ns_1::test_ns_2:: 314159
|
|
sl@0
|
602 |
lappend l [set test_ns_1::test_ns_2::]
|
|
sl@0
|
603 |
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
|
|
sl@0
|
604 |
test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {
|
|
sl@0
|
605 |
catch {rename test_ns_1::test_ns_2:: {}}
|
|
sl@0
|
606 |
set l {}
|
|
sl@0
|
607 |
lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
|
|
sl@0
|
608 |
proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
|
|
sl@0
|
609 |
lappend l [test_ns_1::test_ns_2:: hello]
|
|
sl@0
|
610 |
} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
|
|
sl@0
|
611 |
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
|
|
sl@0
|
612 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
613 |
namespace eval test_ns_1 {
|
|
sl@0
|
614 |
variable {}
|
|
sl@0
|
615 |
set test_ns_1::(x) y
|
|
sl@0
|
616 |
}
|
|
sl@0
|
617 |
set test_ns_1::(x)
|
|
sl@0
|
618 |
} y
|
|
sl@0
|
619 |
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
|
|
sl@0
|
620 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
621 |
list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
|
|
sl@0
|
622 |
} {1 {can't create namespace "": only global namespace can have empty name}}
|
|
sl@0
|
623 |
|
|
sl@0
|
624 |
test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
|
|
sl@0
|
625 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
626 |
namespace eval test_ns_delete {
|
|
sl@0
|
627 |
namespace eval test_ns_delete2 {}
|
|
sl@0
|
628 |
proc cmd {args} {namespace current}
|
|
sl@0
|
629 |
}
|
|
sl@0
|
630 |
list [namespace delete ::test_ns_delete::test_ns_delete2] \
|
|
sl@0
|
631 |
[namespace children ::test_ns_delete]
|
|
sl@0
|
632 |
} {{} {}}
|
|
sl@0
|
633 |
test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
|
|
sl@0
|
634 |
list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
|
|
sl@0
|
635 |
} {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
|
|
sl@0
|
636 |
test namespace-15.3 {Tcl_FindNamespace, relative name found} {
|
|
sl@0
|
637 |
namespace eval test_ns_delete {
|
|
sl@0
|
638 |
namespace eval test_ns_delete2 {}
|
|
sl@0
|
639 |
namespace eval test_ns_delete3 {}
|
|
sl@0
|
640 |
list [namespace delete test_ns_delete2] \
|
|
sl@0
|
641 |
[namespace children [namespace current]]
|
|
sl@0
|
642 |
}
|
|
sl@0
|
643 |
} {{} ::test_ns_delete::test_ns_delete3}
|
|
sl@0
|
644 |
test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
|
|
sl@0
|
645 |
namespace eval test_ns_delete2 {}
|
|
sl@0
|
646 |
namespace eval test_ns_delete {
|
|
sl@0
|
647 |
list [catch {namespace delete test_ns_delete2} msg] $msg
|
|
sl@0
|
648 |
}
|
|
sl@0
|
649 |
} {1 {unknown namespace "test_ns_delete2" in namespace delete command}}
|
|
sl@0
|
650 |
|
|
sl@0
|
651 |
test namespace-16.1 {Tcl_FindCommand, absolute name found} {
|
|
sl@0
|
652 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
653 |
namespace eval test_ns_1 {
|
|
sl@0
|
654 |
proc cmd {args} {return "[namespace current]::cmd: $args"}
|
|
sl@0
|
655 |
variable v "::test_ns_1::cmd"
|
|
sl@0
|
656 |
eval $v one
|
|
sl@0
|
657 |
}
|
|
sl@0
|
658 |
} {::test_ns_1::cmd: one}
|
|
sl@0
|
659 |
test namespace-16.2 {Tcl_FindCommand, absolute name found} {
|
|
sl@0
|
660 |
eval $test_ns_1::v two
|
|
sl@0
|
661 |
} {::test_ns_1::cmd: two}
|
|
sl@0
|
662 |
test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
|
|
sl@0
|
663 |
namespace eval test_ns_1 {
|
|
sl@0
|
664 |
variable v2 "::test_ns_1::ladidah"
|
|
sl@0
|
665 |
list [catch {eval $v2} msg] $msg
|
|
sl@0
|
666 |
}
|
|
sl@0
|
667 |
} {1 {invalid command name "::test_ns_1::ladidah"}}
|
|
sl@0
|
668 |
|
|
sl@0
|
669 |
# save the "unknown" proc, which is redefined by the following two tests
|
|
sl@0
|
670 |
catch {rename unknown unknown.old}
|
|
sl@0
|
671 |
proc unknown {args} {
|
|
sl@0
|
672 |
return "unknown: $args"
|
|
sl@0
|
673 |
}
|
|
sl@0
|
674 |
test namespace-16.4 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
|
|
sl@0
|
675 |
::test_ns_1::foobar x y z
|
|
sl@0
|
676 |
} {unknown: ::test_ns_1::foobar x y z}
|
|
sl@0
|
677 |
test namespace-16.5 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
|
|
sl@0
|
678 |
::foobar 1 2 3 4 5
|
|
sl@0
|
679 |
} {unknown: ::foobar 1 2 3 4 5}
|
|
sl@0
|
680 |
test namespace-16.6 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
|
|
sl@0
|
681 |
test_ns_1::foobar x y z
|
|
sl@0
|
682 |
} {unknown: test_ns_1::foobar x y z}
|
|
sl@0
|
683 |
test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
|
|
sl@0
|
684 |
foobar 1 2 3 4 5
|
|
sl@0
|
685 |
} {unknown: foobar 1 2 3 4 5}
|
|
sl@0
|
686 |
# restore the "unknown" proc saved previously
|
|
sl@0
|
687 |
catch {rename unknown {}}
|
|
sl@0
|
688 |
catch {rename unknown.old unknown}
|
|
sl@0
|
689 |
|
|
sl@0
|
690 |
test namespace-16.8 {Tcl_FindCommand, relative name found} {
|
|
sl@0
|
691 |
namespace eval test_ns_1 {
|
|
sl@0
|
692 |
cmd a b c
|
|
sl@0
|
693 |
}
|
|
sl@0
|
694 |
} {::test_ns_1::cmd: a b c}
|
|
sl@0
|
695 |
test namespace-16.9 {Tcl_FindCommand, relative name found} {
|
|
sl@0
|
696 |
catch {rename cmd2 {}}
|
|
sl@0
|
697 |
proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
|
|
sl@0
|
698 |
namespace eval test_ns_1 {
|
|
sl@0
|
699 |
cmd2 a b c
|
|
sl@0
|
700 |
}
|
|
sl@0
|
701 |
} {::::cmd2: a b c}
|
|
sl@0
|
702 |
test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} {
|
|
sl@0
|
703 |
namespace eval test_ns_1 {
|
|
sl@0
|
704 |
proc cmd2 {args} {
|
|
sl@0
|
705 |
return "[namespace current]::cmd2 in test_ns_1: $args"
|
|
sl@0
|
706 |
}
|
|
sl@0
|
707 |
namespace eval test_ns_12 {
|
|
sl@0
|
708 |
cmd2 a b c
|
|
sl@0
|
709 |
}
|
|
sl@0
|
710 |
}
|
|
sl@0
|
711 |
} {::::cmd2: a b c}
|
|
sl@0
|
712 |
test namespace-16.11 {Tcl_FindCommand, relative name not found} {
|
|
sl@0
|
713 |
namespace eval test_ns_1 {
|
|
sl@0
|
714 |
list [catch {cmd3 a b c} msg] $msg
|
|
sl@0
|
715 |
}
|
|
sl@0
|
716 |
} {1 {invalid command name "cmd3"}}
|
|
sl@0
|
717 |
|
|
sl@0
|
718 |
catch {unset x}
|
|
sl@0
|
719 |
test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
|
|
sl@0
|
720 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
721 |
set x 314159
|
|
sl@0
|
722 |
namespace eval test_ns_1 {
|
|
sl@0
|
723 |
set ::x
|
|
sl@0
|
724 |
}
|
|
sl@0
|
725 |
} {314159}
|
|
sl@0
|
726 |
test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
|
|
sl@0
|
727 |
namespace eval test_ns_1 {
|
|
sl@0
|
728 |
variable x 777
|
|
sl@0
|
729 |
set ::test_ns_1::x
|
|
sl@0
|
730 |
}
|
|
sl@0
|
731 |
} {777}
|
|
sl@0
|
732 |
test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
|
|
sl@0
|
733 |
namespace eval test_ns_1 {
|
|
sl@0
|
734 |
namespace eval test_ns_2 {
|
|
sl@0
|
735 |
variable x 1111
|
|
sl@0
|
736 |
}
|
|
sl@0
|
737 |
set ::test_ns_1::test_ns_2::x
|
|
sl@0
|
738 |
}
|
|
sl@0
|
739 |
} {1111}
|
|
sl@0
|
740 |
test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
|
|
sl@0
|
741 |
namespace eval test_ns_1 {
|
|
sl@0
|
742 |
namespace eval test_ns_2 {
|
|
sl@0
|
743 |
variable x 1111
|
|
sl@0
|
744 |
}
|
|
sl@0
|
745 |
list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
|
|
sl@0
|
746 |
}
|
|
sl@0
|
747 |
} {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
|
|
sl@0
|
748 |
test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {
|
|
sl@0
|
749 |
namespace eval test_ns_1 {
|
|
sl@0
|
750 |
namespace eval test_ns_3 {
|
|
sl@0
|
751 |
variable ::test_ns_1::test_ns_2::x 2222
|
|
sl@0
|
752 |
}
|
|
sl@0
|
753 |
}
|
|
sl@0
|
754 |
set ::test_ns_1::test_ns_2::x
|
|
sl@0
|
755 |
} {2222}
|
|
sl@0
|
756 |
test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {
|
|
sl@0
|
757 |
namespace eval test_ns_1 {
|
|
sl@0
|
758 |
set x
|
|
sl@0
|
759 |
}
|
|
sl@0
|
760 |
} {777}
|
|
sl@0
|
761 |
test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
|
|
sl@0
|
762 |
namespace eval test_ns_1 {
|
|
sl@0
|
763 |
unset x
|
|
sl@0
|
764 |
set x ;# must be global x now
|
|
sl@0
|
765 |
}
|
|
sl@0
|
766 |
} {314159}
|
|
sl@0
|
767 |
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
|
|
sl@0
|
768 |
namespace eval test_ns_1 {
|
|
sl@0
|
769 |
list [catch {set wuzzat} msg] $msg
|
|
sl@0
|
770 |
}
|
|
sl@0
|
771 |
} {1 {can't read "wuzzat": no such variable}}
|
|
sl@0
|
772 |
test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
|
|
sl@0
|
773 |
namespace eval test_ns_1 {
|
|
sl@0
|
774 |
variable a hello
|
|
sl@0
|
775 |
}
|
|
sl@0
|
776 |
set test_ns_1::a
|
|
sl@0
|
777 |
} {hello}
|
|
sl@0
|
778 |
catch {unset x}
|
|
sl@0
|
779 |
|
|
sl@0
|
780 |
catch {unset l}
|
|
sl@0
|
781 |
catch {rename foo {}}
|
|
sl@0
|
782 |
test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
|
|
sl@0
|
783 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
784 |
proc foo {} {return "global foo"}
|
|
sl@0
|
785 |
namespace eval test_ns_1 {
|
|
sl@0
|
786 |
proc trigger {} {
|
|
sl@0
|
787 |
return [foo]
|
|
sl@0
|
788 |
}
|
|
sl@0
|
789 |
}
|
|
sl@0
|
790 |
set l ""
|
|
sl@0
|
791 |
lappend l [test_ns_1::trigger]
|
|
sl@0
|
792 |
namespace eval test_ns_1 {
|
|
sl@0
|
793 |
# force invalidation of cached ref to "foo" in proc trigger
|
|
sl@0
|
794 |
proc foo {} {return "foo in test_ns_1"}
|
|
sl@0
|
795 |
}
|
|
sl@0
|
796 |
lappend l [test_ns_1::trigger]
|
|
sl@0
|
797 |
set l
|
|
sl@0
|
798 |
} {{global foo} {foo in test_ns_1}}
|
|
sl@0
|
799 |
test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
|
|
sl@0
|
800 |
namespace eval test_ns_2 {
|
|
sl@0
|
801 |
proc foo {} {return "foo in ::test_ns_2"}
|
|
sl@0
|
802 |
}
|
|
sl@0
|
803 |
namespace eval test_ns_1 {
|
|
sl@0
|
804 |
namespace eval test_ns_2 {}
|
|
sl@0
|
805 |
proc trigger {} {
|
|
sl@0
|
806 |
return [test_ns_2::foo]
|
|
sl@0
|
807 |
}
|
|
sl@0
|
808 |
}
|
|
sl@0
|
809 |
set l ""
|
|
sl@0
|
810 |
lappend l [test_ns_1::trigger]
|
|
sl@0
|
811 |
namespace eval test_ns_1 {
|
|
sl@0
|
812 |
namespace eval test_ns_2 {
|
|
sl@0
|
813 |
# force invalidation of cached ref to "foo" in proc trigger
|
|
sl@0
|
814 |
proc foo {} {return "foo in ::test_ns_1::test_ns_2"}
|
|
sl@0
|
815 |
}
|
|
sl@0
|
816 |
}
|
|
sl@0
|
817 |
lappend l [test_ns_1::trigger]
|
|
sl@0
|
818 |
set l
|
|
sl@0
|
819 |
} {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
|
|
sl@0
|
820 |
catch {unset l}
|
|
sl@0
|
821 |
catch {rename foo {}}
|
|
sl@0
|
822 |
|
|
sl@0
|
823 |
test namespace-19.1 {GetNamespaceFromObj, global name found} {
|
|
sl@0
|
824 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
825 |
namespace eval test_ns_1::test_ns_2 {}
|
|
sl@0
|
826 |
namespace children ::test_ns_1
|
|
sl@0
|
827 |
} {::test_ns_1::test_ns_2}
|
|
sl@0
|
828 |
test namespace-19.2 {GetNamespaceFromObj, relative name found} {
|
|
sl@0
|
829 |
namespace eval test_ns_1 {
|
|
sl@0
|
830 |
namespace children test_ns_2
|
|
sl@0
|
831 |
}
|
|
sl@0
|
832 |
} {}
|
|
sl@0
|
833 |
test namespace-19.3 {GetNamespaceFromObj, name not found} {
|
|
sl@0
|
834 |
namespace eval test_ns_1 {
|
|
sl@0
|
835 |
list [catch {namespace children test_ns_99} msg] $msg
|
|
sl@0
|
836 |
}
|
|
sl@0
|
837 |
} {1 {unknown namespace "test_ns_99" in namespace children command}}
|
|
sl@0
|
838 |
test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
|
|
sl@0
|
839 |
namespace eval test_ns_1 {
|
|
sl@0
|
840 |
proc foo {} {
|
|
sl@0
|
841 |
return [namespace children test_ns_2]
|
|
sl@0
|
842 |
}
|
|
sl@0
|
843 |
list [catch {namespace children test_ns_99} msg] $msg
|
|
sl@0
|
844 |
}
|
|
sl@0
|
845 |
set l {}
|
|
sl@0
|
846 |
lappend l [test_ns_1::foo]
|
|
sl@0
|
847 |
namespace delete test_ns_1::test_ns_2
|
|
sl@0
|
848 |
namespace eval test_ns_1::test_ns_2::test_ns_3 {}
|
|
sl@0
|
849 |
lappend l [test_ns_1::foo]
|
|
sl@0
|
850 |
set l
|
|
sl@0
|
851 |
} {{} ::test_ns_1::test_ns_2::test_ns_3}
|
|
sl@0
|
852 |
|
|
sl@0
|
853 |
test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
|
|
sl@0
|
854 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
855 |
list [catch {namespace} msg] $msg
|
|
sl@0
|
856 |
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
|
|
sl@0
|
857 |
test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} {
|
|
sl@0
|
858 |
list [catch {namespace wombat {}} msg] $msg
|
|
sl@0
|
859 |
} {1 {bad option "wombat": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
|
|
sl@0
|
860 |
test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
|
|
sl@0
|
861 |
namespace ch :: test_ns_*
|
|
sl@0
|
862 |
} {}
|
|
sl@0
|
863 |
|
|
sl@0
|
864 |
test namespace-21.1 {NamespaceChildrenCmd, no args} {
|
|
sl@0
|
865 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
866 |
namespace eval test_ns_1::test_ns_2 {}
|
|
sl@0
|
867 |
expr {[string first ::test_ns_1 [namespace children]] != -1}
|
|
sl@0
|
868 |
} {1}
|
|
sl@0
|
869 |
test namespace-21.2 {NamespaceChildrenCmd, no args} {
|
|
sl@0
|
870 |
namespace eval test_ns_1 {
|
|
sl@0
|
871 |
namespace children
|
|
sl@0
|
872 |
}
|
|
sl@0
|
873 |
} {::test_ns_1::test_ns_2}
|
|
sl@0
|
874 |
test namespace-21.3 {NamespaceChildrenCmd, ns name given} {
|
|
sl@0
|
875 |
namespace children ::test_ns_1
|
|
sl@0
|
876 |
} {::test_ns_1::test_ns_2}
|
|
sl@0
|
877 |
test namespace-21.4 {NamespaceChildrenCmd, ns name given} {
|
|
sl@0
|
878 |
namespace eval test_ns_1 {
|
|
sl@0
|
879 |
namespace children test_ns_2
|
|
sl@0
|
880 |
}
|
|
sl@0
|
881 |
} {}
|
|
sl@0
|
882 |
test namespace-21.5 {NamespaceChildrenCmd, too many args} {
|
|
sl@0
|
883 |
namespace eval test_ns_1 {
|
|
sl@0
|
884 |
list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
|
|
sl@0
|
885 |
}
|
|
sl@0
|
886 |
} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
|
|
sl@0
|
887 |
test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
|
|
sl@0
|
888 |
namespace eval test_ns_1::test_ns_foo {}
|
|
sl@0
|
889 |
namespace children test_ns_1 *f*
|
|
sl@0
|
890 |
} {::test_ns_1::test_ns_foo}
|
|
sl@0
|
891 |
test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
|
|
sl@0
|
892 |
namespace eval test_ns_1::test_ns_foo {}
|
|
sl@0
|
893 |
lsort [namespace children test_ns_1 test*]
|
|
sl@0
|
894 |
} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
|
|
sl@0
|
895 |
|
|
sl@0
|
896 |
test namespace-22.1 {NamespaceCodeCmd, bad args} {
|
|
sl@0
|
897 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
898 |
list [catch {namespace code} msg] $msg \
|
|
sl@0
|
899 |
[catch {namespace code xxx yyy} msg] $msg
|
|
sl@0
|
900 |
} {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}}
|
|
sl@0
|
901 |
test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} {
|
|
sl@0
|
902 |
namespace eval test_ns_1 {
|
|
sl@0
|
903 |
proc cmd {} {return "test_ns_1::cmd"}
|
|
sl@0
|
904 |
}
|
|
sl@0
|
905 |
namespace code {namespace inscope ::test_ns_1 cmd}
|
|
sl@0
|
906 |
} {namespace inscope ::test_ns_1 cmd}
|
|
sl@0
|
907 |
test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} {
|
|
sl@0
|
908 |
namespace code {namespace inscope ::test_ns_1 cmd}
|
|
sl@0
|
909 |
} {namespace inscope ::test_ns_1 cmd}
|
|
sl@0
|
910 |
test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {
|
|
sl@0
|
911 |
namespace code unknown
|
|
sl@0
|
912 |
} {::namespace inscope :: unknown}
|
|
sl@0
|
913 |
test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
|
|
sl@0
|
914 |
namespace eval test_ns_1 {
|
|
sl@0
|
915 |
namespace code cmd
|
|
sl@0
|
916 |
}
|
|
sl@0
|
917 |
} {::namespace inscope ::test_ns_1 cmd}
|
|
sl@0
|
918 |
test namespace-22.6 {NamespaceCodeCmd, in other namespace} {
|
|
sl@0
|
919 |
namespace eval test_ns_1 {
|
|
sl@0
|
920 |
variable v 42
|
|
sl@0
|
921 |
}
|
|
sl@0
|
922 |
namespace eval test_ns_2 {
|
|
sl@0
|
923 |
proc namespace args {}
|
|
sl@0
|
924 |
}
|
|
sl@0
|
925 |
namespace eval test_ns_2 [namespace eval test_ns_1 {
|
|
sl@0
|
926 |
namespace code {set v}
|
|
sl@0
|
927 |
}]
|
|
sl@0
|
928 |
} {42}
|
|
sl@0
|
929 |
|
|
sl@0
|
930 |
test namespace-23.1 {NamespaceCurrentCmd, bad args} {
|
|
sl@0
|
931 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
932 |
list [catch {namespace current xxx} msg] $msg \
|
|
sl@0
|
933 |
[catch {namespace current xxx yyy} msg] $msg
|
|
sl@0
|
934 |
} {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}}
|
|
sl@0
|
935 |
test namespace-23.2 {NamespaceCurrentCmd, at global level} {
|
|
sl@0
|
936 |
namespace current
|
|
sl@0
|
937 |
} {::}
|
|
sl@0
|
938 |
test namespace-23.3 {NamespaceCurrentCmd, in nested ns} {
|
|
sl@0
|
939 |
namespace eval test_ns_1::test_ns_2 {
|
|
sl@0
|
940 |
namespace current
|
|
sl@0
|
941 |
}
|
|
sl@0
|
942 |
} {::test_ns_1::test_ns_2}
|
|
sl@0
|
943 |
|
|
sl@0
|
944 |
test namespace-24.1 {NamespaceDeleteCmd, no args} {
|
|
sl@0
|
945 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
946 |
namespace delete
|
|
sl@0
|
947 |
} {}
|
|
sl@0
|
948 |
test namespace-24.2 {NamespaceDeleteCmd, one arg} {
|
|
sl@0
|
949 |
namespace eval test_ns_1::test_ns_2 {}
|
|
sl@0
|
950 |
namespace delete ::test_ns_1
|
|
sl@0
|
951 |
} {}
|
|
sl@0
|
952 |
test namespace-24.3 {NamespaceDeleteCmd, two args} {
|
|
sl@0
|
953 |
namespace eval test_ns_1::test_ns_2 {}
|
|
sl@0
|
954 |
list [namespace delete ::test_ns_1::test_ns_2] [namespace delete ::test_ns_1]
|
|
sl@0
|
955 |
} {{} {}}
|
|
sl@0
|
956 |
test namespace-24.4 {NamespaceDeleteCmd, unknown ns} {
|
|
sl@0
|
957 |
list [catch {namespace delete ::test_ns_foo} msg] $msg
|
|
sl@0
|
958 |
} {1 {unknown namespace "::test_ns_foo" in namespace delete command}}
|
|
sl@0
|
959 |
|
|
sl@0
|
960 |
test namespace-25.1 {NamespaceEvalCmd, bad args} {
|
|
sl@0
|
961 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
962 |
list [catch {namespace eval} msg] $msg
|
|
sl@0
|
963 |
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
|
|
sl@0
|
964 |
test namespace-25.2 {NamespaceEvalCmd, bad args} {
|
|
sl@0
|
965 |
list [catch {namespace test_ns_1} msg] $msg
|
|
sl@0
|
966 |
} {1 {bad option "test_ns_1": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
|
|
sl@0
|
967 |
catch {unset v}
|
|
sl@0
|
968 |
test namespace-25.3 {NamespaceEvalCmd, new namespace} {
|
|
sl@0
|
969 |
set v 123
|
|
sl@0
|
970 |
namespace eval test_ns_1 {
|
|
sl@0
|
971 |
variable v 314159
|
|
sl@0
|
972 |
proc p {} {
|
|
sl@0
|
973 |
variable v
|
|
sl@0
|
974 |
return $v
|
|
sl@0
|
975 |
}
|
|
sl@0
|
976 |
}
|
|
sl@0
|
977 |
test_ns_1::p
|
|
sl@0
|
978 |
} {314159}
|
|
sl@0
|
979 |
test namespace-25.4 {NamespaceEvalCmd, existing namespace} {
|
|
sl@0
|
980 |
namespace eval test_ns_1 {
|
|
sl@0
|
981 |
proc q {} {return [expr {[p]+1}]}
|
|
sl@0
|
982 |
}
|
|
sl@0
|
983 |
test_ns_1::q
|
|
sl@0
|
984 |
} {314160}
|
|
sl@0
|
985 |
test namespace-25.5 {NamespaceEvalCmd, multiple args} {
|
|
sl@0
|
986 |
namespace eval test_ns_1 "set" "v"
|
|
sl@0
|
987 |
} {314159}
|
|
sl@0
|
988 |
test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
|
|
sl@0
|
989 |
list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $errorInfo
|
|
sl@0
|
990 |
} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
|
|
sl@0
|
991 |
while executing
|
|
sl@0
|
992 |
"xxxx"
|
|
sl@0
|
993 |
(in namespace eval "::test_ns_1" script line 1)
|
|
sl@0
|
994 |
invoked from within
|
|
sl@0
|
995 |
"namespace eval test_ns_1 {xxxx}"}}
|
|
sl@0
|
996 |
test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} {
|
|
sl@0
|
997 |
list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $errorInfo
|
|
sl@0
|
998 |
} {1 foo {bar
|
|
sl@0
|
999 |
(in namespace eval "::test_ns_1" script line 1)
|
|
sl@0
|
1000 |
invoked from within
|
|
sl@0
|
1001 |
"namespace eval test_ns_1 {error foo bar baz}"}}
|
|
sl@0
|
1002 |
test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} knownBug {
|
|
sl@0
|
1003 |
list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $errorInfo
|
|
sl@0
|
1004 |
} {1 foo {bar
|
|
sl@0
|
1005 |
(in namespace eval "::test_ns_1" script line 1)
|
|
sl@0
|
1006 |
invoked from within
|
|
sl@0
|
1007 |
"namespace eval test_ns_1 error foo bar baz"}}
|
|
sl@0
|
1008 |
catch {unset v}
|
|
sl@0
|
1009 |
test namespace-25.9 {NamespaceEvalCmd, 545325} {
|
|
sl@0
|
1010 |
namespace eval test_ns_1 info level 0
|
|
sl@0
|
1011 |
} {namespace eval test_ns_1 info level 0}
|
|
sl@0
|
1012 |
|
|
sl@0
|
1013 |
test namespace-26.1 {NamespaceExportCmd, no args and new ns} {
|
|
sl@0
|
1014 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1015 |
namespace export
|
|
sl@0
|
1016 |
} {}
|
|
sl@0
|
1017 |
test namespace-26.2 {NamespaceExportCmd, just -clear arg} {
|
|
sl@0
|
1018 |
namespace export -clear
|
|
sl@0
|
1019 |
} {}
|
|
sl@0
|
1020 |
test namespace-26.3 {NamespaceExportCmd, pattern can't specify a namespace} {
|
|
sl@0
|
1021 |
namespace eval test_ns_1 {
|
|
sl@0
|
1022 |
list [catch {namespace export ::zzz} msg] $msg
|
|
sl@0
|
1023 |
}
|
|
sl@0
|
1024 |
} {1 {invalid export pattern "::zzz": pattern can't specify a namespace}}
|
|
sl@0
|
1025 |
test namespace-26.4 {NamespaceExportCmd, one pattern} {
|
|
sl@0
|
1026 |
namespace eval test_ns_1 {
|
|
sl@0
|
1027 |
namespace export cmd1
|
|
sl@0
|
1028 |
proc cmd1 {args} {return "cmd1: $args"}
|
|
sl@0
|
1029 |
proc cmd2 {args} {return "cmd2: $args"}
|
|
sl@0
|
1030 |
proc cmd3 {args} {return "cmd3: $args"}
|
|
sl@0
|
1031 |
proc cmd4 {args} {return "cmd4: $args"}
|
|
sl@0
|
1032 |
}
|
|
sl@0
|
1033 |
namespace eval test_ns_2 {
|
|
sl@0
|
1034 |
namespace import ::test_ns_1::*
|
|
sl@0
|
1035 |
}
|
|
sl@0
|
1036 |
list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
|
|
sl@0
|
1037 |
} {::test_ns_2::cmd1 {cmd1: hello}}
|
|
sl@0
|
1038 |
test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {
|
|
sl@0
|
1039 |
namespace eval test_ns_1 {
|
|
sl@0
|
1040 |
namespace export cmd1 cmd3
|
|
sl@0
|
1041 |
}
|
|
sl@0
|
1042 |
namespace eval test_ns_2 {
|
|
sl@0
|
1043 |
namespace import -force ::test_ns_1::*
|
|
sl@0
|
1044 |
}
|
|
sl@0
|
1045 |
list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello]
|
|
sl@0
|
1046 |
} [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}]
|
|
sl@0
|
1047 |
test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} {
|
|
sl@0
|
1048 |
namespace eval test_ns_1 {
|
|
sl@0
|
1049 |
namespace export
|
|
sl@0
|
1050 |
}
|
|
sl@0
|
1051 |
} {cmd1 cmd3}
|
|
sl@0
|
1052 |
test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
|
|
sl@0
|
1053 |
namespace eval test_ns_1 {
|
|
sl@0
|
1054 |
namespace export -clear cmd4
|
|
sl@0
|
1055 |
}
|
|
sl@0
|
1056 |
namespace eval test_ns_2 {
|
|
sl@0
|
1057 |
namespace import ::test_ns_1::*
|
|
sl@0
|
1058 |
}
|
|
sl@0
|
1059 |
list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
|
|
sl@0
|
1060 |
} [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
|
|
sl@0
|
1061 |
|
|
sl@0
|
1062 |
test namespace-27.1 {NamespaceForgetCmd, no args} {
|
|
sl@0
|
1063 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1064 |
namespace forget
|
|
sl@0
|
1065 |
} {}
|
|
sl@0
|
1066 |
test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} {
|
|
sl@0
|
1067 |
list [catch {namespace forget ::test_ns_1::xxx} msg] $msg
|
|
sl@0
|
1068 |
} {1 {unknown namespace in namespace forget pattern "::test_ns_1::xxx"}}
|
|
sl@0
|
1069 |
test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} {
|
|
sl@0
|
1070 |
namespace eval test_ns_1 {
|
|
sl@0
|
1071 |
namespace export cmd*
|
|
sl@0
|
1072 |
proc cmd1 {args} {return "cmd1: $args"}
|
|
sl@0
|
1073 |
proc cmd2 {args} {return "cmd2: $args"}
|
|
sl@0
|
1074 |
}
|
|
sl@0
|
1075 |
namespace eval test_ns_2 {
|
|
sl@0
|
1076 |
namespace import ::test_ns_1::*
|
|
sl@0
|
1077 |
namespace forget ::test_ns_1::cmd1
|
|
sl@0
|
1078 |
}
|
|
sl@0
|
1079 |
info commands ::test_ns_2::*
|
|
sl@0
|
1080 |
} {::test_ns_2::cmd2}
|
|
sl@0
|
1081 |
|
|
sl@0
|
1082 |
test namespace-28.1 {NamespaceImportCmd, no args} {
|
|
sl@0
|
1083 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1084 |
namespace import
|
|
sl@0
|
1085 |
} {}
|
|
sl@0
|
1086 |
test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} {
|
|
sl@0
|
1087 |
namespace import -force
|
|
sl@0
|
1088 |
} {}
|
|
sl@0
|
1089 |
test namespace-28.3 {NamespaceImportCmd, arg is imported} {
|
|
sl@0
|
1090 |
namespace eval test_ns_1 {
|
|
sl@0
|
1091 |
namespace export cmd2
|
|
sl@0
|
1092 |
proc cmd1 {args} {return "cmd1: $args"}
|
|
sl@0
|
1093 |
proc cmd2 {args} {return "cmd2: $args"}
|
|
sl@0
|
1094 |
}
|
|
sl@0
|
1095 |
namespace eval test_ns_2 {
|
|
sl@0
|
1096 |
namespace import ::test_ns_1::*
|
|
sl@0
|
1097 |
namespace forget ::test_ns_1::cmd1
|
|
sl@0
|
1098 |
}
|
|
sl@0
|
1099 |
info commands test_ns_2::*
|
|
sl@0
|
1100 |
} {::test_ns_2::cmd2}
|
|
sl@0
|
1101 |
|
|
sl@0
|
1102 |
test namespace-29.1 {NamespaceInscopeCmd, bad args} {
|
|
sl@0
|
1103 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1104 |
list [catch {namespace inscope} msg] $msg
|
|
sl@0
|
1105 |
} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
|
|
sl@0
|
1106 |
test namespace-29.2 {NamespaceInscopeCmd, bad args} {
|
|
sl@0
|
1107 |
list [catch {namespace inscope ::} msg] $msg
|
|
sl@0
|
1108 |
} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
|
|
sl@0
|
1109 |
test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} {
|
|
sl@0
|
1110 |
list [catch {namespace inscope test_ns_1 {set v}} msg] $msg
|
|
sl@0
|
1111 |
} {1 {unknown namespace "test_ns_1" in inscope namespace command}}
|
|
sl@0
|
1112 |
test namespace-29.4 {NamespaceInscopeCmd, simple case} {
|
|
sl@0
|
1113 |
namespace eval test_ns_1 {
|
|
sl@0
|
1114 |
variable v 747
|
|
sl@0
|
1115 |
proc cmd {args} {
|
|
sl@0
|
1116 |
variable v
|
|
sl@0
|
1117 |
return "[namespace current]::cmd: v=$v, args=$args"
|
|
sl@0
|
1118 |
}
|
|
sl@0
|
1119 |
}
|
|
sl@0
|
1120 |
namespace inscope test_ns_1 cmd
|
|
sl@0
|
1121 |
} {::test_ns_1::cmd: v=747, args=}
|
|
sl@0
|
1122 |
test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
|
|
sl@0
|
1123 |
list [namespace inscope test_ns_1 cmd x y z] \
|
|
sl@0
|
1124 |
[namespace eval test_ns_1 [concat cmd [list x y z]]]
|
|
sl@0
|
1125 |
} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
|
|
sl@0
|
1126 |
test namespace-29.6 {NamespaceInscopeCmd, 1400572} knownBug {
|
|
sl@0
|
1127 |
namespace inscope test_ns_1 {info level 0}
|
|
sl@0
|
1128 |
} {namespace inscope test_ns_1 {info level 0}}
|
|
sl@0
|
1129 |
|
|
sl@0
|
1130 |
|
|
sl@0
|
1131 |
test namespace-30.1 {NamespaceOriginCmd, bad args} {
|
|
sl@0
|
1132 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1133 |
list [catch {namespace origin} msg] $msg
|
|
sl@0
|
1134 |
} {1 {wrong # args: should be "namespace origin name"}}
|
|
sl@0
|
1135 |
test namespace-30.2 {NamespaceOriginCmd, bad args} {
|
|
sl@0
|
1136 |
list [catch {namespace origin x y} msg] $msg
|
|
sl@0
|
1137 |
} {1 {wrong # args: should be "namespace origin name"}}
|
|
sl@0
|
1138 |
test namespace-30.3 {NamespaceOriginCmd, command not found} {
|
|
sl@0
|
1139 |
list [catch {namespace origin fred} msg] $msg
|
|
sl@0
|
1140 |
} {1 {invalid command name "fred"}}
|
|
sl@0
|
1141 |
test namespace-30.4 {NamespaceOriginCmd, command isn't imported} {
|
|
sl@0
|
1142 |
namespace origin set
|
|
sl@0
|
1143 |
} {::set}
|
|
sl@0
|
1144 |
test namespace-30.5 {NamespaceOriginCmd, imported command} {
|
|
sl@0
|
1145 |
namespace eval test_ns_1 {
|
|
sl@0
|
1146 |
namespace export cmd*
|
|
sl@0
|
1147 |
proc cmd1 {args} {return "cmd1: $args"}
|
|
sl@0
|
1148 |
proc cmd2 {args} {return "cmd2: $args"}
|
|
sl@0
|
1149 |
}
|
|
sl@0
|
1150 |
namespace eval test_ns_2 {
|
|
sl@0
|
1151 |
namespace export *
|
|
sl@0
|
1152 |
namespace import ::test_ns_1::*
|
|
sl@0
|
1153 |
proc p {} {}
|
|
sl@0
|
1154 |
}
|
|
sl@0
|
1155 |
namespace eval test_ns_3 {
|
|
sl@0
|
1156 |
namespace import ::test_ns_2::*
|
|
sl@0
|
1157 |
list [namespace origin foreach] \
|
|
sl@0
|
1158 |
[namespace origin p] \
|
|
sl@0
|
1159 |
[namespace origin cmd1] \
|
|
sl@0
|
1160 |
[namespace origin ::test_ns_2::cmd2]
|
|
sl@0
|
1161 |
}
|
|
sl@0
|
1162 |
} {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2}
|
|
sl@0
|
1163 |
|
|
sl@0
|
1164 |
test namespace-31.1 {NamespaceParentCmd, bad args} {
|
|
sl@0
|
1165 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1166 |
list [catch {namespace parent a b} msg] $msg
|
|
sl@0
|
1167 |
} {1 {wrong # args: should be "namespace parent ?name?"}}
|
|
sl@0
|
1168 |
test namespace-31.2 {NamespaceParentCmd, no args} {
|
|
sl@0
|
1169 |
namespace parent
|
|
sl@0
|
1170 |
} {}
|
|
sl@0
|
1171 |
test namespace-31.3 {NamespaceParentCmd, namespace specified} {
|
|
sl@0
|
1172 |
namespace eval test_ns_1 {
|
|
sl@0
|
1173 |
namespace eval test_ns_2 {
|
|
sl@0
|
1174 |
namespace eval test_ns_3 {}
|
|
sl@0
|
1175 |
}
|
|
sl@0
|
1176 |
}
|
|
sl@0
|
1177 |
list [namespace parent ::] \
|
|
sl@0
|
1178 |
[namespace parent test_ns_1::test_ns_2] \
|
|
sl@0
|
1179 |
[namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}]
|
|
sl@0
|
1180 |
} {{} ::test_ns_1 ::test_ns_1}
|
|
sl@0
|
1181 |
test namespace-31.4 {NamespaceParentCmd, bad namespace specified} {
|
|
sl@0
|
1182 |
list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg
|
|
sl@0
|
1183 |
} {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}}
|
|
sl@0
|
1184 |
|
|
sl@0
|
1185 |
test namespace-32.1 {NamespaceQualifiersCmd, bad args} {
|
|
sl@0
|
1186 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1187 |
list [catch {namespace qualifiers} msg] $msg
|
|
sl@0
|
1188 |
} {1 {wrong # args: should be "namespace qualifiers string"}}
|
|
sl@0
|
1189 |
test namespace-32.2 {NamespaceQualifiersCmd, bad args} {
|
|
sl@0
|
1190 |
list [catch {namespace qualifiers x y} msg] $msg
|
|
sl@0
|
1191 |
} {1 {wrong # args: should be "namespace qualifiers string"}}
|
|
sl@0
|
1192 |
test namespace-32.3 {NamespaceQualifiersCmd, simple name} {
|
|
sl@0
|
1193 |
namespace qualifiers foo
|
|
sl@0
|
1194 |
} {}
|
|
sl@0
|
1195 |
test namespace-32.4 {NamespaceQualifiersCmd, leading ::} {
|
|
sl@0
|
1196 |
namespace qualifiers ::x::y::z
|
|
sl@0
|
1197 |
} {::x::y}
|
|
sl@0
|
1198 |
test namespace-32.5 {NamespaceQualifiersCmd, no leading ::} {
|
|
sl@0
|
1199 |
namespace qualifiers a::b
|
|
sl@0
|
1200 |
} {a}
|
|
sl@0
|
1201 |
test namespace-32.6 {NamespaceQualifiersCmd, :: argument} {
|
|
sl@0
|
1202 |
namespace qualifiers ::
|
|
sl@0
|
1203 |
} {}
|
|
sl@0
|
1204 |
test namespace-32.7 {NamespaceQualifiersCmd, odd number of :s} {
|
|
sl@0
|
1205 |
namespace qualifiers :::::
|
|
sl@0
|
1206 |
} {}
|
|
sl@0
|
1207 |
test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} {
|
|
sl@0
|
1208 |
namespace qualifiers foo:::
|
|
sl@0
|
1209 |
} {foo}
|
|
sl@0
|
1210 |
|
|
sl@0
|
1211 |
test namespace-33.1 {NamespaceTailCmd, bad args} {
|
|
sl@0
|
1212 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1213 |
list [catch {namespace tail} msg] $msg
|
|
sl@0
|
1214 |
} {1 {wrong # args: should be "namespace tail string"}}
|
|
sl@0
|
1215 |
test namespace-33.2 {NamespaceTailCmd, bad args} {
|
|
sl@0
|
1216 |
list [catch {namespace tail x y} msg] $msg
|
|
sl@0
|
1217 |
} {1 {wrong # args: should be "namespace tail string"}}
|
|
sl@0
|
1218 |
test namespace-33.3 {NamespaceTailCmd, simple name} {
|
|
sl@0
|
1219 |
namespace tail foo
|
|
sl@0
|
1220 |
} {foo}
|
|
sl@0
|
1221 |
test namespace-33.4 {NamespaceTailCmd, leading ::} {
|
|
sl@0
|
1222 |
namespace tail ::x::y::z
|
|
sl@0
|
1223 |
} {z}
|
|
sl@0
|
1224 |
test namespace-33.5 {NamespaceTailCmd, no leading ::} {
|
|
sl@0
|
1225 |
namespace tail a::b
|
|
sl@0
|
1226 |
} {b}
|
|
sl@0
|
1227 |
test namespace-33.6 {NamespaceTailCmd, :: argument} {
|
|
sl@0
|
1228 |
namespace tail ::
|
|
sl@0
|
1229 |
} {}
|
|
sl@0
|
1230 |
test namespace-33.7 {NamespaceTailCmd, odd number of :s} {
|
|
sl@0
|
1231 |
namespace tail :::::
|
|
sl@0
|
1232 |
} {}
|
|
sl@0
|
1233 |
test namespace-33.8 {NamespaceTailCmd, odd number of :s} {
|
|
sl@0
|
1234 |
namespace tail foo:::
|
|
sl@0
|
1235 |
} {}
|
|
sl@0
|
1236 |
|
|
sl@0
|
1237 |
test namespace-34.1 {NamespaceWhichCmd, bad args} {
|
|
sl@0
|
1238 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1239 |
list [catch {namespace which} msg] $msg
|
|
sl@0
|
1240 |
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
|
|
sl@0
|
1241 |
test namespace-34.2 {NamespaceWhichCmd, bad args} {
|
|
sl@0
|
1242 |
list [catch {namespace which -fred} msg] $msg
|
|
sl@0
|
1243 |
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
|
|
sl@0
|
1244 |
test namespace-34.3 {NamespaceWhichCmd, bad args} {
|
|
sl@0
|
1245 |
list [catch {namespace which -command} msg] $msg
|
|
sl@0
|
1246 |
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
|
|
sl@0
|
1247 |
test namespace-34.4 {NamespaceWhichCmd, bad args} {
|
|
sl@0
|
1248 |
list [catch {namespace which a b} msg] $msg
|
|
sl@0
|
1249 |
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
|
|
sl@0
|
1250 |
test namespace-34.5 {NamespaceWhichCmd, command lookup} {
|
|
sl@0
|
1251 |
namespace eval test_ns_1 {
|
|
sl@0
|
1252 |
namespace export cmd*
|
|
sl@0
|
1253 |
variable v1 111
|
|
sl@0
|
1254 |
proc cmd1 {args} {return "cmd1: $args"}
|
|
sl@0
|
1255 |
proc cmd2 {args} {return "cmd2: $args"}
|
|
sl@0
|
1256 |
}
|
|
sl@0
|
1257 |
namespace eval test_ns_2 {
|
|
sl@0
|
1258 |
namespace export *
|
|
sl@0
|
1259 |
namespace import ::test_ns_1::*
|
|
sl@0
|
1260 |
variable v2 222
|
|
sl@0
|
1261 |
proc p {} {}
|
|
sl@0
|
1262 |
}
|
|
sl@0
|
1263 |
namespace eval test_ns_3 {
|
|
sl@0
|
1264 |
namespace import ::test_ns_2::*
|
|
sl@0
|
1265 |
variable v3 333
|
|
sl@0
|
1266 |
list [namespace which -command foreach] \
|
|
sl@0
|
1267 |
[namespace which -command p] \
|
|
sl@0
|
1268 |
[namespace which -command cmd1] \
|
|
sl@0
|
1269 |
[namespace which -command ::test_ns_2::cmd2] \
|
|
sl@0
|
1270 |
[catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
|
|
sl@0
|
1271 |
}
|
|
sl@0
|
1272 |
} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
|
|
sl@0
|
1273 |
test namespace-34.6 {NamespaceWhichCmd, -command is default} {
|
|
sl@0
|
1274 |
namespace eval test_ns_3 {
|
|
sl@0
|
1275 |
list [namespace which foreach] \
|
|
sl@0
|
1276 |
[namespace which p] \
|
|
sl@0
|
1277 |
[namespace which cmd1] \
|
|
sl@0
|
1278 |
[namespace which ::test_ns_2::cmd2]
|
|
sl@0
|
1279 |
}
|
|
sl@0
|
1280 |
} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
|
|
sl@0
|
1281 |
test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
|
|
sl@0
|
1282 |
namespace eval test_ns_3 {
|
|
sl@0
|
1283 |
list [namespace which -variable env] \
|
|
sl@0
|
1284 |
[namespace which -variable v3] \
|
|
sl@0
|
1285 |
[namespace which -variable ::test_ns_2::v2] \
|
|
sl@0
|
1286 |
[catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
|
|
sl@0
|
1287 |
}
|
|
sl@0
|
1288 |
} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
|
|
sl@0
|
1289 |
|
|
sl@0
|
1290 |
test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
|
|
sl@0
|
1291 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1292 |
namespace eval test_ns_1 {
|
|
sl@0
|
1293 |
proc p {} {
|
|
sl@0
|
1294 |
namespace delete [namespace current]
|
|
sl@0
|
1295 |
return [namespace current]
|
|
sl@0
|
1296 |
}
|
|
sl@0
|
1297 |
}
|
|
sl@0
|
1298 |
test_ns_1::p
|
|
sl@0
|
1299 |
} {::test_ns_1}
|
|
sl@0
|
1300 |
test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
|
|
sl@0
|
1301 |
namespace eval test_ns_1 {
|
|
sl@0
|
1302 |
proc q {} {
|
|
sl@0
|
1303 |
return [namespace current]
|
|
sl@0
|
1304 |
}
|
|
sl@0
|
1305 |
}
|
|
sl@0
|
1306 |
list [test_ns_1::q] \
|
|
sl@0
|
1307 |
[namespace delete test_ns_1] \
|
|
sl@0
|
1308 |
[catch {test_ns_1::q} msg] $msg
|
|
sl@0
|
1309 |
} {::test_ns_1 {} 1 {invalid command name "test_ns_1::q"}}
|
|
sl@0
|
1310 |
|
|
sl@0
|
1311 |
catch {unset x}
|
|
sl@0
|
1312 |
catch {unset y}
|
|
sl@0
|
1313 |
test namespace-36.1 {DupNsNameInternalRep} {
|
|
sl@0
|
1314 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1315 |
namespace eval test_ns_1 {}
|
|
sl@0
|
1316 |
set x "::test_ns_1"
|
|
sl@0
|
1317 |
list [namespace parent $x] [set y $x] [namespace parent $y]
|
|
sl@0
|
1318 |
} {:: ::test_ns_1 ::}
|
|
sl@0
|
1319 |
catch {unset x}
|
|
sl@0
|
1320 |
catch {unset y}
|
|
sl@0
|
1321 |
|
|
sl@0
|
1322 |
test namespace-37.1 {SetNsNameFromAny, ns name found} {
|
|
sl@0
|
1323 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1324 |
namespace eval test_ns_1::test_ns_2 {}
|
|
sl@0
|
1325 |
namespace eval test_ns_1 {
|
|
sl@0
|
1326 |
namespace children ::test_ns_1
|
|
sl@0
|
1327 |
}
|
|
sl@0
|
1328 |
} {::test_ns_1::test_ns_2}
|
|
sl@0
|
1329 |
test namespace-37.2 {SetNsNameFromAny, ns name not found} {
|
|
sl@0
|
1330 |
namespace eval test_ns_1 {
|
|
sl@0
|
1331 |
list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg
|
|
sl@0
|
1332 |
}
|
|
sl@0
|
1333 |
} {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}}
|
|
sl@0
|
1334 |
|
|
sl@0
|
1335 |
test namespace-38.1 {UpdateStringOfNsName} {
|
|
sl@0
|
1336 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1337 |
;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name
|
|
sl@0
|
1338 |
list [namespace eval {} {namespace current}] \
|
|
sl@0
|
1339 |
[namespace eval {} {namespace current}]
|
|
sl@0
|
1340 |
} {:: ::}
|
|
sl@0
|
1341 |
|
|
sl@0
|
1342 |
test namespace-39.1 {NamespaceExistsCmd} {
|
|
sl@0
|
1343 |
catch {eval namespace delete [namespace children :: test_ns_*]}
|
|
sl@0
|
1344 |
namespace eval ::test_ns_z::test_me { variable foo }
|
|
sl@0
|
1345 |
list [namespace exists ::] \
|
|
sl@0
|
1346 |
[namespace exists ::bogus_namespace] \
|
|
sl@0
|
1347 |
[namespace exists ::test_ns_z] \
|
|
sl@0
|
1348 |
[namespace exists test_ns_z] \
|
|
sl@0
|
1349 |
[namespace exists ::test_ns_z::foo] \
|
|
sl@0
|
1350 |
[namespace exists ::test_ns_z::test_me] \
|
|
sl@0
|
1351 |
[namespace eval ::test_ns_z { namespace exists ::test_me }] \
|
|
sl@0
|
1352 |
[namespace eval ::test_ns_z { namespace exists test_me }] \
|
|
sl@0
|
1353 |
[namespace exists :::::test_ns_z]
|
|
sl@0
|
1354 |
} {1 0 1 1 0 1 0 1 1}
|
|
sl@0
|
1355 |
test namespace-39.2 {NamespaceExistsCmd error} {
|
|
sl@0
|
1356 |
list [catch {namespace exists} msg] $msg
|
|
sl@0
|
1357 |
} {1 {wrong # args: should be "namespace exists name"}}
|
|
sl@0
|
1358 |
test namespace-39.3 {NamespaceExistsCmd error} {
|
|
sl@0
|
1359 |
list [catch {namespace exists a b} msg] $msg
|
|
sl@0
|
1360 |
} {1 {wrong # args: should be "namespace exists name"}}
|
|
sl@0
|
1361 |
|
|
sl@0
|
1362 |
test namespace-40.1 {Ignoring namespace proc "unknown"} {
|
|
sl@0
|
1363 |
rename unknown _unknown
|
|
sl@0
|
1364 |
proc unknown args {return global}
|
|
sl@0
|
1365 |
namespace eval ns {proc unknown args {return local}}
|
|
sl@0
|
1366 |
set l [list [namespace eval ns aaa bbb] [namespace eval ns aaa]]
|
|
sl@0
|
1367 |
rename unknown {}
|
|
sl@0
|
1368 |
rename _unknown unknown
|
|
sl@0
|
1369 |
namespace delete ns
|
|
sl@0
|
1370 |
set l
|
|
sl@0
|
1371 |
} {global global}
|
|
sl@0
|
1372 |
|
|
sl@0
|
1373 |
test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
|
|
sl@0
|
1374 |
set res {}
|
|
sl@0
|
1375 |
namespace eval ns {
|
|
sl@0
|
1376 |
set res {}
|
|
sl@0
|
1377 |
proc test {} {
|
|
sl@0
|
1378 |
set ::g 0
|
|
sl@0
|
1379 |
}
|
|
sl@0
|
1380 |
lappend ::res [test]
|
|
sl@0
|
1381 |
proc set {a b} {
|
|
sl@0
|
1382 |
::set a [incr b]
|
|
sl@0
|
1383 |
}
|
|
sl@0
|
1384 |
lappend ::res [test]
|
|
sl@0
|
1385 |
}
|
|
sl@0
|
1386 |
namespace delete ns
|
|
sl@0
|
1387 |
set res
|
|
sl@0
|
1388 |
} {0 1}
|
|
sl@0
|
1389 |
|
|
sl@0
|
1390 |
test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} {
|
|
sl@0
|
1391 |
set res {}
|
|
sl@0
|
1392 |
namespace eval ns {}
|
|
sl@0
|
1393 |
proc ns::a {i} {
|
|
sl@0
|
1394 |
variable b
|
|
sl@0
|
1395 |
proc set args {return "New proc is called"}
|
|
sl@0
|
1396 |
return [set b $i]
|
|
sl@0
|
1397 |
}
|
|
sl@0
|
1398 |
ns::a 1
|
|
sl@0
|
1399 |
set res [ns::a 2]
|
|
sl@0
|
1400 |
namespace delete ns
|
|
sl@0
|
1401 |
set res
|
|
sl@0
|
1402 |
} {New proc is called}
|
|
sl@0
|
1403 |
|
|
sl@0
|
1404 |
test namespace-41.3 {Shadowing byte-compiled commands, Bug: 231259} {knownBug} {
|
|
sl@0
|
1405 |
set res {}
|
|
sl@0
|
1406 |
namespace eval ns {
|
|
sl@0
|
1407 |
variable b 0
|
|
sl@0
|
1408 |
}
|
|
sl@0
|
1409 |
|
|
sl@0
|
1410 |
proc ns::a {i} {
|
|
sl@0
|
1411 |
variable b
|
|
sl@0
|
1412 |
proc set args {return "New proc is called"}
|
|
sl@0
|
1413 |
return [set b $i]
|
|
sl@0
|
1414 |
}
|
|
sl@0
|
1415 |
|
|
sl@0
|
1416 |
set res [list [ns::a 1] $ns::b]
|
|
sl@0
|
1417 |
namespace delete ns
|
|
sl@0
|
1418 |
set res
|
|
sl@0
|
1419 |
} {{New proc is called} 0}
|
|
sl@0
|
1420 |
|
|
sl@0
|
1421 |
# cleanup
|
|
sl@0
|
1422 |
catch {rename cmd1 {}}
|
|
sl@0
|
1423 |
catch {unset l}
|
|
sl@0
|
1424 |
catch {unset msg}
|
|
sl@0
|
1425 |
catch {unset trigger}
|
|
sl@0
|
1426 |
eval namespace delete [namespace children :: test_ns_*]
|
|
sl@0
|
1427 |
::tcltest::cleanupTests
|
|
sl@0
|
1428 |
return
|
|
sl@0
|
1429 |
|
|
sl@0
|
1430 |
|
|
sl@0
|
1431 |
|
|
sl@0
|
1432 |
|
|
sl@0
|
1433 |
|
|
sl@0
|
1434 |
|
|
sl@0
|
1435 |
|
|
sl@0
|
1436 |
|
|
sl@0
|
1437 |
|
|
sl@0
|
1438 |
|
|
sl@0
|
1439 |
|
|
sl@0
|
1440 |
|