OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [namespace.test] - Blame information for rev 1780

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# Functionality covered: this file contains a collection of tests for the
2 
# procedures in tclNamesp.c that implement Tcl's basic support for
3 
# namespaces. Other namespace-related tests appear in variable.test.
4 
#
5 
# Sourcing this file into Tcl runs the tests and generates output for
6 
# errors. No output means no errors were found.
7 
#
8 
# Copyright (c) 1997 Sun Microsystems, Inc.
9 
#
10 
# See the file "license.terms" for information on usage and redistribution
11 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 
#
13 
# RCS: @(#) $Id: namespace.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
14 
 
15 
if {[string compare test [info procs test]] == 1} then {source defs}
16 
 
17 
# Clear out any namespaces called test_ns_*
18 
catch {eval namespace delete [namespace children :: test_ns_*]}
19 
 
20 
test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} {
21 
    namespace children :: test_ns_*
22 
} {}
23 
 
24 
catch {unset l}
25 
test namespace-2.1 {Tcl_GetCurrentNamespace} {
26 
    list [namespace current] [namespace eval {} {namespace current}] \
27 
        [namespace eval {} {namespace current}]
28 
} {:: :: ::}
29 
test namespace-2.2 {Tcl_GetCurrentNamespace} {
30 
    set l {}
31 
    lappend l [namespace current]
32 
    namespace eval test_ns_1 {
33 
        lappend l [namespace current]
34 
        namespace eval foo {
35 
            lappend l [namespace current]
36 
        }
37 
    }
38 
    lappend l [namespace current]
39 
    set l
40 
} {:: ::test_ns_1 ::test_ns_1::foo ::}
41 
 
42 
test namespace-3.1 {Tcl_GetGlobalNamespace} {
43 
    namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
44 
    # namespace children uses Tcl_GetGlobalNamespace
45 
    namespace eval test_ns_1 {namespace children foo b*}
46 
} {::test_ns_1::foo::bar}
47 
 
48 
test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} {
49 
    namespace eval test_ns_1 {
50 
        variable v 123
51 
        proc p {} {
52 
            variable v
53 
            return $v
54 
        }
55 
    }
56 
    test_ns_1::p    ;# does Tcl_PushCallFrame to push p's namespace
57 
} {123}
58 
test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} {
59 
    namespace eval test_ns_1::baz {}  ;# does Tcl_PushCallFrame to create baz
60 
    proc test_ns_1::baz::p {} {
61 
        variable v
62 
        set v 789
63 
        set v}
64 
    test_ns_1::baz::p
65 
} {789}
66 
 
67 
test namespace-5.1 {Tcl_PopCallFrame, no vars} {
68 
    namespace eval test_ns_1::blodge {}  ;# pushes then pops frame
69 
} {}
70 
test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
71 
    proc test_ns_1::r {} {
72 
        set a 123
73 
    }
74 
    test_ns_1::r   ;# pushes then pop's r's frame
75 
} {123}
76 
 
77 
test namespace-6.1 {Tcl_CreateNamespace} {
78 
    catch {eval namespace delete [namespace children :: test_ns_*]}
79 
    list [lsort [namespace children :: test_ns_*]] \
80 
         [namespace eval test_ns_1 {namespace current}] \
81 
         [namespace eval test_ns_2 {namespace current}] \
82 
         [namespace eval ::test_ns_3 {namespace current}] \
83 
         [namespace eval ::test_ns_4 \
84 
             {namespace eval foo {namespace current}}] \
85 
         [namespace eval ::test_ns_5 \
86 
             {namespace eval ::test_ns_6 {namespace current}}] \
87 
         [lsort [namespace children :: test_ns_*]]
88 
} {{} ::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}}
89 
test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
90 
    list [namespace eval :::test_ns_1::::foo {namespace current}] \
91 
         [namespace eval test_ns_2:::::foo {namespace current}]
92 
} {::test_ns_1::foo ::test_ns_2::foo}
93 
test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
94 
    list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg
95 
} {0 ::test_ns_7}
96 
test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
97 
    catch {eval namespace delete [namespace children :: test_ns_*]}
98 
    namespace eval test_ns_1:: {
99 
        namespace eval test_ns_2:: {}
100 
        namespace eval test_ns_3:: {}
101 
    }
102 
    namespace children ::test_ns_1
103 
} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}
104 
test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} {
105 
    set trigger {
106 
        namespace eval test_ns_2 {namespace current}
107 
    }
108 
    set l {}
109 
    lappend l [namespace eval test_ns_1 $trigger]
110 
    namespace eval test_ns_1::test_ns_2 {}
111 
    lappend l [namespace eval test_ns_1 $trigger]
112 
} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2}
113 
 
114 
test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} {
115 
    catch {eval namespace delete [namespace children :: test_ns_*]}
116 
    namespace eval test_ns_1 {
117 
        proc p {} {
118 
            namespace delete [namespace current]
119 
            return [namespace current]
120 
        }
121 
    }
122 
    list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg
123 
} {::test_ns_1 1 {invalid command name "test_ns_1::p"}}
124 
test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
125 
    namespace eval test_ns_2 {
126 
        proc p {} {
127 
            return [namespace current]
128 
        }
129 
    }
130 
    list [test_ns_2::p] [namespace delete test_ns_2]
131 
} {::test_ns_2 {}}
132 
 
133 
test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
134 
    catch {interp delete test_interp}
135 
    interp create test_interp
136 
    interp eval test_interp {
137 
        namespace eval test_ns_1 {
138 
            namespace export p
139 
            proc p {} {
140 
                return [namespace current]
141 
            }
142 
        }
143 
        namespace eval test_ns_2 {
144 
            namespace import ::test_ns_1::p
145 
            variable v 27
146 
            proc q {} {
147 
                variable v
148 
                return "[p] $v"
149 
            }
150 
        }
151 
        set x [test_ns_2::q]
152 
        catch {set xxxx}
153 
    }
154 
    list [interp eval test_interp {test_ns_2::q}] \
155 
         [interp eval test_interp {namespace delete ::}] \
156 
         [catch {interp eval test_interp {set a 123}} msg] $msg \
157 
         [interp delete test_interp]
158 
} {{::test_ns_1 27} {} 1 {invalid command name "set"} {}}
159 
test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} {
160 
    catch {eval namespace delete [namespace children :: test_ns_*]}
161 
    namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
162 
    namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
163 
    list [namespace children test_ns_1] \
164 
         [namespace delete test_ns_1::test_ns_2] \
165 
         [namespace children test_ns_1]
166 
} {::test_ns_1::test_ns_2 {} {}}
167 
test namespace-8.3 {TclTeardownNamespace, delete child namespaces} {
168 
    catch {eval namespace delete [namespace children :: test_ns_*]}
169 
    namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
170 
    namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
171 
    list [namespace children test_ns_1] \
172 
         [namespace delete test_ns_1::test_ns_2] \
173 
         [namespace children test_ns_1] \
174 
         [catch {namespace children test_ns_1::test_ns_2} msg] $msg \
175 
         [info commands test_ns_1::test_ns_2::test_ns_3a::*]
176 
} {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}}
177 
test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} {
178 
    catch {eval namespace delete [namespace children :: test_ns_*]}
179 
    namespace eval test_ns_export {
180 
        namespace export cmd1 cmd2
181 
        proc cmd1 {args} {return "cmd1: $args"}
182 
        proc cmd2 {args} {return "cmd2: $args"}
183 
    }
184 
    namespace eval test_ns_import {
185 
        namespace import ::test_ns_export::*
186 
        proc p {} {return foo}
187 
    }
188 
    list [info commands test_ns_import::*] \
189 
         [namespace delete test_ns_export] \
190 
         [info commands test_ns_import::*]
191 
} {{::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2} {} ::test_ns_import::p}
192 
 
193 
test namespace-9.1 {Tcl_Import, empty import pattern} {
194 
    catch {eval namespace delete [namespace children :: test_ns_*]}
195 
    list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg
196 
} {1 {empty import pattern}}
197 
test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} {
198 
    list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg
199 
} {1 {unknown namespace in import pattern "fred::x"}}
200 
test namespace-9.3 {Tcl_Import, import ns == export ns} {
201 
    list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg
202 
} {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}}
203 
test namespace-9.4 {Tcl_Import, simple import} {
204 
    catch {eval namespace delete [namespace children :: test_ns_*]}
205 
    namespace eval test_ns_export {
206 
        namespace export cmd1
207 
        proc cmd1 {args} {return "cmd1: $args"}
208 
        proc cmd2 {args} {return "cmd2: $args"}
209 
    }
210 
    namespace eval test_ns_import {
211 
        namespace import ::test_ns_export::*
212 
        proc p {} {return [cmd1 123]}
213 
    }
214 
    test_ns_import::p
215 
} {cmd1: 123}
216 
test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} {
217 
    list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
218 
} {1 {can't import command "cmd1": already exists}}
219 
test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
220 
    namespace eval test_ns_import {
221 
        namespace import -force ::test_ns_export::*
222 
        cmd1 555
223 
    }
224 
} {cmd1: 555}
225 
test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
226 
    catch {eval namespace delete [namespace children :: test_ns_*]}
227 
    namespace eval test_ns_export {
228 
        namespace export cmd1
229 
        proc cmd1 {args} {return "cmd1: $args"}
230 
    }
231 
    namespace eval test_ns_import {
232 
        namespace import -force ::test_ns_export::*
233 
    }
234 
    list [test_ns_import::cmd1 a b c] \
235 
         [test_ns_export::cmd1 d e f] \
236 
         [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \
237 
         [namespace origin test_ns_import::cmd1] \
238 
         [namespace origin test_ns_export::cmd1] \
239 
         [test_ns_import::cmd1 g h i] \
240 
         [test_ns_export::cmd1 j k l]
241 
} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}
242 
 
243 
test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} {
244 
    catch {eval namespace delete [namespace children :: test_ns_*]}
245 
    list [catch {namespace forget xyzzy::*} msg] $msg
246 
} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
247 
test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
248 
    namespace eval test_ns_export {
249 
        namespace export cmd1
250 
        proc cmd1 {args} {return "cmd1: $args"}
251 
        proc cmd2 {args} {return "cmd2: $args"}
252 
    }
253 
    namespace eval test_ns_import {
254 
        namespace forget ::test_ns_export::wombat
255 
    }
256 
} {}
257 
test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
258 
    namespace eval test_ns_import {
259 
        namespace import ::test_ns_export::*
260 
        proc p {} {return [cmd1 123]}
261 
        set l {}
262 
        lappend l [info commands ::test_ns_import::*]
263 
        namespace forget ::test_ns_export::cmd1
264 
        lappend l [info commands ::test_ns_import::*]
265 
        lappend l [catch {cmd1 777} msg] $msg
266 
    }
267 
} {{::test_ns_import::p ::test_ns_import::cmd1} ::test_ns_import::p 1 {invalid command name "cmd1"}}
268 
 
269 
test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
270 
    catch {eval namespace delete [namespace children :: test_ns_*]}
271 
    namespace eval test_ns_export {
272 
        namespace export cmd1
273 
        proc cmd1 {args} {return "cmd1: $args"}
274 
    }
275 
    list [namespace origin set] [namespace origin test_ns_export::cmd1]
276 
} {::set ::test_ns_export::cmd1}
277 
test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {
278 
    namespace eval test_ns_import1 {
279 
        namespace import ::test_ns_export::*
280 
        namespace export *
281 
        proc p {} {namespace origin cmd1}
282 
    }
283 
    list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
284 
} {::test_ns_export::cmd1 ::test_ns_export::cmd1}
285 
test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
286 
    namespace eval test_ns_import2 {
287 
        namespace import ::test_ns_import1::*
288 
        proc q {} {return [cmd1 123]}
289 
    }
290 
    list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
291 
} {{cmd1: 123} ::test_ns_export::cmd1}
292 
 
293 
test namespace-12.1 {InvokeImportedCmd} {
294 
    catch {eval namespace delete [namespace children :: test_ns_*]}
295 
    namespace eval test_ns_export {
296 
        namespace export cmd1
297 
        proc cmd1 {args} {namespace current}
298 
    }
299 
    namespace eval test_ns_import {
300 
        namespace import ::test_ns_export::*
301 
    }
302 
    list [test_ns_import::cmd1]
303 
} {::test_ns_export}
304 
 
305 
test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
306 
    namespace eval test_ns_import {
307 
        set l {}
308 
        lappend l [info commands ::test_ns_import::*]
309 
        namespace forget ::test_ns_export::cmd1
310 
        lappend l [info commands ::test_ns_import::*]
311 
    }
312 
} {::test_ns_import::cmd1 {}}
313 
 
314 
test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
315 
    catch {eval namespace delete [namespace children :: test_ns_*]}
316 
    variable v 10
317 
    namespace eval test_ns_1::test_ns_2 {
318 
        variable v 20
319 
    }
320 
    namespace eval test_ns_2 {
321 
        variable v 30
322 
    }
323 
    namespace eval test_ns_1 {
324 
        list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
325 
             [namespace children :: test_ns_*]
326 
    }
327 
} {10 30 20 {::test_ns_1 ::test_ns_2}}
328 
test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
329 
    namespace eval test_ns_1 {
330 
        list [catch {set ::test_ns_777::v} msg] $msg \
331 
             [catch {namespace children test_ns_777} msg] $msg
332 
    }
333 
} {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}}
334 
test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
335 
    namespace eval test_ns_1 {
336 
        list $v $test_ns_2::v
337 
    }
338 
} {10 20}
339 
test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
340 
    namespace eval test_ns_1::test_ns_2 {
341 
        namespace eval foo {}
342 
    }
343 
    namespace eval test_ns_1 {
344 
        list [namespace children test_ns_2] \
345 
             [catch {namespace children test_ns_1} msg] $msg
346 
    }
347 
} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
348 
test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
349 
    namespace eval ::test_ns_2 {
350 
        namespace eval bar {}
351 
    }
352 
    namespace eval test_ns_1 {
353 
        set l [list [catch {namespace delete test_ns_2::bar} msg] $msg]
354 
    }
355 
    set l
356 
} {1 {unknown namespace "test_ns_2::bar" in namespace delete command}}
357 
test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
358 
    namespace eval test_ns_1::test_ns_2 {
359 
        namespace eval foo {}
360 
    }
361 
    namespace eval test_ns_1 {
362 
        list [namespace children test_ns_2] \
363 
             [catch {namespace children test_ns_1} msg] $msg
364 
    }
365 
} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
366 
test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
367 
    namespace children test_ns_1:::
368 
} {::test_ns_1::test_ns_2}
369 
test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
370 
    namespace children :::test_ns_1:::::test_ns_2:::
371 
} {::test_ns_1::test_ns_2::foo}
372 
test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
373 
    set l {}
374 
    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
375 
    namespace eval test_ns_1::test_ns_2 {variable {} 2525}
376 
    lappend l [set test_ns_1::test_ns_2::]
377 
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
378 
test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
379 
    catch {unset test_ns_1::test_ns_2::}
380 
    set l {}
381 
    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
382 
    set test_ns_1::test_ns_2:: 314159
383 
    lappend l [set test_ns_1::test_ns_2::]
384 
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
385 
test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {
386 
    catch {rename test_ns_1::test_ns_2:: {}}
387 
    set l {}
388 
    lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
389 
    proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
390 
    lappend l [test_ns_1::test_ns_2:: hello]
391 
} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
392 
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
393 
    catch {eval namespace delete [namespace children :: test_ns_*]}
394 
    namespace eval test_ns_1 {
395 
        variable {}
396 
        set test_ns_1::(x) y
397 
    }
398 
    set test_ns_1::(x)
399 
} y
400 
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
401 
    catch {eval namespace delete [namespace children :: test_ns_*]}
402 
    list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
403 
} {1 {can't create namespace "": only global namespace can have empty name}}
404 
 
405 
test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
406 
    catch {eval namespace delete [namespace children :: test_ns_*]}
407 
    namespace eval test_ns_delete {
408 
        namespace eval test_ns_delete2 {}
409 
        proc cmd {args} {namespace current}
410 
    }
411 
    list [namespace delete ::test_ns_delete::test_ns_delete2] \
412 
         [namespace children ::test_ns_delete]
413 
} {{} {}}
414 
test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
415 
    list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
416 
} {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
417 
test namespace-15.3 {Tcl_FindNamespace, relative name found} {
418 
    namespace eval test_ns_delete {
419 
        namespace eval test_ns_delete2 {}
420 
        namespace eval test_ns_delete3 {}
421 
        list [namespace delete test_ns_delete2] \
422 
             [namespace children [namespace current]]
423 
    }
424 
} {{} ::test_ns_delete::test_ns_delete3}
425 
test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
426 
    namespace eval test_ns_delete2 {}
427 
    namespace eval test_ns_delete {
428 
        list [catch {namespace delete test_ns_delete2} msg] $msg
429 
    }
430 
} {1 {unknown namespace "test_ns_delete2" in namespace delete command}}
431 
 
432 
test namespace-16.1 {Tcl_FindCommand, absolute name found} {
433 
    catch {eval namespace delete [namespace children :: test_ns_*]}
434 
    namespace eval test_ns_1 {
435 
        proc cmd {args} {return "[namespace current]::cmd: $args"}
436 
        variable v "::test_ns_1::cmd"
437 
        eval $v one
438 
    }
439 
} {::test_ns_1::cmd: one}
440 
test namespace-16.2 {Tcl_FindCommand, absolute name found} {
441 
    eval $test_ns_1::v two
442 
} {::test_ns_1::cmd: two}
443 
test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
444 
    namespace eval test_ns_1 {
445 
        variable v2 "::test_ns_1::ladidah"
446 
        list [catch {eval $v2} msg] $msg
447 
    }
448 
} {1 {invalid command name "::test_ns_1::ladidah"}}
449 
 
450 
# save the "unknown" proc, which is redefined by the following two tests
451 
catch {rename unknown unknown.old}
452 
proc unknown {args} {
453 
    return "unknown: $args"
454 
}
455 
test namespace-16.4 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
456 
    ::test_ns_1::foobar x y z
457 
} {unknown: ::test_ns_1::foobar x y z}
458 
test namespace-16.5 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
459 
    ::foobar 1 2 3 4 5
460 
} {unknown: ::foobar 1 2 3 4 5}
461 
test namespace-16.6 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
462 
    test_ns_1::foobar x y z
463 
} {unknown: test_ns_1::foobar x y z}
464 
test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
465 
    foobar 1 2 3 4 5
466 
} {unknown: foobar 1 2 3 4 5}
467 
# restore the "unknown" proc saved previously
468 
catch {rename unknown {}}
469 
catch {rename unknown.old unknown}
470 
 
471 
test namespace-16.8 {Tcl_FindCommand, relative name found} {
472 
    namespace eval test_ns_1 {
473 
        cmd a b c
474 
    }
475 
} {::test_ns_1::cmd: a b c}
476 
test namespace-16.9 {Tcl_FindCommand, relative name found} {
477 
    catch {rename cmd2 {}}
478 
    proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
479 
    namespace eval test_ns_1 {
480 
       cmd2 a b c
481 
    }
482 
} {::::cmd2: a b c}
483 
test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} {
484 
    namespace eval test_ns_1 {
485 
        proc cmd2 {args} {
486 
            return "[namespace current]::cmd2 in test_ns_1: $args"
487 
        }
488 
        namespace eval test_ns_12 {
489 
            cmd2 a b c
490 
        }
491 
    }
492 
} {::::cmd2: a b c}
493 
test namespace-16.11 {Tcl_FindCommand, relative name not found} {
494 
    namespace eval test_ns_1 {
495 
       list [catch {cmd3 a b c} msg] $msg
496 
    }
497 
} {1 {invalid command name "cmd3"}}
498 
 
499 
catch {unset x}
500 
test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
501 
    catch {eval namespace delete [namespace children :: test_ns_*]}
502 
    set x 314159
503 
    namespace eval test_ns_1 {
504 
        set ::x
505 
    }
506 
} {314159}
507 
test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
508 
    namespace eval test_ns_1 {
509 
        variable x 777
510 
        set ::test_ns_1::x
511 
    }
512 
} {777}
513 
test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
514 
    namespace eval test_ns_1 {
515 
        namespace eval test_ns_2 {
516 
            variable x 1111
517 
        }
518 
        set ::test_ns_1::test_ns_2::x
519 
    }
520 
} {1111}
521 
test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
522 
    namespace eval test_ns_1 {
523 
        namespace eval test_ns_2 {
524 
            variable x 1111
525 
        }
526 
        list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
527 
    }
528 
} {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
529 
test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {
530 
    namespace eval test_ns_1 {
531 
        namespace eval test_ns_3 {
532 
            variable ::test_ns_1::test_ns_2::x 2222
533 
        }
534 
    }
535 
    set ::test_ns_1::test_ns_2::x
536 
} {2222}
537 
test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {
538 
    namespace eval test_ns_1 {
539 
        set x
540 
    }
541 
} {777}
542 
test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
543 
    namespace eval test_ns_1 {
544 
        unset x
545 
        set x  ;# must be global x now
546 
    }
547 
} {314159}
548 
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
549 
    namespace eval test_ns_1 {
550 
        list [catch {set wuzzat} msg] $msg
551 
    }
552 
} {1 {can't read "wuzzat": no such variable}}
553 
test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
554 
    namespace eval test_ns_1 {
555 
        variable a hello
556 
    }
557 
    set test_ns_1::a
558 
} {hello}
559 
catch {unset x}
560 
 
561 
catch {unset l}
562 
catch {rename foo {}}
563 
test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
564 
    catch {eval namespace delete [namespace children :: test_ns_*]}
565 
    proc foo {} {return "global foo"}
566 
    namespace eval test_ns_1 {
567 
        proc trigger {} {
568 
            return [foo]
569 
        }
570 
    }
571 
    set l ""
572 
    lappend l [test_ns_1::trigger]
573 
    namespace eval test_ns_1 {
574 
        # force invalidation of cached ref to "foo" in proc trigger
575 
        proc foo {} {return "foo in test_ns_1"}
576 
    }
577 
    lappend l [test_ns_1::trigger]
578 
    set l
579 
} {{global foo} {foo in test_ns_1}}
580 
test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
581 
    namespace eval test_ns_2 {
582 
        proc foo {} {return "foo in ::test_ns_2"}
583 
    }
584 
    namespace eval test_ns_1 {
585 
        namespace eval test_ns_2 {}
586 
        proc trigger {} {
587 
            return [test_ns_2::foo]
588 
        }
589 
    }
590 
    set l ""
591 
    lappend l [test_ns_1::trigger]
592 
    namespace eval test_ns_1 {
593 
        namespace eval test_ns_2 {
594 
            # force invalidation of cached ref to "foo" in proc trigger
595 
            proc foo {} {return "foo in ::test_ns_1::test_ns_2"}
596 
        }
597 
    }
598 
    lappend l [test_ns_1::trigger]
599 
    set l
600 
} {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
601 
catch {unset l}
602 
catch {rename foo {}}
603 
 
604 
test namespace-19.1 {GetNamespaceFromObj, global name found} {
605 
    catch {eval namespace delete [namespace children :: test_ns_*]}
606 
    namespace eval test_ns_1::test_ns_2 {}
607 
    namespace children ::test_ns_1
608 
} {::test_ns_1::test_ns_2}
609 
test namespace-19.2 {GetNamespaceFromObj, relative name found} {
610 
    namespace eval test_ns_1 {
611 
        namespace children test_ns_2
612 
    }
613 
} {}
614 
test namespace-19.3 {GetNamespaceFromObj, name not found} {
615 
    namespace eval test_ns_1 {
616 
        list [catch {namespace children test_ns_99} msg] $msg
617 
    }
618 
} {1 {unknown namespace "test_ns_99" in namespace children command}}
619 
test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
620 
    namespace eval test_ns_1 {
621 
        proc foo {} {
622 
            return [namespace children test_ns_2]
623 
        }
624 
        list [catch {namespace children test_ns_99} msg] $msg
625 
    }
626 
    set l {}
627 
    lappend l [test_ns_1::foo]
628 
    namespace delete test_ns_1::test_ns_2
629 
    namespace eval test_ns_1::test_ns_2::test_ns_3 {}
630 
    lappend l [test_ns_1::foo]
631 
    set l
632 
} {{} ::test_ns_1::test_ns_2::test_ns_3}
633 
 
634 
test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
635 
    catch {eval namespace delete [namespace children :: test_ns_*]}
636 
    list [catch {namespace} msg] $msg
637 
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
638 
test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} {
639 
    list [catch {namespace wombat {}} msg] $msg
640 
} {1 {bad option "wombat": must be children, code, current, delete, eval, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
641 
test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
642 
    namespace ch :: test_ns_*
643 
} {}
644 
 
645 
test namespace-21.1 {NamespaceChildrenCmd, no args} {
646 
    catch {eval namespace delete [namespace children :: test_ns_*]}
647 
    namespace eval test_ns_1::test_ns_2 {}
648 
    expr {[string first ::test_ns_1 [namespace children]] != -1}
649 
} {1}
650 
test namespace-21.2 {NamespaceChildrenCmd, no args} {
651 
    namespace eval test_ns_1 {
652 
        namespace children
653 
    }
654 
} {::test_ns_1::test_ns_2}
655 
test namespace-21.3 {NamespaceChildrenCmd, ns name given} {
656 
    namespace children ::test_ns_1
657 
} {::test_ns_1::test_ns_2}
658 
test namespace-21.4 {NamespaceChildrenCmd, ns name given} {
659 
    namespace eval test_ns_1 {
660 
        namespace children test_ns_2
661 
    }
662 
} {}
663 
test namespace-21.5 {NamespaceChildrenCmd, too many args} {
664 
    namespace eval test_ns_1 {
665 
        list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
666 
    }
667 
} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
668 
test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
669 
    namespace eval test_ns_1::test_ns_foo {}
670 
    namespace children test_ns_1 *f*
671 
} {::test_ns_1::test_ns_foo}
672 
test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
673 
    namespace eval test_ns_1::test_ns_foo {}
674 
    namespace children test_ns_1 test*
675 
} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}
676 
 
677 
test namespace-22.1 {NamespaceCodeCmd, bad args} {
678 
    catch {eval namespace delete [namespace children :: test_ns_*]}
679 
    list [catch {namespace code} msg] $msg \
680 
         [catch {namespace code xxx yyy} msg] $msg
681 
} {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}}
682 
test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} {
683 
    namespace eval test_ns_1 {
684 
        proc cmd {} {return "test_ns_1::cmd"}
685 
    }
686 
    namespace code {namespace inscope ::test_ns_1 cmd}
687 
} {namespace inscope ::test_ns_1 cmd}
688 
test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} {
689 
    namespace code {namespace     inscope     ::test_ns_1 cmd}
690 
} {namespace     inscope     ::test_ns_1 cmd}
691 
test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {
692 
    namespace code unknown
693 
} {namespace inscope :: unknown}
694 
test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
695 
    namespace eval test_ns_1 {
696 
        namespace code cmd
697 
    }
698 
} {namespace inscope ::test_ns_1 cmd}
699 
 
700 
test namespace-23.1 {NamespaceCurrentCmd, bad args} {
701 
    catch {eval namespace delete [namespace children :: test_ns_*]}
702 
    list [catch {namespace current xxx} msg] $msg \
703 
         [catch {namespace current xxx yyy} msg] $msg
704 
} {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}}
705 
test namespace-23.2 {NamespaceCurrentCmd, at global level} {
706 
    namespace current
707 
} {::}
708 
test namespace-23.3 {NamespaceCurrentCmd, in nested ns} {
709 
    namespace eval test_ns_1::test_ns_2 {
710 
        namespace current
711 
    }
712 
} {::test_ns_1::test_ns_2}
713 
 
714 
test namespace-24.1 {NamespaceDeleteCmd, no args} {
715 
    catch {eval namespace delete [namespace children :: test_ns_*]}
716 
    namespace delete
717 
} {}
718 
test namespace-24.2 {NamespaceDeleteCmd, one arg} {
719 
    namespace eval test_ns_1::test_ns_2 {}
720 
    namespace delete ::test_ns_1
721 
} {}
722 
test namespace-24.3 {NamespaceDeleteCmd, two args} {
723 
    namespace eval test_ns_1::test_ns_2 {}
724 
    list [namespace delete ::test_ns_1::test_ns_2] [namespace delete ::test_ns_1]
725 
} {{} {}}
726 
test namespace-24.4 {NamespaceDeleteCmd, unknown ns} {
727 
    list [catch {namespace delete ::test_ns_foo} msg] $msg
728 
} {1 {unknown namespace "::test_ns_foo" in namespace delete command}}
729 
 
730 
test namespace-25.1 {NamespaceEvalCmd, bad args} {
731 
    catch {eval namespace delete [namespace children :: test_ns_*]}
732 
    list [catch {namespace eval} msg] $msg
733 
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
734 
test namespace-25.2 {NamespaceEvalCmd, bad args} {
735 
    list [catch {namespace test_ns_1} msg] $msg
736 
} {1 {bad option "test_ns_1": must be children, code, current, delete, eval, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
737 
catch {unset v}
738 
test namespace-25.3 {NamespaceEvalCmd, new namespace} {
739 
    set v 123
740 
    namespace eval test_ns_1 {
741 
        variable v 314159
742 
        proc p {} {
743 
            variable v
744 
            return $v
745 
        }
746 
    }
747 
    test_ns_1::p
748 
} {314159}
749 
test namespace-25.4 {NamespaceEvalCmd, existing namespace} {
750 
    namespace eval test_ns_1 {
751 
        proc q {} {return [expr {[p]+1}]}
752 
    }
753 
    test_ns_1::q
754 
} {314160}
755 
test namespace-25.5 {NamespaceEvalCmd, multiple args} {
756 
    namespace eval test_ns_1 "set" "v"
757 
} {314159}
758 
test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
759 
    list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $errorInfo
760 
} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
761 
    while executing
762 
"xxxx"
763 
    (in namespace eval "::test_ns_1" script line 1)
764 
    invoked from within
765 
"namespace eval test_ns_1 {xxxx}"}}
766 
catch {unset v}
767 
 
768 
test namespace-26.1 {NamespaceExportCmd, no args and new ns} {
769 
    catch {eval namespace delete [namespace children :: test_ns_*]}
770 
    namespace export
771 
} {}
772 
test namespace-26.2 {NamespaceExportCmd, just -clear arg} {
773 
    namespace export -clear
774 
} {}
775 
test namespace-26.3 {NamespaceExportCmd, pattern can't specify a namespace} {
776 
    namespace eval test_ns_1 {
777 
        list [catch {namespace export ::zzz} msg] $msg
778 
    }
779 
} {1 {invalid export pattern "::zzz": pattern can't specify a namespace}}
780 
test namespace-26.4 {NamespaceExportCmd, one pattern} {
781 
    namespace eval test_ns_1 {
782 
        namespace export cmd1
783 
        proc cmd1 {args} {return "cmd1: $args"}
784 
        proc cmd2 {args} {return "cmd2: $args"}
785 
        proc cmd3 {args} {return "cmd3: $args"}
786 
        proc cmd4 {args} {return "cmd4: $args"}
787 
    }
788 
    namespace eval test_ns_2 {
789 
        namespace import ::test_ns_1::*
790 
    }
791 
    list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
792 
} {::test_ns_2::cmd1 {cmd1: hello}}
793 
test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {
794 
    namespace eval test_ns_1 {
795 
        namespace export cmd1 cmd3
796 
    }
797 
    namespace eval test_ns_2 {
798 
        namespace import -force ::test_ns_1::*
799 
    }
800 
    list [info commands test_ns_2::*] [test_ns_2::cmd3 hello]
801 
} {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}}
802 
test namespace-26.6 {NamespaceExportCmd, no patterns means return export list} {
803 
    namespace eval test_ns_1 {
804 
        namespace export
805 
    }
806 
} {cmd1 cmd1 cmd3}
807 
test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
808 
    namespace eval test_ns_1 {
809 
        namespace export -clear cmd4
810 
    }
811 
    namespace eval test_ns_2 {
812 
        namespace import ::test_ns_1::*
813 
    }
814 
    list [info commands test_ns_2::*] [test_ns_2::cmd4 hello]
815 
} {{::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd4: hello}}
816 
 
817 
test namespace-27.1 {NamespaceForgetCmd, no args} {
818 
    catch {eval namespace delete [namespace children :: test_ns_*]}
819 
    namespace forget
820 
} {}
821 
test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} {
822 
    list [catch {namespace forget ::test_ns_1::xxx} msg] $msg
823 
} {1 {unknown namespace in namespace forget pattern "::test_ns_1::xxx"}}
824 
test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} {
825 
    namespace eval test_ns_1 {
826 
        namespace export cmd*
827 
        proc cmd1 {args} {return "cmd1: $args"}
828 
        proc cmd2 {args} {return "cmd2: $args"}
829 
    }
830 
    namespace eval test_ns_2 {
831 
        namespace import ::test_ns_1::*
832 
        namespace forget ::test_ns_1::cmd1
833 
    }
834 
    info commands ::test_ns_2::*
835 
} {::test_ns_2::cmd2}
836 
 
837 
test namespace-28.1 {NamespaceImportCmd, no args} {
838 
    catch {eval namespace delete [namespace children :: test_ns_*]}
839 
    namespace import
840 
} {}
841 
test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} {
842 
    namespace import -force
843 
} {}
844 
test namespace-28.3 {NamespaceImportCmd, arg is imported} {
845 
    namespace eval test_ns_1 {
846 
        namespace export cmd2
847 
        proc cmd1 {args} {return "cmd1: $args"}
848 
        proc cmd2 {args} {return "cmd2: $args"}
849 
    }
850 
    namespace eval test_ns_2 {
851 
        namespace import ::test_ns_1::*
852 
        namespace forget ::test_ns_1::cmd1
853 
    }
854 
    info commands test_ns_2::*
855 
} {::test_ns_2::cmd2}
856 
 
857 
test namespace-29.1 {NamespaceInscopeCmd, bad args} {
858 
    catch {eval namespace delete [namespace children :: test_ns_*]}
859 
    list [catch {namespace inscope} msg] $msg
860 
} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
861 
test namespace-29.2 {NamespaceInscopeCmd, bad args} {
862 
    list [catch {namespace inscope ::} msg] $msg
863 
} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
864 
test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} {
865 
    list [catch {namespace inscope test_ns_1 {set v}} msg] $msg
866 
} {1 {unknown namespace "test_ns_1" in inscope namespace command}}
867 
test namespace-29.4 {NamespaceInscopeCmd, simple case} {
868 
    namespace eval test_ns_1 {
869 
        variable v 747
870 
        proc cmd {args} {
871 
            variable v
872 
            return "[namespace current]::cmd: v=$v, args=$args"
873 
        }
874 
    }
875 
    namespace inscope test_ns_1 cmd
876 
} {::test_ns_1::cmd: v=747, args=}
877 
test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
878 
    list [namespace inscope test_ns_1 cmd x y z] \
879 
         [namespace eval test_ns_1 [concat cmd [list x y z]]]
880 
} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
881 
 
882 
test namespace-30.1 {NamespaceOriginCmd, bad args} {
883 
    catch {eval namespace delete [namespace children :: test_ns_*]}
884 
    list [catch {namespace origin} msg] $msg
885 
} {1 {wrong # args: should be "namespace origin name"}}
886 
test namespace-30.2 {NamespaceOriginCmd, bad args} {
887 
    list [catch {namespace origin x y} msg] $msg
888 
} {1 {wrong # args: should be "namespace origin name"}}
889 
test namespace-30.3 {NamespaceOriginCmd, command not found} {
890 
    list [catch {namespace origin fred} msg] $msg
891 
} {1 {invalid command name "fred"}}
892 
test namespace-30.4 {NamespaceOriginCmd, command isn't imported} {
893 
    namespace origin set
894 
} {::set}
895 
test namespace-30.5 {NamespaceOriginCmd, imported command} {
896 
    namespace eval test_ns_1 {
897 
        namespace export cmd*
898 
        proc cmd1 {args} {return "cmd1: $args"}
899 
        proc cmd2 {args} {return "cmd2: $args"}
900 
    }
901 
    namespace eval test_ns_2 {
902 
        namespace export *
903 
        namespace import ::test_ns_1::*
904 
        proc p {} {}
905 
    }
906 
    namespace eval test_ns_3 {
907 
        namespace import ::test_ns_2::*
908 
        list [namespace origin foreach] \
909 
             [namespace origin p] \
910 
             [namespace origin cmd1] \
911 
             [namespace origin ::test_ns_2::cmd2]
912 
    }
913 
} {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2}
914 
 
915 
test namespace-31.1 {NamespaceParentCmd, bad args} {
916 
    catch {eval namespace delete [namespace children :: test_ns_*]}
917 
    list [catch {namespace parent a b} msg] $msg
918 
} {1 {wrong # args: should be "namespace parent ?name?"}}
919 
test namespace-31.2 {NamespaceParentCmd, no args} {
920 
    namespace parent
921 
} {}
922 
test namespace-31.3 {NamespaceParentCmd, namespace specified} {
923 
    namespace eval test_ns_1 {
924 
        namespace eval test_ns_2 {
925 
            namespace eval test_ns_3 {}
926 
        }
927 
    }
928 
    list [namespace parent ::] \
929 
         [namespace parent test_ns_1::test_ns_2] \
930 
         [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}]
931 
} {{} ::test_ns_1 ::test_ns_1}
932 
test namespace-31.4 {NamespaceParentCmd, bad namespace specified} {
933 
    list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg
934 
} {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}}
935 
 
936 
test namespace-32.1 {NamespaceQualifiersCmd, bad args} {
937 
    catch {eval namespace delete [namespace children :: test_ns_*]}
938 
    list [catch {namespace qualifiers} msg] $msg
939 
} {1 {wrong # args: should be "namespace qualifiers string"}}
940 
test namespace-32.2 {NamespaceQualifiersCmd, bad args} {
941 
    list [catch {namespace qualifiers x y} msg] $msg
942 
} {1 {wrong # args: should be "namespace qualifiers string"}}
943 
test namespace-32.3 {NamespaceQualifiersCmd, simple name} {
944 
    namespace qualifiers foo
945 
} {}
946 
test namespace-32.4 {NamespaceQualifiersCmd, leading ::} {
947 
    namespace qualifiers ::x::y::z
948 
} {::x::y}
949 
test namespace-32.5 {NamespaceQualifiersCmd, no leading ::} {
950 
    namespace qualifiers a::b
951 
} {a}
952 
test namespace-32.6 {NamespaceQualifiersCmd, :: argument} {
953 
    namespace qualifiers ::
954 
} {}
955 
test namespace-32.7 {NamespaceQualifiersCmd, odd number of :s} {
956 
    namespace qualifiers :::::
957 
} {}
958 
test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} {
959 
    namespace qualifiers foo:::
960 
} {foo}
961 
 
962 
test namespace-33.1 {NamespaceTailCmd, bad args} {
963 
    catch {eval namespace delete [namespace children :: test_ns_*]}
964 
    list [catch {namespace tail} msg] $msg
965 
} {1 {wrong # args: should be "namespace tail string"}}
966 
test namespace-33.2 {NamespaceTailCmd, bad args} {
967 
    list [catch {namespace tail x y} msg] $msg
968 
} {1 {wrong # args: should be "namespace tail string"}}
969 
test namespace-33.3 {NamespaceTailCmd, simple name} {
970 
    namespace tail foo
971 
} {foo}
972 
test namespace-33.4 {NamespaceTailCmd, leading ::} {
973 
    namespace tail ::x::y::z
974 
} {z}
975 
test namespace-33.5 {NamespaceTailCmd, no leading ::} {
976 
    namespace tail a::b
977 
} {b}
978 
test namespace-33.6 {NamespaceTailCmd, :: argument} {
979 
    namespace tail ::
980 
} {}
981 
test namespace-33.7 {NamespaceTailCmd, odd number of :s} {
982 
    namespace tail :::::
983 
} {}
984 
test namespace-33.8 {NamespaceTailCmd, odd number of :s} {
985 
    namespace tail foo:::
986 
} {}
987 
 
988 
test namespace-34.1 {NamespaceWhichCmd, bad args} {
989 
    catch {eval namespace delete [namespace children :: test_ns_*]}
990 
    list [catch {namespace which} msg] $msg
991 
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
992 
test namespace-34.2 {NamespaceWhichCmd, bad args} {
993 
    list [catch {namespace which -fred} msg] $msg
994 
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
995 
test namespace-34.3 {NamespaceWhichCmd, bad args} {
996 
    list [catch {namespace which -command} msg] $msg
997 
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
998 
test namespace-34.4 {NamespaceWhichCmd, bad args} {
999 
    list [catch {namespace which a b} msg] $msg
1000 
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
1001 
test namespace-34.5 {NamespaceWhichCmd, command lookup} {
1002 
    namespace eval test_ns_1 {
1003 
        namespace export cmd*
1004 
        variable v1 111
1005 
        proc cmd1 {args} {return "cmd1: $args"}
1006 
        proc cmd2 {args} {return "cmd2: $args"}
1007 
    }
1008 
    namespace eval test_ns_2 {
1009 
        namespace export *
1010 
        namespace import ::test_ns_1::*
1011 
        variable v2 222
1012 
        proc p {} {}
1013 
    }
1014 
    namespace eval test_ns_3 {
1015 
        namespace import ::test_ns_2::*
1016 
        variable v3 333
1017 
        list [namespace which -command foreach] \
1018 
             [namespace which -command p] \
1019 
             [namespace which -command cmd1] \
1020 
             [namespace which -command ::test_ns_2::cmd2] \
1021 
             [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
1022 
    }
1023 
} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
1024 
test namespace-34.6 {NamespaceWhichCmd, -command is default} {
1025 
    namespace eval test_ns_3 {
1026 
        list [namespace which foreach] \
1027 
             [namespace which p] \
1028 
             [namespace which cmd1] \
1029 
             [namespace which ::test_ns_2::cmd2]
1030 
    }
1031 
} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
1032 
test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
1033 
    namespace eval test_ns_3 {
1034 
        list [namespace which -variable env] \
1035 
             [namespace which -variable v3] \
1036 
             [namespace which -variable ::test_ns_2::v2] \
1037 
             [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
1038 
    }
1039 
} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
1040 
 
1041 
test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
1042 
    catch {eval namespace delete [namespace children :: test_ns_*]}
1043 
    namespace eval test_ns_1 {
1044 
        proc p {} {
1045 
            namespace delete [namespace current]
1046 
            return [namespace current]
1047 
        }
1048 
    }
1049 
    test_ns_1::p
1050 
} {::test_ns_1}
1051 
test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
1052 
    namespace eval test_ns_1 {
1053 
        proc q {} {
1054 
            return [namespace current]
1055 
        }
1056 
    }
1057 
    list [test_ns_1::q] \
1058 
         [namespace delete test_ns_1] \
1059 
         [catch {test_ns_1::q} msg] $msg
1060 
} {::test_ns_1 {} 1 {invalid command name "test_ns_1::q"}}
1061 
 
1062 
catch {unset x}
1063 
catch {unset y}
1064 
test namespace-36.1 {DupNsNameInternalRep} {
1065 
    catch {eval namespace delete [namespace children :: test_ns_*]}
1066 
    namespace eval test_ns_1 {}
1067 
    set x "::test_ns_1"
1068 
    list [namespace parent $x] [set y $x] [namespace parent $y]
1069 
} {:: ::test_ns_1 ::}
1070 
catch {unset x}
1071 
catch {unset y}
1072 
 
1073 
test namespace-37.1 {SetNsNameFromAny, ns name found} {
1074 
    catch {eval namespace delete [namespace children :: test_ns_*]}
1075 
    namespace eval test_ns_1::test_ns_2 {}
1076 
    namespace eval test_ns_1 {
1077 
        namespace children ::test_ns_1
1078 
    }
1079 
} {::test_ns_1::test_ns_2}
1080 
test namespace-37.2 {SetNsNameFromAny, ns name not found} {
1081 
    namespace eval test_ns_1 {
1082 
        list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg
1083 
    }
1084 
} {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}}
1085 
 
1086 
test namespace-38.1 {UpdateStringOfNsName} {
1087 
    catch {eval namespace delete [namespace children :: test_ns_*]}
1088 
    ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name
1089 
    list [namespace eval {} {namespace current}] \
1090 
         [namespace eval {} {namespace current}]
1091 
} {:: ::}
1092 
 
1093 
catch {rename cmd1 {}}
1094 
catch {unset l}
1095 
catch {unset msg}
1096 
catch {unset trigger}
1097 
eval namespace delete [namespace children :: test_ns_*]

powered by: WebSVN 2.1.0

© copyright 1999-2025 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.