Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/tests/namespace.test @ 47

Last change on this file since 47 was 25, checked in by landauf, 17 years ago

added tcl to libs

File size: 88.5 KB
Line 
1# 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# Copyright (c) 1998-2000 by Scriptics Corporation.
10#
11# See the file "license.terms" for information on usage and redistribution
12# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13#
14# RCS: @(#) $Id: namespace.test,v 1.70 2007/12/13 15:26:06 dgp Exp $
15
16if {[lsearch [namespace children] ::tcltest] == -1} {
17    package require tcltest 2
18    namespace import -force ::tcltest::*
19}
20
21#
22# REMARK: the tests for 'namespace upvar' are not done here. They are to be
23# found in the file 'upvar.test'.
24#
25
26# Clear out any namespaces called test_ns_*
27catch {namespace delete {*}[namespace children :: test_ns_*]}
28
29test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} {
30    namespace children :: test_ns_*
31} {}
32
33catch {unset l}
34test namespace-2.1 {Tcl_GetCurrentNamespace} {
35    list [namespace current] [namespace eval {} {namespace current}] \
36        [namespace eval {} {namespace current}]
37} {:: :: ::}
38test namespace-2.2 {Tcl_GetCurrentNamespace} {
39    set l {}
40    lappend l [namespace current]
41    namespace eval test_ns_1 {
42        lappend l [namespace current]
43        namespace eval foo {
44            lappend l [namespace current]
45        }
46    }
47    lappend l [namespace current]
48    set l
49} {:: ::test_ns_1 ::test_ns_1::foo ::}
50
51test namespace-3.1 {Tcl_GetGlobalNamespace} {
52    namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
53    # namespace children uses Tcl_GetGlobalNamespace
54    namespace eval test_ns_1 {namespace children foo b*}
55} {::test_ns_1::foo::bar}
56
57test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} {
58    namespace eval test_ns_1 {
59        variable v 123
60        proc p {} {
61            variable v
62            return $v
63        }
64    }
65    test_ns_1::p    ;# does Tcl_PushCallFrame to push p's namespace
66} {123}
67test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} {
68    namespace eval test_ns_1::baz {}  ;# does Tcl_PushCallFrame to create baz
69    proc test_ns_1::baz::p {} {
70        variable v
71        set v 789
72        set v}
73    test_ns_1::baz::p
74} {789}
75
76test namespace-5.1 {Tcl_PopCallFrame, no vars} {
77    namespace eval test_ns_1::blodge {}  ;# pushes then pops frame
78} {}
79test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
80    proc test_ns_1::r {} {
81        set a 123
82    }
83    test_ns_1::r   ;# pushes then pop's r's frame
84} {123}
85
86test namespace-6.1 {Tcl_CreateNamespace} {
87    catch {namespace delete {*}[namespace children :: test_ns_*]}
88    list [lsort [namespace children :: test_ns_*]] \
89        [namespace eval test_ns_1 {namespace current}] \
90        [namespace eval test_ns_2 {namespace current}] \
91        [namespace eval ::test_ns_3 {namespace current}] \
92        [namespace eval ::test_ns_4 \
93            {namespace eval foo {namespace current}}] \
94        [namespace eval ::test_ns_5 \
95            {namespace eval ::test_ns_6 {namespace current}}] \
96        [lsort [namespace children :: test_ns_*]]
97} {{} ::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}}
98test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
99    list [namespace eval :::test_ns_1::::foo {namespace current}] \
100         [namespace eval test_ns_2:::::foo {namespace current}]
101} {::test_ns_1::foo ::test_ns_2::foo}
102test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
103    list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg
104} {0 ::test_ns_7}
105test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
106    catch {namespace delete {*}[namespace children :: test_ns_*]}
107    namespace eval test_ns_1:: {
108        namespace eval test_ns_2:: {}
109        namespace eval test_ns_3:: {}
110    }
111    lsort [namespace children ::test_ns_1]
112} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}]
113test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} {
114    set trigger {
115        namespace eval test_ns_2 {namespace current}
116    }
117    set l {}
118    lappend l [namespace eval test_ns_1 $trigger]
119    namespace eval test_ns_1::test_ns_2 {}
120    lappend l [namespace eval test_ns_1 $trigger]
121} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2}
122
123test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} {
124    catch {namespace delete {*}[namespace children :: test_ns_*]}
125    namespace eval test_ns_1 {
126        proc p {} {
127            namespace delete [namespace current]
128            return [namespace current]
129        }
130    }
131    list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg
132} {::test_ns_1 1 {invalid command name "test_ns_1::p"}}
133test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
134    namespace eval test_ns_2 {
135        proc p {} {
136            return [namespace current]
137        }
138    }
139    list [test_ns_2::p] [namespace delete test_ns_2]
140} {::test_ns_2 {}}
141test namespace-7.3 {recursive Tcl_DeleteNamespace, active call frames in ns} {
142    # [Bug 1355942]
143    namespace eval test_ns_2 {
144        set x 1
145        trace add variable x unset "namespace delete [namespace current];#"
146        namespace delete [namespace current]
147    }
148} {}
149test namespace-7.4 {recursive Tcl_DeleteNamespace, active call frames in ns} {
150    # [Bug 1355942]
151    namespace eval test_ns_2 {
152        proc x {} {}
153        trace add command x delete "namespace delete [namespace current];#"
154        namespace delete [namespace current]
155    }
156} {}
157test namespace-7.5 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
158    # [Bug 1355942]
159    namespace eval test_ns_2 {
160        set x 1
161        trace add variable x unset "namespace delete [namespace current];#"
162    }
163    namespace delete test_ns_2
164} {}
165test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
166    # [Bug 1355942]
167    namespace eval test_ns_2 {
168        proc x {} {}
169        trace add command x delete "namespace delete [namespace current];#"
170    }
171    namespace delete test_ns_2
172} {}
173test namespace-7.7 {Bug 1655305} -setup {
174    interp create slave
175    # Can't invoke through the ensemble, since deleting the global namespace
176    # (indirectly, via deleting ::tcl) deletes the ensemble.
177    slave eval {rename ::tcl::info::commands ::infocommands}
178    slave hide infocommands
179    slave eval {
180        proc foo {} {
181            namespace delete ::
182        }
183    }
184} -body {
185    slave eval foo
186    slave invokehidden infocommands
187} -cleanup {
188    interp delete slave
189} -result {}
190
191
192test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
193    catch {interp delete test_interp}
194    interp create test_interp
195    interp eval test_interp {
196        namespace eval test_ns_1 {
197            namespace export p
198            proc p {} {
199                return [namespace current]
200            }
201        }
202        namespace eval test_ns_2 {
203            namespace import ::test_ns_1::p
204            variable v 27
205            proc q {} {
206                variable v
207                return "[p] $v"
208            }
209        }
210        set x [test_ns_2::q]
211        catch {set xxxx}
212    }
213    list [interp eval test_interp {test_ns_2::q}] \
214         [interp eval test_interp {namespace delete ::}] \
215         [catch {interp eval test_interp {set a 123}} msg] $msg \
216         [interp delete test_interp]
217} {{::test_ns_1 27} {} 1 {invalid command name "set"} {}}
218test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} {
219    catch {namespace delete {*}[namespace children :: test_ns_*]}
220    namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
221    namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
222    list [namespace children test_ns_1] \
223         [namespace delete test_ns_1::test_ns_2] \
224         [namespace children test_ns_1]
225} {::test_ns_1::test_ns_2 {} {}}
226test namespace-8.3 {TclTeardownNamespace, delete child namespaces} {
227    catch {namespace delete {*}[namespace children :: test_ns_*]}
228    namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
229    namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
230    list [namespace children test_ns_1] \
231         [namespace delete test_ns_1::test_ns_2] \
232         [namespace children test_ns_1] \
233         [catch {namespace children test_ns_1::test_ns_2} msg] $msg \
234         [info commands test_ns_1::test_ns_2::test_ns_3a::*]
235} {::test_ns_1::test_ns_2 {} {} 1 {namespace "test_ns_1::test_ns_2" not found in "::"} {}}
236test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} {
237    catch {namespace delete {*}[namespace children :: test_ns_*]}
238    namespace eval test_ns_export {
239        namespace export cmd1 cmd2
240        proc cmd1 {args} {return "cmd1: $args"}
241        proc cmd2 {args} {return "cmd2: $args"}
242    }
243    namespace eval test_ns_import {
244        namespace import ::test_ns_export::*
245        proc p {} {return foo}
246    }
247    list [lsort [info commands test_ns_import::*]] \
248         [namespace delete test_ns_export] \
249         [info commands test_ns_import::*]
250} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p]
251test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
252    interp create slave
253    slave eval {trace add execution error leave {namespace delete :: ;#}}
254    catch {slave eval error foo bar baz}
255    interp delete slave
256    set ::errorInfo
257} {bar
258    invoked from within
259"slave eval error foo bar baz"}
260test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
261    interp create slave
262    slave eval {trace add variable errorCode write {namespace delete :: ;#}}
263    catch {slave eval error foo bar baz}
264    interp delete slave
265    set ::errorInfo
266} {bar
267    invoked from within
268"slave eval error foo bar baz"}
269test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
270    interp create slave
271    slave eval {trace add execution error leave {namespace delete :: ;#}}
272    catch {slave eval error foo bar baz}
273    interp delete slave
274    set ::errorCode
275} baz
276
277test namespace-9.1 {Tcl_Import, empty import pattern} {
278    catch {namespace delete {*}[namespace children :: test_ns_*]}
279    list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg
280} {1 {empty import pattern}}
281test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} {
282    list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg
283} {1 {unknown namespace in import pattern "fred::x"}}
284test namespace-9.3 {Tcl_Import, import ns == export ns} {
285    list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg
286} {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}}
287test namespace-9.4 {Tcl_Import, simple import} {
288    catch {namespace delete {*}[namespace children :: test_ns_*]}
289    namespace eval test_ns_export {
290        namespace export cmd1
291        proc cmd1 {args} {return "cmd1: $args"}
292        proc cmd2 {args} {return "cmd2: $args"}
293    }
294    namespace eval test_ns_import {
295        namespace import ::test_ns_export::*
296        proc p {} {return [cmd1 123]}
297    }
298    test_ns_import::p
299} {cmd1: 123}
300test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} {
301    list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
302} {0 {}}
303test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
304    namespace eval test_ns_import {
305        namespace import -force ::test_ns_export::*
306        cmd1 555
307    }
308} {cmd1: 555}
309test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
310    catch {namespace delete {*}[namespace children :: test_ns_*]}
311    namespace eval test_ns_export {
312        namespace export cmd1
313        proc cmd1 {args} {return "cmd1: $args"}
314    }
315    namespace eval test_ns_import {
316        namespace import -force ::test_ns_export::*
317    }
318    list [test_ns_import::cmd1 a b c] \
319         [test_ns_export::cmd1 d e f] \
320         [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \
321         [namespace origin test_ns_import::cmd1] \
322         [namespace origin test_ns_export::cmd1] \
323         [test_ns_import::cmd1 g h i] \
324         [test_ns_export::cmd1 j k l]
325} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}
326
327test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
328    namespace eval one {
329        namespace export cmd
330        proc cmd {} {}
331    }
332    namespace eval two {
333        namespace export cmd
334        proc other args {}
335    }
336    namespace eval two \
337            [list namespace import [namespace current]::one::cmd]
338    namespace eval three \
339            [list namespace import [namespace current]::two::cmd]
340    namespace eval three {
341        rename cmd other
342        namespace export other
343    }
344} -body {
345    namespace eval two [list namespace import -force \
346            [namespace current]::three::other]
347    namespace origin two::other
348} -cleanup {
349    namespace delete one two three
350} -match glob -result *::one::cmd
351
352test namespace-9.9 {Tcl_Import: Bug 1017299} -setup {
353    namespace eval one {
354        namespace export cmd
355        proc cmd {} {}
356    }
357    namespace eval two namespace export cmd
358    namespace eval two \
359            [list namespace import [namespace current]::one::cmd]
360    namespace eval three namespace export cmd
361    namespace eval three \
362            [list namespace import [namespace current]::two::cmd]
363} -body {
364    namespace eval two [list namespace import -force \
365            [namespace current]::three::cmd]
366    namespace origin two::cmd
367} -cleanup {
368    namespace delete one two three
369} -returnCodes error -match glob -result {import pattern * would create a loop*}
370
371test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} {
372    catch {namespace delete {*}[namespace children :: test_ns_*]}
373    list [catch {namespace forget xyzzy::*} msg] $msg
374} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
375test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
376    namespace eval test_ns_export {
377        namespace export cmd1
378        proc cmd1 {args} {return "cmd1: $args"}
379        proc cmd2 {args} {return "cmd2: $args"}
380    }
381    namespace eval test_ns_import {
382        namespace forget ::test_ns_export::wombat
383    }
384} {}
385test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
386    namespace eval test_ns_import {
387        namespace import ::test_ns_export::*
388        proc p {} {return [cmd1 123]}
389        set l {}
390        lappend l [lsort [info commands ::test_ns_import::*]]
391        namespace forget ::test_ns_export::cmd1
392        lappend l [info commands ::test_ns_import::*]
393        lappend l [catch {cmd1 777} msg] $msg
394    }
395} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]
396
397test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
398    namespace eval origin {
399        namespace export cmd
400        proc cmd {} {}
401    }
402    namespace eval unrelated {
403        proc cmd {} {}
404    }
405    namespace eval my \
406            [list namespace import [namespace current]::origin::cmd]
407} -body {
408    namespace eval my \
409            [list namespace forget [namespace current]::unrelated::cmd]
410    my::cmd
411} -cleanup {
412    namespace delete origin unrelated my
413}
414
415test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
416    namespace eval origin {
417        namespace export cmd
418        proc cmd {} {}
419    }
420    namespace eval my \
421            [list namespace import [namespace current]::origin::cmd]
422    namespace eval my rename cmd newname
423} -body {
424    namespace eval my \
425            [list namespace forget [namespace current]::origin::cmd]
426    my::newname
427} -cleanup {
428    namespace delete origin my
429} -returnCodes error -match glob -result *
430
431test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
432    namespace eval origin {
433        namespace export cmd
434        proc cmd {} {}
435    }
436    namespace eval my \
437            [list namespace import [namespace current]::origin::cmd]
438    namespace eval your {}
439    namespace eval my \
440            [list rename cmd [namespace current]::your::newname]
441} -body {
442    namespace eval your namespace forget newname
443    your::newname
444} -cleanup {
445    namespace delete origin my your
446} -returnCodes error -match glob -result *
447
448test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
449    namespace eval origin {
450        namespace export cmd
451        proc cmd {} {}
452    }
453    namespace eval link namespace export cmd
454    namespace eval link \
455            [list namespace import [namespace current]::origin::cmd]
456    namespace eval link2 namespace export cmd
457    namespace eval link2 \
458            [list namespace import [namespace current]::link::cmd]
459    namespace eval my \
460            [list namespace import [namespace current]::link2::cmd]
461} -body {
462    namespace eval my \
463            [list namespace forget [namespace current]::origin::cmd]
464    my::cmd
465} -cleanup {
466    namespace delete origin link link2 my
467} -returnCodes error -match glob -result *
468
469test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
470    namespace eval origin {
471        namespace export cmd
472        proc cmd {} {}
473    }
474    namespace eval link namespace export cmd
475    namespace eval link \
476            [list namespace import [namespace current]::origin::cmd]
477    namespace eval link2 namespace export cmd
478    namespace eval link2 \
479            [list namespace import [namespace current]::link::cmd]
480    namespace eval my \
481            [list namespace import [namespace current]::link2::cmd]
482} -body {
483    namespace eval my \
484            [list namespace forget [namespace current]::link::cmd]
485    my::cmd
486} -cleanup {
487    namespace delete origin link link2 my
488}
489
490test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
491    namespace eval origin {
492        namespace export cmd
493        proc cmd {} {}
494    }
495    namespace eval link namespace export cmd
496    namespace eval link \
497            [list namespace import [namespace current]::origin::cmd]
498    namespace eval link2 namespace export cmd
499    namespace eval link2 \
500            [list namespace import [namespace current]::link::cmd]
501    namespace eval my \
502            [list namespace import [namespace current]::link2::cmd]
503} -body {
504    namespace eval my \
505            [list namespace forget [namespace current]::link2::cmd]
506    my::cmd
507} -cleanup {
508    namespace delete origin link link2 my
509} -returnCodes error -match glob -result *
510
511test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
512    catch {namespace delete {*}[namespace children :: test_ns_*]}
513    namespace eval test_ns_export {
514        namespace export cmd1
515        proc cmd1 {args} {return "cmd1: $args"}
516    }
517    list [namespace origin set] [namespace origin test_ns_export::cmd1]
518} {::set ::test_ns_export::cmd1}
519test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {
520    namespace eval test_ns_import1 {
521        namespace import ::test_ns_export::*
522        namespace export *
523        proc p {} {namespace origin cmd1}
524    }
525    list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
526} {::test_ns_export::cmd1 ::test_ns_export::cmd1}
527test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
528    namespace eval test_ns_import2 {
529        namespace import ::test_ns_import1::*
530        proc q {} {return [cmd1 123]}
531    }
532    list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
533} {{cmd1: 123} ::test_ns_export::cmd1}
534
535test namespace-12.1 {InvokeImportedCmd} {
536    catch {namespace delete {*}[namespace children :: test_ns_*]}
537    namespace eval test_ns_export {
538        namespace export cmd1
539        proc cmd1 {args} {namespace current}
540    }
541    namespace eval test_ns_import {
542        namespace import ::test_ns_export::*
543    }
544    list [test_ns_import::cmd1]
545} {::test_ns_export}
546
547test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
548    namespace eval test_ns_import {
549        set l {}
550        lappend l [info commands ::test_ns_import::*]
551        namespace forget ::test_ns_export::cmd1
552        lappend l [info commands ::test_ns_import::*]
553    }
554} {::test_ns_import::cmd1 {}}
555
556test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
557    catch {namespace delete {*}[namespace children :: test_ns_*]}
558    variable v 10
559    namespace eval test_ns_1::test_ns_2 {
560        variable v 20
561    }
562    namespace eval test_ns_2 {
563        variable v 30
564    }
565    namespace eval test_ns_1 {
566        list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
567                [lsort [namespace children :: test_ns_*]]
568    }
569} [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
570test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
571    namespace eval test_ns_1 {
572        list [catch {set ::test_ns_777::v} msg] $msg \
573             [catch {namespace children test_ns_777} msg] $msg
574    }
575} {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
576test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
577    namespace eval test_ns_1 {
578        list $v $test_ns_2::v
579    }
580} {10 20}
581test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
582    namespace eval test_ns_1::test_ns_2 {
583        namespace eval foo {}
584    }
585    namespace eval test_ns_1 {
586        list [namespace children test_ns_2] \
587             [catch {namespace children test_ns_1} msg] $msg
588    }
589} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
590test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
591    namespace eval ::test_ns_2 {
592        namespace eval bar {}
593    }
594    namespace eval test_ns_1 {
595        set l [list [catch {namespace delete test_ns_2::bar} msg] $msg]
596    }
597    set l
598} {1 {unknown namespace "test_ns_2::bar" in namespace delete command}}
599test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
600    namespace eval test_ns_1::test_ns_2 {
601        namespace eval foo {}
602    }
603    namespace eval test_ns_1 {
604        list [namespace children test_ns_2] \
605             [catch {namespace children test_ns_1} msg] $msg
606    }
607} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
608test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
609    namespace children test_ns_1:::
610} {::test_ns_1::test_ns_2}
611test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
612    namespace children :::test_ns_1:::::test_ns_2:::
613} {::test_ns_1::test_ns_2::foo}
614test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
615    set l {}
616    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
617    namespace eval test_ns_1::test_ns_2 {variable {} 2525}
618    lappend l [set test_ns_1::test_ns_2::]
619} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
620test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
621    catch {unset test_ns_1::test_ns_2::}
622    set l {}
623    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
624    set test_ns_1::test_ns_2:: 314159
625    lappend l [set test_ns_1::test_ns_2::]
626} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
627test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {
628    catch {rename test_ns_1::test_ns_2:: {}}
629    set l {}
630    lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
631    proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
632    lappend l [test_ns_1::test_ns_2:: hello]
633} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
634test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
635    catch {namespace delete {*}[namespace children :: test_ns_*]}
636    namespace eval test_ns_1 {
637        variable {}
638        set test_ns_1::(x) y
639    }
640    set test_ns_1::(x)
641} y
642test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
643    catch {namespace delete {*}[namespace children :: test_ns_*]}
644    list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
645} {1 {can't create namespace "": only global namespace can have empty name}}
646
647test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
648    catch {namespace delete {*}[namespace children :: test_ns_*]}
649    namespace eval test_ns_delete {
650        namespace eval test_ns_delete2 {}
651        proc cmd {args} {namespace current}
652    }
653    list [namespace delete ::test_ns_delete::test_ns_delete2] \
654         [namespace children ::test_ns_delete]
655} {{} {}}
656test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
657    list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
658} {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
659test namespace-15.3 {Tcl_FindNamespace, relative name found} {
660    namespace eval test_ns_delete {
661        namespace eval test_ns_delete2 {}
662        namespace eval test_ns_delete3 {}
663        list [namespace delete test_ns_delete2] \
664             [namespace children [namespace current]]
665    }
666} {{} ::test_ns_delete::test_ns_delete3}
667test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
668    namespace eval test_ns_delete2 {}
669    namespace eval test_ns_delete {
670        list [catch {namespace delete test_ns_delete2} msg] $msg
671    }
672} {1 {unknown namespace "test_ns_delete2" in namespace delete command}}
673
674test namespace-16.1 {Tcl_FindCommand, absolute name found} {
675    catch {namespace delete {*}[namespace children :: test_ns_*]}
676    namespace eval test_ns_1 {
677        proc cmd {args} {return "[namespace current]::cmd: $args"}
678        variable v "::test_ns_1::cmd"
679        eval $v one
680    }
681} {::test_ns_1::cmd: one}
682test namespace-16.2 {Tcl_FindCommand, absolute name found} {
683    eval $test_ns_1::v two
684} {::test_ns_1::cmd: two}
685test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
686    namespace eval test_ns_1 {
687        variable v2 "::test_ns_1::ladidah"
688        list [catch {eval $v2} msg] $msg
689    }
690} {1 {invalid command name "::test_ns_1::ladidah"}}
691
692# save the "unknown" proc, which is redefined by the following two tests
693catch {rename unknown unknown.old}
694proc unknown {args} {
695    return "unknown: $args"
696}
697test namespace-16.4 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
698    ::test_ns_1::foobar x y z
699} {unknown: ::test_ns_1::foobar x y z}
700test namespace-16.5 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
701    ::foobar 1 2 3 4 5
702} {unknown: ::foobar 1 2 3 4 5}
703test namespace-16.6 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
704    test_ns_1::foobar x y z
705} {unknown: test_ns_1::foobar x y z}
706test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
707    foobar 1 2 3 4 5
708} {unknown: foobar 1 2 3 4 5}
709# restore the "unknown" proc saved previously
710catch {rename unknown {}}
711catch {rename unknown.old unknown}
712
713test namespace-16.8 {Tcl_FindCommand, relative name found} {
714    namespace eval test_ns_1 {
715        cmd a b c
716    }
717} {::test_ns_1::cmd: a b c}
718test namespace-16.9 {Tcl_FindCommand, relative name found} {
719    catch {rename cmd2 {}}
720    proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
721    namespace eval test_ns_1 {
722       cmd2 a b c
723    }
724} {::::cmd2: a b c}
725test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} {
726    namespace eval test_ns_1 {
727        proc cmd2 {args} {
728            return "[namespace current]::cmd2 in test_ns_1: $args"
729        }
730        namespace eval test_ns_12 {
731            cmd2 a b c
732        }
733    }
734} {::::cmd2: a b c}
735test namespace-16.11 {Tcl_FindCommand, relative name not found} {
736    namespace eval test_ns_1 {
737       list [catch {cmd3 a b c} msg] $msg
738    }
739} {1 {invalid command name "cmd3"}}
740
741catch {unset x}
742test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
743    catch {namespace delete {*}[namespace children :: test_ns_*]}
744    set x 314159
745    namespace eval test_ns_1 {
746        set ::x
747    }
748} {314159}
749test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
750    namespace eval test_ns_1 {
751        variable x 777
752        set ::test_ns_1::x
753    }
754} {777}
755test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
756    namespace eval test_ns_1 {
757        namespace eval test_ns_2 {
758            variable x 1111
759        }
760        set ::test_ns_1::test_ns_2::x
761    }
762} {1111}
763test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
764    namespace eval test_ns_1 {
765        namespace eval test_ns_2 {
766            variable x 1111
767        }
768        list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
769    }
770} {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
771test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {
772    namespace eval test_ns_1 {
773        namespace eval test_ns_3 {
774            variable ::test_ns_1::test_ns_2::x 2222
775        }
776    }
777    set ::test_ns_1::test_ns_2::x
778} {2222}
779test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {
780    namespace eval test_ns_1 {
781        set x
782    }
783} {777}
784test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
785    namespace eval test_ns_1 {
786        unset x
787        set x  ;# must be global x now
788    }
789} {314159}
790test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
791    namespace eval test_ns_1 {
792        list [catch {set wuzzat} msg] $msg
793    }
794} {1 {can't read "wuzzat": no such variable}}
795test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
796    namespace eval test_ns_1 {
797        variable a hello
798    }
799    set test_ns_1::a
800} {hello}
801test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} {
802    namespace eval test_ns_1 {}
803    proc test_ns {} {
804        set ::test_ns_1::a 0
805    }
806    test_ns
807    rename test_ns {}
808    namespace eval test_ns_1 unset a
809    set a 0
810    namespace eval test_ns_1 set a 1
811    namespace delete test_ns_1
812    set a
813} 1
814catch {unset a}
815catch {unset x}
816
817catch {unset l}
818catch {rename foo {}}
819test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
820    catch {namespace delete {*}[namespace children :: test_ns_*]}
821    proc foo {} {return "global foo"}
822    namespace eval test_ns_1 {
823        proc trigger {} {
824            return [foo]
825        }
826    }
827    set l ""
828    lappend l [test_ns_1::trigger]
829    namespace eval test_ns_1 {
830        # force invalidation of cached ref to "foo" in proc trigger
831        proc foo {} {return "foo in test_ns_1"}
832    }
833    lappend l [test_ns_1::trigger]
834    set l
835} {{global foo} {foo in test_ns_1}}
836test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
837    namespace eval test_ns_2 {
838        proc foo {} {return "foo in ::test_ns_2"}
839    }
840    namespace eval test_ns_1 {
841        namespace eval test_ns_2 {}
842        proc trigger {} {
843            return [test_ns_2::foo]
844        }
845    }
846    set l ""
847    lappend l [test_ns_1::trigger]
848    namespace eval test_ns_1 {
849        namespace eval test_ns_2 {
850            # force invalidation of cached ref to "foo" in proc trigger
851            proc foo {} {return "foo in ::test_ns_1::test_ns_2"}
852        }
853    }
854    lappend l [test_ns_1::trigger]
855    set l
856} {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
857catch {unset l}
858catch {rename foo {}}
859
860test namespace-19.1 {GetNamespaceFromObj, global name found} {
861    catch {namespace delete {*}[namespace children :: test_ns_*]}
862    namespace eval test_ns_1::test_ns_2 {}
863    namespace children ::test_ns_1
864} {::test_ns_1::test_ns_2}
865test namespace-19.2 {GetNamespaceFromObj, relative name found} {
866    namespace eval test_ns_1 {
867        namespace children test_ns_2
868    }
869} {}
870test namespace-19.3 {GetNamespaceFromObj, name not found} -body {
871    namespace eval test_ns_1 {
872        namespace children test_ns_99
873    }
874} -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"}
875test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
876    namespace eval test_ns_1 {
877        proc foo {} {
878            return [namespace children test_ns_2]
879        }
880        list [catch {namespace children test_ns_99} msg] $msg
881    }
882    set l {}
883    lappend l [test_ns_1::foo]
884    namespace delete test_ns_1::test_ns_2
885    namespace eval test_ns_1::test_ns_2::test_ns_3 {}
886    lappend l [test_ns_1::foo]
887    set l
888} {{} ::test_ns_1::test_ns_2::test_ns_3}
889
890test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
891    catch {namespace delete {*}[namespace children :: test_ns_*]}
892    list [catch {namespace} msg] $msg
893} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
894test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body {
895    namespace wombat {}
896} -returnCodes error -match glob -result {bad option "wombat": must be *}
897test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
898    namespace ch :: test_ns_*
899} {}
900
901test namespace-21.1 {NamespaceChildrenCmd, no args} {
902    catch {namespace delete {*}[namespace children :: test_ns_*]}
903    namespace eval test_ns_1::test_ns_2 {}
904    expr {[string first ::test_ns_1 [namespace children]] != -1}
905} {1}
906test namespace-21.2 {NamespaceChildrenCmd, no args} {
907    namespace eval test_ns_1 {
908        namespace children
909    }
910} {::test_ns_1::test_ns_2}
911test namespace-21.3 {NamespaceChildrenCmd, ns name given} {
912    namespace children ::test_ns_1
913} {::test_ns_1::test_ns_2}
914test namespace-21.4 {NamespaceChildrenCmd, ns name given} {
915    namespace eval test_ns_1 {
916        namespace children test_ns_2
917    }
918} {}
919test namespace-21.5 {NamespaceChildrenCmd, too many args} {
920    namespace eval test_ns_1 {
921        list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
922    }
923} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
924test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
925    namespace eval test_ns_1::test_ns_foo {}
926    namespace children test_ns_1 *f*
927} {::test_ns_1::test_ns_foo}
928test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
929    namespace eval test_ns_1::test_ns_foo {}
930    lsort [namespace children test_ns_1 test*]
931} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
932test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} {
933    namespace eval test_ns_1 {}
934    namespace children [namespace current] \
935            [string trimright [namespace current] :]::test_ns_1
936} [string trimright [namespace current] :]::test_ns_1
937
938test namespace-22.1 {NamespaceCodeCmd, bad args} {
939    catch {namespace delete {*}[namespace children :: test_ns_*]}
940    list [catch {namespace code} msg] $msg \
941         [catch {namespace code xxx yyy} msg] $msg
942} {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}}
943test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} {
944    namespace eval test_ns_1 {
945        proc cmd {} {return "test_ns_1::cmd"}
946    }
947    namespace code {namespace inscope ::test_ns_1 cmd}
948} {namespace inscope ::test_ns_1 cmd}
949test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} {
950    namespace code {namespace     inscope     ::test_ns_1 cmd}
951} {namespace     inscope     ::test_ns_1 cmd}
952test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {
953    namespace code unknown
954} {::namespace inscope :: unknown}
955test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
956    namespace eval test_ns_1 {
957        namespace code cmd
958    }
959} {::namespace inscope ::test_ns_1 cmd}
960test namespace-22.6 {NamespaceCodeCmd, in other namespace} {
961    namespace eval test_ns_1 {
962        variable v 42
963    }
964    namespace eval test_ns_2 {
965        proc namespace args {}
966    }
967    namespace eval test_ns_2 [namespace eval test_ns_1 {
968        namespace code {set v}
969    }]
970} {42}
971
972test namespace-23.1 {NamespaceCurrentCmd, bad args} {
973    catch {namespace delete {*}[namespace children :: test_ns_*]}
974    list [catch {namespace current xxx} msg] $msg \
975         [catch {namespace current xxx yyy} msg] $msg
976} {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}}
977test namespace-23.2 {NamespaceCurrentCmd, at global level} {
978    namespace current
979} {::}
980test namespace-23.3 {NamespaceCurrentCmd, in nested ns} {
981    namespace eval test_ns_1::test_ns_2 {
982        namespace current
983    }
984} {::test_ns_1::test_ns_2}
985
986test namespace-24.1 {NamespaceDeleteCmd, no args} {
987    catch {namespace delete {*}[namespace children :: test_ns_*]}
988    namespace delete
989} {}
990test namespace-24.2 {NamespaceDeleteCmd, one arg} {
991    namespace eval test_ns_1::test_ns_2 {}
992    namespace delete ::test_ns_1
993} {}
994test namespace-24.3 {NamespaceDeleteCmd, two args} {
995    namespace eval test_ns_1::test_ns_2 {}
996    list [namespace delete ::test_ns_1::test_ns_2] [namespace delete ::test_ns_1]
997} {{} {}}
998test namespace-24.4 {NamespaceDeleteCmd, unknown ns} {
999    list [catch {namespace delete ::test_ns_foo} msg] $msg
1000} {1 {unknown namespace "::test_ns_foo" in namespace delete command}}
1001
1002test namespace-25.1 {NamespaceEvalCmd, bad args} {
1003    catch {namespace delete {*}[namespace children :: test_ns_*]}
1004    list [catch {namespace eval} msg] $msg
1005} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
1006test namespace-25.2 {NamespaceEvalCmd, bad args} -body {
1007    namespace test_ns_1
1008} -returnCodes error -match glob -result {bad option "test_ns_1": must be *}
1009catch {unset v}
1010test namespace-25.3 {NamespaceEvalCmd, new namespace} {
1011    set v 123
1012    namespace eval test_ns_1 {
1013        variable v 314159
1014        proc p {} {
1015            variable v
1016            return $v
1017        }
1018    }
1019    test_ns_1::p
1020} {314159}
1021test namespace-25.4 {NamespaceEvalCmd, existing namespace} {
1022    namespace eval test_ns_1 {
1023        proc q {} {return [expr {[p]+1}]}
1024    }
1025    test_ns_1::q
1026} {314160}
1027test namespace-25.5 {NamespaceEvalCmd, multiple args} {
1028    namespace eval test_ns_1 "set" "v"
1029} {314159}
1030test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
1031    list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo
1032} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
1033    while executing
1034"xxxx"
1035    (in namespace eval "::test_ns_1" script line 1)
1036    invoked from within
1037"namespace eval test_ns_1 {xxxx}"}}
1038test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} {
1039    list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $::errorInfo
1040} {1 foo {bar
1041    (in namespace eval "::test_ns_1" script line 1)
1042    invoked from within
1043"namespace eval test_ns_1 {error foo bar baz}"}}
1044test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} {
1045    list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $::errorInfo
1046} {1 foo {bar
1047    (in namespace eval "::test_ns_1" script line 1)
1048    invoked from within
1049"namespace eval test_ns_1 error foo bar baz"}}
1050catch {unset v}
1051test namespace-25.9 {NamespaceEvalCmd, 545325} {
1052    namespace eval test_ns_1 info level 0
1053} {namespace eval test_ns_1 info level 0}
1054
1055test namespace-26.1 {NamespaceExportCmd, no args and new ns} {
1056    catch {namespace delete {*}[namespace children :: test_ns_*]}
1057    namespace export
1058} {}
1059test namespace-26.2 {NamespaceExportCmd, just -clear arg} {
1060    namespace export -clear
1061} {}
1062test namespace-26.3 {NamespaceExportCmd, pattern can't specify a namespace} {
1063    namespace eval test_ns_1 {
1064        list [catch {namespace export ::zzz} msg] $msg
1065    }
1066} {1 {invalid export pattern "::zzz": pattern can't specify a namespace}}
1067test namespace-26.4 {NamespaceExportCmd, one pattern} {
1068    namespace eval test_ns_1 {
1069        namespace export cmd1
1070        proc cmd1 {args} {return "cmd1: $args"}
1071        proc cmd2 {args} {return "cmd2: $args"}
1072        proc cmd3 {args} {return "cmd3: $args"}
1073        proc cmd4 {args} {return "cmd4: $args"}
1074    }
1075    namespace eval test_ns_2 {
1076        namespace import ::test_ns_1::*
1077    }
1078    list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
1079} {::test_ns_2::cmd1 {cmd1: hello}}
1080test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {
1081    namespace eval test_ns_1 {
1082        namespace export cmd1 cmd3
1083    }
1084    namespace eval test_ns_2 {
1085        namespace import -force ::test_ns_1::*
1086    }
1087    list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello]
1088} [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}]
1089test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} {
1090    namespace eval test_ns_1 {
1091        namespace export
1092    }
1093} {cmd1 cmd3}
1094test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
1095    namespace eval test_ns_1 {
1096        namespace export -clear cmd4
1097    }
1098    namespace eval test_ns_2 {
1099        namespace import ::test_ns_1::*
1100    }
1101    list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
1102} [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
1103
1104test namespace-27.1 {NamespaceForgetCmd, no args} {
1105    catch {namespace delete {*}[namespace children :: test_ns_*]}
1106    namespace forget
1107} {}
1108test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} {
1109    list [catch {namespace forget ::test_ns_1::xxx} msg] $msg
1110} {1 {unknown namespace in namespace forget pattern "::test_ns_1::xxx"}}
1111test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} {
1112    namespace eval test_ns_1 {
1113        namespace export cmd*
1114        proc cmd1 {args} {return "cmd1: $args"}
1115        proc cmd2 {args} {return "cmd2: $args"}
1116    }
1117    namespace eval test_ns_2 {
1118        namespace import ::test_ns_1::*
1119        namespace forget ::test_ns_1::cmd1
1120    }
1121    info commands ::test_ns_2::*
1122} {::test_ns_2::cmd2}
1123
1124test namespace-28.1 {NamespaceImportCmd, no args} {
1125    catch {namespace delete {*}[namespace children :: test_ns_*]}
1126    lsort [namespace import]
1127} {bytestring cleanupTests configure customMatch debug errorChannel errorFile getMatchingFiles interpreter limitConstraints loadFile loadScript loadTestedCommands mainThread makeDirectory makeFile match matchDirectories matchFiles normalizeMsg normalizePath outputChannel outputFile preserveCore removeDirectory removeFile restoreState runAllTests saveState singleProcess skip skipDirectories skipFiles temporaryDirectory test testConstraint testsDirectory threadReap verbose viewFile workingDirectory}
1128test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} {
1129    namespace import -force
1130} {}
1131test namespace-28.3 {NamespaceImportCmd, arg is imported} {
1132    namespace eval test_ns_1 {
1133        namespace export cmd2
1134        proc cmd1 {args} {return "cmd1: $args"}
1135        proc cmd2 {args} {return "cmd2: $args"}
1136    }
1137    namespace eval test_ns_2 {
1138        namespace import ::test_ns_1::*
1139        namespace forget ::test_ns_1::cmd1
1140    }
1141    info commands test_ns_2::*
1142} {::test_ns_2::cmd2}
1143
1144test namespace-29.1 {NamespaceInscopeCmd, bad args} {
1145    catch {namespace delete {*}[namespace children :: test_ns_*]}
1146    list [catch {namespace inscope} msg] $msg
1147} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
1148test namespace-29.2 {NamespaceInscopeCmd, bad args} {
1149    list [catch {namespace inscope ::} msg] $msg
1150} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
1151test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} -body {
1152    namespace inscope test_ns_1 {set v}
1153} -returnCodes error -result {namespace "test_ns_1" not found in "::"}
1154test namespace-29.4 {NamespaceInscopeCmd, simple case} {
1155    namespace eval test_ns_1 {
1156        variable v 747
1157        proc cmd {args} {
1158            variable v
1159            return "[namespace current]::cmd: v=$v, args=$args"
1160        }
1161    }
1162    namespace inscope test_ns_1 cmd
1163} {::test_ns_1::cmd: v=747, args=}
1164test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
1165    list [namespace inscope test_ns_1 cmd x y z] \
1166         [namespace eval test_ns_1 [concat cmd [list x y z]]]
1167} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
1168test namespace-29.6 {NamespaceInscopeCmd, 1400572} {
1169    namespace inscope test_ns_1 {info level 0}
1170} {namespace inscope test_ns_1 {info level 0}}
1171
1172
1173test namespace-30.1 {NamespaceOriginCmd, bad args} {
1174    catch {namespace delete {*}[namespace children :: test_ns_*]}
1175    list [catch {namespace origin} msg] $msg
1176} {1 {wrong # args: should be "namespace origin name"}}
1177test namespace-30.2 {NamespaceOriginCmd, bad args} {
1178    list [catch {namespace origin x y} msg] $msg
1179} {1 {wrong # args: should be "namespace origin name"}}
1180test namespace-30.3 {NamespaceOriginCmd, command not found} {
1181    list [catch {namespace origin fred} msg] $msg
1182} {1 {invalid command name "fred"}}
1183test namespace-30.4 {NamespaceOriginCmd, command isn't imported} {
1184    namespace origin set
1185} {::set}
1186test namespace-30.5 {NamespaceOriginCmd, imported command} {
1187    namespace eval test_ns_1 {
1188        namespace export cmd*
1189        proc cmd1 {args} {return "cmd1: $args"}
1190        proc cmd2 {args} {return "cmd2: $args"}
1191    }
1192    namespace eval test_ns_2 {
1193        namespace export *
1194        namespace import ::test_ns_1::*
1195        proc p {} {}
1196    }
1197    namespace eval test_ns_3 {
1198        namespace import ::test_ns_2::*
1199        list [namespace origin foreach] \
1200             [namespace origin p] \
1201             [namespace origin cmd1] \
1202             [namespace origin ::test_ns_2::cmd2]
1203    }
1204} {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2}
1205
1206test namespace-31.1 {NamespaceParentCmd, bad args} {
1207    catch {namespace delete {*}[namespace children :: test_ns_*]}
1208    list [catch {namespace parent a b} msg] $msg
1209} {1 {wrong # args: should be "namespace parent ?name?"}}
1210test namespace-31.2 {NamespaceParentCmd, no args} {
1211    namespace parent
1212} {}
1213test namespace-31.3 {NamespaceParentCmd, namespace specified} {
1214    namespace eval test_ns_1 {
1215        namespace eval test_ns_2 {
1216            namespace eval test_ns_3 {}
1217        }
1218    }
1219    list [namespace parent ::] \
1220         [namespace parent test_ns_1::test_ns_2] \
1221         [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}]
1222} {{} ::test_ns_1 ::test_ns_1}
1223test namespace-31.4 {NamespaceParentCmd, bad namespace specified} -body {
1224    namespace parent test_ns_1::test_ns_foo
1225} -returnCodes error -result {namespace "test_ns_1::test_ns_foo" not found in "::"}
1226
1227test namespace-32.1 {NamespaceQualifiersCmd, bad args} {
1228    catch {namespace delete {*}[namespace children :: test_ns_*]}
1229    list [catch {namespace qualifiers} msg] $msg
1230} {1 {wrong # args: should be "namespace qualifiers string"}}
1231test namespace-32.2 {NamespaceQualifiersCmd, bad args} {
1232    list [catch {namespace qualifiers x y} msg] $msg
1233} {1 {wrong # args: should be "namespace qualifiers string"}}
1234test namespace-32.3 {NamespaceQualifiersCmd, simple name} {
1235    namespace qualifiers foo
1236} {}
1237test namespace-32.4 {NamespaceQualifiersCmd, leading ::} {
1238    namespace qualifiers ::x::y::z
1239} {::x::y}
1240test namespace-32.5 {NamespaceQualifiersCmd, no leading ::} {
1241    namespace qualifiers a::b
1242} {a}
1243test namespace-32.6 {NamespaceQualifiersCmd, :: argument} {
1244    namespace qualifiers ::
1245} {}
1246test namespace-32.7 {NamespaceQualifiersCmd, odd number of :s} {
1247    namespace qualifiers :::::
1248} {}
1249test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} {
1250    namespace qualifiers foo:::
1251} {foo}
1252
1253test namespace-33.1 {NamespaceTailCmd, bad args} {
1254    catch {namespace delete {*}[namespace children :: test_ns_*]}
1255    list [catch {namespace tail} msg] $msg
1256} {1 {wrong # args: should be "namespace tail string"}}
1257test namespace-33.2 {NamespaceTailCmd, bad args} {
1258    list [catch {namespace tail x y} msg] $msg
1259} {1 {wrong # args: should be "namespace tail string"}}
1260test namespace-33.3 {NamespaceTailCmd, simple name} {
1261    namespace tail foo
1262} {foo}
1263test namespace-33.4 {NamespaceTailCmd, leading ::} {
1264    namespace tail ::x::y::z
1265} {z}
1266test namespace-33.5 {NamespaceTailCmd, no leading ::} {
1267    namespace tail a::b
1268} {b}
1269test namespace-33.6 {NamespaceTailCmd, :: argument} {
1270    namespace tail ::
1271} {}
1272test namespace-33.7 {NamespaceTailCmd, odd number of :s} {
1273    namespace tail :::::
1274} {}
1275test namespace-33.8 {NamespaceTailCmd, odd number of :s} {
1276    namespace tail foo:::
1277} {}
1278
1279test namespace-34.1 {NamespaceWhichCmd, bad args} {
1280    catch {namespace delete {*}[namespace children :: test_ns_*]}
1281    list [catch {namespace which} msg] $msg
1282} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
1283test namespace-34.2 {NamespaceWhichCmd, bad args} {
1284    list [catch {namespace which -fred x} msg] $msg
1285} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
1286test namespace-34.3 {NamespaceWhichCmd, single arg is always command name} {
1287    namespace which -command
1288} {}
1289test namespace-34.4 {NamespaceWhichCmd, bad args} {
1290    list [catch {namespace which a b} msg] $msg
1291} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
1292test namespace-34.5 {NamespaceWhichCmd, command lookup} {
1293    namespace eval test_ns_1 {
1294        namespace export cmd*
1295        variable v1 111
1296        proc cmd1 {args} {return "cmd1: $args"}
1297        proc cmd2 {args} {return "cmd2: $args"}
1298    }
1299    namespace eval test_ns_2 {
1300        namespace export *
1301        namespace import ::test_ns_1::*
1302        variable v2 222
1303        proc p {} {}
1304    }
1305    namespace eval test_ns_3 {
1306        namespace import ::test_ns_2::*
1307        variable v3 333
1308        list [namespace which -command foreach] \
1309             [namespace which -command p] \
1310             [namespace which -command cmd1] \
1311             [namespace which -command ::test_ns_2::cmd2] \
1312             [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
1313    }
1314} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
1315test namespace-34.6 {NamespaceWhichCmd, -command is default} {
1316    namespace eval test_ns_3 {
1317        list [namespace which foreach] \
1318             [namespace which p] \
1319             [namespace which cmd1] \
1320             [namespace which ::test_ns_2::cmd2]
1321    }
1322} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
1323test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
1324    namespace eval test_ns_3 {
1325        list [namespace which -variable env] \
1326             [namespace which -variable v3] \
1327             [namespace which -variable ::test_ns_2::v2] \
1328             [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
1329    }
1330} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
1331
1332test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
1333    catch {namespace delete {*}[namespace children :: test_ns_*]}
1334    namespace eval test_ns_1 {
1335        proc p {} {
1336            namespace delete [namespace current]
1337            return [namespace current]
1338        }
1339    }
1340    test_ns_1::p
1341} {::test_ns_1}
1342test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
1343    namespace eval test_ns_1 {
1344        proc q {} {
1345            return [namespace current]
1346        }
1347    }
1348    list [test_ns_1::q] \
1349         [namespace delete test_ns_1] \
1350         [catch {test_ns_1::q} msg] $msg
1351} {::test_ns_1 {} 1 {invalid command name "test_ns_1::q"}}
1352
1353catch {unset x}
1354catch {unset y}
1355test namespace-36.1 {DupNsNameInternalRep} {
1356    catch {namespace delete {*}[namespace children :: test_ns_*]}
1357    namespace eval test_ns_1 {}
1358    set x "::test_ns_1"
1359    list [namespace parent $x] [set y $x] [namespace parent $y]
1360} {:: ::test_ns_1 ::}
1361catch {unset x}
1362catch {unset y}
1363
1364test namespace-37.1 {SetNsNameFromAny, ns name found} {
1365    catch {namespace delete {*}[namespace children :: test_ns_*]}
1366    namespace eval test_ns_1::test_ns_2 {}
1367    namespace eval test_ns_1 {
1368        namespace children ::test_ns_1
1369    }
1370} {::test_ns_1::test_ns_2}
1371test namespace-37.2 {SetNsNameFromAny, ns name not found} -body {
1372    namespace eval test_ns_1 {
1373        namespace children ::test_ns_1::test_ns_foo
1374    }
1375} -returnCodes error -result {namespace "::test_ns_1::test_ns_foo" not found}
1376
1377test namespace-38.1 {UpdateStringOfNsName} {
1378    catch {namespace delete {*}[namespace children :: test_ns_*]}
1379    ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name
1380    list [namespace eval {} {namespace current}] \
1381         [namespace eval {} {namespace current}]
1382} {:: ::}
1383
1384test namespace-39.1 {NamespaceExistsCmd} {
1385    catch {namespace delete {*}[namespace children :: test_ns_*]}
1386    namespace eval ::test_ns_z::test_me { variable foo }
1387    list [namespace exists ::] \
1388            [namespace exists ::bogus_namespace] \
1389            [namespace exists ::test_ns_z] \
1390            [namespace exists test_ns_z] \
1391            [namespace exists ::test_ns_z::foo] \
1392            [namespace exists ::test_ns_z::test_me] \
1393            [namespace eval ::test_ns_z { namespace exists ::test_me }] \
1394            [namespace eval ::test_ns_z { namespace exists test_me }] \
1395            [namespace exists :::::test_ns_z]
1396} {1 0 1 1 0 1 0 1 1}
1397test namespace-39.2 {NamespaceExistsCmd error} {
1398    list [catch {namespace exists} msg] $msg
1399} {1 {wrong # args: should be "namespace exists name"}}
1400test namespace-39.3 {NamespaceExistsCmd error} {
1401    list [catch {namespace exists a b} msg] $msg
1402} {1 {wrong # args: should be "namespace exists name"}}
1403
1404test namespace-40.1 {Ignoring namespace proc "unknown"} {
1405    rename unknown _unknown
1406    proc unknown args {return global}
1407    namespace eval ns {proc unknown args {return local}}
1408    set l [list [namespace eval ns aaa bbb] [namespace eval ns aaa]]
1409    rename unknown {}   
1410    rename _unknown unknown
1411    namespace delete ns
1412    set l
1413} {global global}
1414
1415test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
1416    set res {}
1417    namespace eval ns {
1418        set res {}
1419        proc test {} {
1420            set ::g 0
1421        } 
1422        lappend ::res [test]
1423        proc set {a b} {
1424            ::set a [incr b]
1425        }
1426        lappend ::res [test]
1427    }
1428    namespace delete ns
1429    set res
1430} {0 1}
1431
1432test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} {
1433    set res {}
1434    namespace eval ns {}
1435    proc ns::a {i} {
1436        variable b
1437        proc set args {return "New proc is called"}
1438        return [set b $i]
1439    }
1440    ns::a 1
1441    set res [ns::a 2]
1442    namespace delete ns
1443    set res
1444} {New proc is called}
1445
1446test namespace-41.3 {Shadowing byte-compiled commands, Bugs: 231259, 729692} {
1447    set res {}
1448    namespace eval ns {
1449        variable b 0
1450    }
1451
1452    proc ns::a {i} {
1453        variable b
1454        proc set args {return "New proc is called"}
1455        return [set b $i]
1456    }
1457   
1458    set res [list [ns::a 1] $ns::b]
1459    namespace delete ns
1460    set res
1461} {{New proc is called} 0}
1462
1463# Ensembles (TIP#112)
1464
1465test namespace-42.1 {ensembles: basic} {
1466    namespace eval ns {
1467        namespace export x
1468        proc x {} {format 1}
1469        namespace ensemble create
1470    }
1471    list [info command ns] [ns x] [namespace delete ns] [info command ns]
1472} {ns 1 {} {}}
1473test namespace-42.2 {ensembles: basic} {
1474    namespace eval ns {
1475        namespace export x
1476        proc x {} {format 1}
1477        namespace ensemble create
1478    }
1479    rename ns foo
1480    list [info command foo] [foo x] [namespace delete ns] [info command foo]
1481} {foo 1 {} {}}
1482test namespace-42.3 {ensembles: basic} {
1483    namespace eval ns {
1484        namespace export x*
1485        proc x1 {} {format 1}
1486        proc x2 {} {format 2}
1487        namespace ensemble create
1488    }
1489    set result [list [ns x1] [ns x2]]
1490    lappend result [catch {ns x} msg] $msg
1491    rename ns {}
1492    lappend result [info command ns::x1]
1493    namespace delete ns
1494    lappend result [info command ns::x1]
1495} {1 2 1 {unknown or ambiguous subcommand "x": must be x1, or x2} ::ns::x1 {}}
1496test namespace-42.4 {ensembles: basic} {
1497    namespace eval ns {
1498        namespace export y*
1499        proc x1 {} {format 1}
1500        proc x2 {} {format 2}
1501        namespace ensemble create
1502    }
1503    set result [list [catch {ns x} msg] $msg]
1504    namespace delete ns
1505    set result
1506} {1 {unknown subcommand "x": namespace ::ns does not export any commands}}
1507test namespace-42.5 {ensembles: basic} {
1508    namespace eval ns {
1509        namespace export x*
1510        proc x1 {} {format 1}
1511        proc x2 {} {format 2}
1512        proc x3 {} {format 3}
1513        namespace ensemble create
1514    }
1515    set result [list [catch {ns x} msg] $msg]
1516    namespace delete ns
1517    set result
1518} {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}}
1519test namespace-42.6 {ensembles: nested} {
1520    namespace eval ns {
1521        namespace export x*
1522        namespace eval x0 {
1523            proc z {} {format 0}
1524            namespace export z
1525            namespace ensemble create
1526        }
1527        proc x1 {} {format 1}
1528        proc x2 {} {format 2}
1529        proc x3 {} {format 3}
1530        namespace ensemble create
1531    }
1532    set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]]
1533    namespace delete ns
1534    set result
1535} {0 1 2 3}
1536test namespace-42.7 {ensembles: nested} {
1537    namespace eval ns {
1538        namespace export x*
1539        namespace eval x0 {
1540            proc z {} {list [info level] [info level 1]}
1541            namespace export z
1542            namespace ensemble create
1543        }
1544        proc x1 {} {format 1}
1545        proc x2 {} {format 2}
1546        proc x3 {} {format 3}
1547        namespace ensemble create
1548    }
1549    set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]]
1550    namespace delete ns
1551    set result
1552} {{1 ::ns::x0::z} 1 2 3}
1553test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
1554    proc demo args {}
1555    variable target [list [namespace which demo] x]
1556    proc trial args {variable target; string length $target}
1557    trace add execution demo enter [namespace code trial]
1558    namespace ensemble create -command foo -map [list bar $target]
1559} -body {
1560    foo bar
1561} -cleanup {
1562    unset target
1563    rename demo {}
1564    rename trial {}
1565    rename foo {}
1566} -result {}
1567
1568test namespace-43.1 {ensembles: dict-driven} {
1569    namespace eval ns {
1570        namespace export x*
1571        proc x1 {} {format 1}
1572        proc x2 {} {format 2}
1573        namespace ensemble create -map {a x1 b x2}
1574    }
1575    set result [list [catch {ns c} msg] $msg [namespace ensemble exists ns]]
1576    rename ns {}
1577    lappend result [namespace ensemble exists ns]
1578} {1 {unknown or ambiguous subcommand "c": must be a, or b} 1 0}
1579test namespace-43.2 {ensembles: dict-driven} {
1580    namespace eval ns {
1581        namespace export x*
1582        proc x1 {args} {list 1 $args}
1583        proc x2 {args} {list 2 [llength $args]}
1584        namespace ensemble create -map {
1585            a ::ns::x1 b ::ns::x2 c {::ns::x1 .} d {::ns::x2 .}
1586        }
1587    }
1588    set result [list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo]]
1589    namespace delete ns
1590    set result
1591} {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}}
1592set SETUP {
1593    namespace eval ns {
1594        namespace export a b
1595        proc a args {format 1,[llength $args]}
1596        proc b args {format 2,[llength $args]}
1597        proc c args {format 3,[llength $args]}
1598        proc d args {format 4,[llength $args]}
1599        namespace ensemble create -subcommands {b c}
1600    }
1601}
1602test namespace-43.3 {ensembles: list-driven} -setup $SETUP -body {
1603    namespace delete ns
1604} -result {}
1605test namespace-43.4 {ensembles: list-driven} -setup $SETUP -body {
1606    ns a foo bar boo spong wibble
1607} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "a": must be b, or c}
1608test namespace-43.5 {ensembles: list-driven} -setup $SETUP -body {
1609    ns b foo bar boo spong wibble
1610} -cleanup {namespace delete ns} -result 2,5
1611test namespace-43.6 {ensembles: list-driven} -setup $SETUP -body {
1612    ns c foo bar boo spong wibble
1613} -cleanup {namespace delete ns} -result 3,5
1614test namespace-43.7 {ensembles: list-driven} -setup $SETUP -body {
1615    ns d foo bar boo spong wibble
1616} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "d": must be b, or c}
1617set SETUP {
1618    namespace eval ns {
1619        namespace export a b
1620        proc a args {format 1,[llength $args]}
1621        proc b args {format 2,[llength $args]}
1622        proc c args {format 3,[llength $args]}
1623        proc d args {format 4,[llength $args]}
1624        namespace ensemble create -subcommands {b c} -map {c ::ns::d}
1625    }
1626}
1627test namespace-43.8 {ensembles: list-and-map-driven} -setup $SETUP -body {
1628    namespace delete ns
1629} -result {}
1630test namespace-43.9 {ensembles: list-and-map-driven} -setup $SETUP -body {
1631    ns a foo bar boo spong wibble
1632} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "a": must be b, or c}
1633test namespace-43.10 {ensembles: list-and-map-driven} -setup $SETUP -body {
1634    ns b foo bar boo spong wibble
1635} -cleanup {namespace delete ns} -result 2,5
1636test namespace-43.11 {ensembles: list-and-map-driven} -setup $SETUP -body {
1637    ns c foo bar boo spong wibble
1638} -cleanup {namespace delete ns} -result 4,5
1639test namespace-43.12 {ensembles: list-and-map-driven} -setup $SETUP -body {
1640    ns d foo bar boo spong wibble
1641} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "d": must be b, or c}
1642set SETUP {
1643    namespace eval ns {
1644        namespace export *
1645        proc foo args {format bar}
1646        proc spong args {format wibble}
1647        namespace ensemble create -prefixes off
1648    }
1649}
1650test namespace-43.13 {ensembles: turn off prefixes} -setup $SETUP -body {
1651    namespace delete ns
1652} -result {}
1653test namespace-43.14 {ensembles: turn off prefixes} -setup $SETUP -body {
1654    ns fo
1655} -cleanup {namespace delete ns} -returnCodes error -result {unknown subcommand "fo": must be foo, or spong}
1656test namespace-43.15 {ensembles: turn off prefixes} -setup $SETUP -body {
1657    ns foo
1658} -cleanup {namespace delete ns} -result bar
1659test namespace-43.16 {ensembles: turn off prefixes} -setup $SETUP -body {
1660    ns s
1661} -cleanup {namespace delete ns} -returnCodes error -result {unknown subcommand "s": must be foo, or spong}
1662test namespace-43.17 {ensembles: turn off prefixes} -setup $SETUP -body {
1663    ns spong
1664} -cleanup {namespace delete ns} -result wibble
1665
1666test namespace-44.1 {ensemble: errors} {
1667    list [catch {namespace ensemble} msg] $msg
1668} {1 {wrong # args: should be "namespace ensemble subcommand ?arg ...?"}}
1669test namespace-44.2 {ensemble: errors} {
1670    list [catch {namespace ensemble ?} msg] $msg
1671} {1 {bad subcommand "?": must be configure, create, or exists}}
1672test namespace-44.3 {ensemble: errors} {
1673    namespace eval ns {
1674        list [catch {namespace ensemble create -map x} msg] $msg
1675    }
1676} {1 {missing value to go with key}}
1677test namespace-44.4 {ensemble: errors} {
1678    namespace eval ns {
1679        list [catch {namespace ensemble create -map {x {}}} msg] $msg
1680    }
1681} {1 {ensemble subcommand implementations must be non-empty lists}}
1682test namespace-44.5 {ensemble: errors} -setup {
1683    namespace ensemble create -command foobar -subcommands {foobarcget foobarconfigure}
1684} -body {
1685    foobar foobarcon
1686} -cleanup {
1687    rename foobar {}
1688} -returnCodes error -result {invalid command name "::foobarconfigure"}
1689
1690test namespace-45.1 {ensemble: introspection} {
1691    namespace eval ns {
1692        namespace export x
1693        proc x {} {}
1694        namespace ensemble create
1695        set ::result [namespace ensemble configure ::ns]
1696    }
1697    namespace delete ns
1698    set result
1699} {-map {} -namespace ::ns -prefixes 1 -subcommands {} -unknown {}}
1700test namespace-45.2 {ensemble: introspection} {
1701    namespace eval ns {
1702        namespace export x
1703        proc x {} {}
1704        namespace ensemble create -map {A x}
1705        set ::result [namespace ensemble configure ::ns -map]
1706    }
1707    namespace delete ns
1708    set result
1709} {A ::ns::x}
1710
1711test namespace-46.1 {ensemble: modification} {
1712    namespace eval ns {
1713        namespace export x
1714        proc x {} {format 123}
1715
1716        # Ensemble maps A->x
1717        namespace ensemble create -command ns -map {A ::ns::x}
1718        set ::result [list [namespace ensemble configure ns -map] [ns A]]
1719
1720        # Ensemble maps B->x
1721        namespace ensemble configure ns -map {B ::ns::x}
1722        lappend ::result [namespace ensemble configure ns -map] [ns B]
1723
1724        # Ensemble maps x->x
1725        namespace ensemble configure ns -map {}
1726        lappend ::result [namespace ensemble configure ns -map] [ns x]
1727    }
1728    namespace delete ns
1729    set result
1730} {{A ::ns::x} 123 {B ::ns::x} 123 {} 123}
1731test namespace-46.2 {ensemble: ensembles really use current export list} {
1732    namespace eval ns {
1733        namespace export x1
1734        proc x1 {} {format 1}
1735        proc x2 {} {format 1}
1736        namespace ensemble create
1737    }
1738    catch {ns ?} msg; set result [list $msg]
1739    namespace eval ns {namespace export x*}
1740    catch {ns ?} msg; lappend result $msg
1741    rename ns::x1 {}
1742    catch {ns ?} msg; lappend result $msg
1743    namespace delete ns
1744    set result
1745} {{unknown or ambiguous subcommand "?": must be x1} {unknown or ambiguous subcommand "?": must be x1, or x2} {unknown or ambiguous subcommand "?": must be x2}}
1746test namespace-46.3 {ensemble: implementation errors} {
1747    namespace eval ns {
1748        variable count 0
1749        namespace ensemble create -map {
1750            a {::lappend ::result}
1751            b {::incr ::ns::count}
1752        }
1753    }
1754    set result {}
1755    lappend result [catch { ns } msg] $msg
1756    ns a [ns b 10]
1757    catch {rename p {}}
1758    rename ns p
1759    p a [p b 3000]
1760    lappend result $ns::count
1761    namespace delete ns
1762    lappend result [info command p]
1763} {1 {wrong # args: should be "ns subcommand ?argument ...?"} 10 3010 3010 {}}
1764test namespace-46.4 {ensemble: implementation errors} {
1765    namespace eval ns {
1766        namespace ensemble create
1767    }
1768    set result [info command ns]
1769    lappend result [catch {ns ?} msg] $msg
1770    namespace delete ns
1771    set result
1772} {ns 1 {unknown subcommand "?": namespace ::ns does not export any commands}}
1773test namespace-46.5 {ensemble: implementation errors} {
1774    namespace eval ns {
1775        namespace ensemble create -map {makeError ::error}
1776    }
1777    list [catch {ns makeError "an error happened"} msg] $msg $::errorInfo [namespace delete ns]
1778} {1 {an error happened} {an error happened
1779    while executing
1780"ns makeError "an error happened""} {}}
1781test namespace-46.6 {ensemble: implementation renames/deletes itself} {
1782    namespace eval ns {
1783        namespace ensemble create -map {to ::rename}
1784    }
1785    ns to ns foo
1786    foo to foo bar
1787    bar to bar spong
1788    spong to spong {}
1789    namespace delete ns
1790} {}
1791test namespace-46.7 {ensemble: implementation deletes its namespace} {
1792    namespace eval ns {
1793        namespace ensemble create -map {kill {::namespace delete}}
1794    }
1795    ns kill ns
1796} {}
1797test namespace-46.8 {ensemble: implementation deletes its namespace} {
1798    namespace eval ns {
1799        namespace export *
1800        proc foo {} {
1801            variable x 1
1802            bar
1803            # Tricky; what is the correct return value anyway?
1804            info exist x
1805        }
1806        proc bar {} {
1807            namespace delete [namespace current]
1808        }
1809        namespace ensemble create
1810    }
1811    list [ns foo] [info exist ns::x]
1812} {1 0}
1813test namespace-46.9 {ensemble: configuring really configures things} {
1814    namespace eval ns {
1815        namespace ensemble create -map {a a} -prefixes 0
1816    }
1817    set result [list [catch {ns x} msg] $msg]
1818    namespace ensemble configure ns -map {b b}
1819    lappend result [catch {ns x} msg] $msg
1820    namespace delete ns
1821    set result
1822} {1 {unknown subcommand "x": must be a} 1 {unknown subcommand "x": must be b}}
1823
1824test namespace-47.1 {ensemble: unknown handler} {
1825    set log {}
1826    namespace eval ns {
1827        namespace export {[a-z]*}
1828        proc Magic {ensemble subcmd args} {
1829            global log
1830            if {[string match {[a-z]*} $subcmd]} {
1831                lappend log "making $subcmd"
1832                proc $subcmd args {
1833                    global log
1834                    lappend log "running [info level 0]"
1835                    llength $args
1836                }
1837            } else {
1838                lappend log "unknown $subcmd - args = $args"
1839                return -code error \
1840                        "unknown or protected subcommand \"$subcmd\""
1841            }
1842        }
1843        namespace ensemble create -unknown ::ns::Magic
1844    }
1845    set result {}
1846    lappend result [catch {ns a b c} msg] $msg
1847    lappend result [catch {ns a b c} msg] $msg
1848    lappend result [catch {ns b c d} msg] $msg
1849    lappend result [catch {ns c d e} msg] $msg
1850    lappend result [catch {ns Magic foo bar spong wibble} msg] $msg
1851    list $result [lsort [info commands ::ns::*]] $log [namespace delete ns]
1852} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running ::ns::a b c} {running ::ns::a b c} {making b} {running ::ns::b c d} {making c} {running ::ns::c d e} {unknown Magic - args = foo bar spong wibble}} {}}
1853test namespace-47.2 {ensemble: unknown handler} {
1854    namespace eval ns {
1855        namespace export {[a-z]*}
1856        proc Magic {ensemble subcmd args} {
1857            error foobar
1858        }
1859        namespace ensemble create -unknown ::ns::Magic
1860    }
1861    list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns]
1862} {1 foobar {foobar
1863    while executing
1864"error foobar"
1865    (procedure "::ns::Magic" line 2)
1866    invoked from within
1867"::ns::Magic ::ns spong"
1868    (ensemble unknown subcommand handler)
1869    invoked from within
1870"ns spong"} {}}
1871test namespace-47.3 {ensemble: unknown handler} {
1872    namespace eval ns {
1873        variable count 0
1874        namespace export {[a-z]*}
1875        proc a {} {}
1876        proc c {} {}
1877        proc Magic {ensemble subcmd args} {
1878            variable count
1879            incr count
1880            proc b {} {}
1881        }
1882        namespace ensemble create -unknown ::ns::Magic
1883    }
1884    list [catch {ns spong} msg] $msg $ns::count [namespace delete ns]
1885} {1 {unknown or ambiguous subcommand "spong": must be a, b, or c} 1 {}}
1886test namespace-47.4 {ensemble: unknown handler} {
1887    namespace eval ns {
1888        namespace export {[a-z]*}
1889        proc Magic {ensemble subcmd args} {
1890            return -code break
1891        }
1892        namespace ensemble create -unknown ::ns::Magic
1893    }
1894    list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns]
1895} {1 {unknown subcommand handler returned bad code: break} {unknown subcommand handler returned bad code: break
1896    result of ensemble unknown subcommand handler: ::ns::Magic ::ns spong
1897    invoked from within
1898"ns spong"} {}}
1899test namespace-47.5 {ensemble: unknown handler} {
1900    namespace ensemble create -command foo -unknown bar
1901    proc bar {args} {
1902        global result target
1903        lappend result "LOG $args"
1904        return $target
1905    }
1906    set result {}
1907    set target {}
1908    lappend result [catch {foo bar} msg] $msg
1909    set target {lappend result boo hoo}
1910    lappend result [catch {foo bar} msg] $msg [namespace ensemble config foo]
1911    rename foo {}
1912    set result
1913} {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo 0 {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo} {-map {} -namespace :: -prefixes 1 -subcommands {} -unknown bar}}
1914test namespace-47.6 {ensemble: unknown handler} {
1915    namespace ensemble create -command foo -unknown bar
1916    proc bar {args} {
1917        return "\{"
1918    }
1919    set result [list [catch {foo bar} msg] $msg $::errorInfo]
1920    rename foo {}
1921    set result
1922} {1 {unmatched open brace in list} {unmatched open brace in list
1923    while parsing result of ensemble unknown subcommand handler
1924    invoked from within
1925"foo bar"}}
1926test namespace-47.7 {ensemble: unknown handler, commands with spaces} {
1927    namespace ensemble create -command foo -unknown bar
1928    proc bar {args} {
1929        list ::set ::x [join $args |]
1930    }
1931    set result [foo {one two three}]
1932    rename foo {}
1933    set result
1934} {::foo|one two three}
1935test namespace-47.8 {ensemble: unknown handler, commands with spaces} {
1936    namespace ensemble create -command foo -unknown {bar boo}
1937    proc bar {args} {
1938        list ::set ::x [join $args |]
1939    }
1940    set result [foo {one two three}]
1941    rename foo {}
1942    set result
1943} {boo|::foo|one two three}
1944
1945test namespace-48.1 {ensembles and namespace import: unknown handler} {
1946    namespace eval foo {
1947        namespace export bar
1948        namespace ensemble create -command bar -unknown ::foo::u -subcomm x
1949        proc u {ens args} {
1950            global result
1951            lappend result $ens $args
1952            namespace ensemble config $ens -subcommand {x y}
1953        }
1954        proc u2 {ens args} {
1955            global result
1956            lappend result $ens $args
1957            namespace ensemble config ::bar -subcommand {x y z}
1958        }
1959        proc x args {
1960            global result
1961            lappend result XXX $args
1962        }
1963        proc y args {
1964            global result
1965            lappend result YYY $args
1966        }
1967        proc z args {
1968            global result
1969            lappend result ZZZ $args
1970        }
1971    }
1972    namespace import -force foo::bar
1973    set result [list [namespace ensemble config bar]]
1974    bar x 123
1975    bar y 456
1976    namespace ensemble config bar -unknown ::foo::u2
1977    bar z 789
1978    namespace delete foo
1979    set result
1980} {{-map {} -namespace ::foo -prefixes 1 -subcommands x -unknown ::foo::u} XXX 123 ::foo::bar {y 456} YYY 456 ::foo::bar {z 789} ZZZ 789}
1981test namespace-48.2 {ensembles and namespace import: exists} {
1982    namespace eval foo {
1983        namespace ensemble create -command ::foo::bar
1984        namespace export bar
1985    }
1986    set result     [namespace ensemble exist foo::bar]
1987    lappend result [namespace ensemble exist bar]
1988    namespace import foo::bar
1989    lappend result [namespace ensemble exist bar]
1990    rename foo::bar foo::bar2
1991    lappend result [namespace ensemble exist bar] \
1992            [namespace ensemble exist spong]
1993    rename bar spong
1994    lappend result [namespace ensemble exist bar] \
1995            [namespace ensemble exist spong]
1996    rename foo::bar2 {}
1997    lappend result [namespace ensemble exist spong]
1998    namespace delete foo
1999    set result
2000} {1 0 1 1 0 0 1 0}
2001test namespace-48.3 {ensembles and namespace import: config} {
2002    catch {rename spong {}}
2003    namespace eval foo {
2004        namespace ensemble create -command ::foo::bar
2005        namespace export bar boo
2006        proc boo {} {}
2007    }
2008    namespace import foo::bar foo::boo
2009    set result [namespace ensemble config bar -namespace]
2010    lappend result [catch {namespace ensemble config boo} msg] $msg
2011    lappend result [catch {namespace ensemble config spong} msg] $msg
2012    namespace delete foo
2013    set result
2014} {::foo 1 {"boo" is not an ensemble command} 1 {unknown command "spong"}}
2015
2016test namespace-49.1 {ensemble subcommand caching} -body {
2017    namespace ens cre -command a -map {b {lappend result 1}}
2018    namespace ens cre -command c -map {b {lappend result 2}}
2019    proc x {} {a b; c b; a b; c b}
2020    x
2021} -result {1 2 1 2} -cleanup {
2022    rename a {}
2023    rename c {}
2024    rename x {}
2025}
2026test namespace-49.2 {strange delete crash} -body {
2027    namespace eval foo {namespace ensemble create -command ::bar}
2028    trace add command ::bar delete DeleteTrace
2029    proc DeleteTrace {old new op} {
2030        trace remove command ::bar delete DeleteTrace
2031        rename $old ""
2032        # This next line caused a bus error in [Bug 1220058]
2033        namespace delete foo
2034    }
2035    rename ::bar ""
2036} -result "" -cleanup {
2037    rename DeleteTrace ""
2038}
2039
2040test namespace-50.1 {ensembles affect proc arguments error messages} -body {
2041    namespace ens cre -command a -map {b {bb foo}}
2042    proc bb {c d {e f} args} {list $c $args}
2043    a b
2044} -returnCodes error -result "wrong # args: should be \"a b d ?e? ...\"" -cleanup {
2045    rename a {}
2046    rename bb {}
2047}
2048test namespace-50.2 {ensembles affect WrongNumArgs error messages} -body {
2049    namespace ens cre -command a -map {b {string is}}
2050    a b boolean
2051} -returnCodes error -result "wrong # args: should be \"a b class ?-strict? ?-failindex var? str\"" -cleanup {
2052    rename a {}
2053}
2054test namespace-50.3 {chained ensembles affect error messages} -body {
2055    namespace ens cre -command a -map {b c}
2056    namespace ens cre -command c -map {d e}
2057    proc e f {}
2058    a b d
2059} -returnCodes error -result "wrong # args: should be \"a b d f\"" -cleanup {
2060    rename a {}
2061}
2062test namespace-50.4 {chained ensembles affect error messages} -body {
2063    namespace ens cre -command a -map {b {c d}}
2064    namespace ens cre -command c -map {d {e f}}
2065    proc e f {}
2066    a b d
2067} -returnCodes error -result "wrong # args: should be \"a b\"" -cleanup {
2068    rename a {}
2069}
2070
2071test namespace-51.1 {name resolution path control} -body {
2072    namespace eval ::test_ns_1 {
2073        namespace eval test_ns_2 {
2074            proc pathtestA {} {
2075                ::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
2076            }
2077            proc pathtestC {} {
2078                ::return 2
2079            }
2080        }
2081        proc pathtestB {} {
2082            return 1
2083        }
2084        proc pathtestC {} {
2085            return 1
2086        }
2087        namespace path ::test_ns_1
2088    }
2089    proc ::pathtestB {} {
2090        return global
2091    }
2092    proc ::pathtestD {} {
2093        return global
2094    }
2095    test_ns_1::test_ns_2::pathtestA
2096} -result "global,2,global," -cleanup {
2097    namespace delete ::test_ns_1
2098    catch {rename ::pathtestB {}}
2099    catch {rename ::pathtestD {}}
2100}
2101test namespace-51.2 {name resolution path control} -body {
2102    namespace eval ::test_ns_1 {
2103        namespace eval test_ns_2 {
2104            namespace path ::test_ns_1
2105            proc pathtestA {} {
2106                ::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
2107            }
2108            proc pathtestC {} {
2109                ::return 2
2110            }
2111        }
2112        proc pathtestB {} {
2113            return 1
2114        }
2115        proc pathtestC {} {
2116            return 1
2117        }
2118    }
2119    proc ::pathtestB {} {
2120        return global
2121    }
2122    proc ::pathtestD {} {
2123        return global
2124    }
2125    ::test_ns_1::test_ns_2::pathtestA
2126} -result "1,2,global,::test_ns_1" -cleanup {
2127    namespace delete ::test_ns_1
2128    catch {rename ::pathtestB {}}
2129    catch {rename ::pathtestD {}}
2130}
2131test namespace-51.3 {name resolution path control} -body {
2132    namespace eval ::test_ns_1 {
2133        namespace eval test_ns_2 {
2134            proc pathtestA {} {
2135                ::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
2136            }
2137            proc pathtestC {} {
2138                ::return 2
2139            }
2140        }
2141        proc pathtestB {} {
2142            return 1
2143        }
2144        proc pathtestC {} {
2145            return 1
2146        }
2147    }
2148    proc ::pathtestB {} {
2149        return global
2150    }
2151    proc ::pathtestD {} {
2152        return global
2153    }
2154    set result [::test_ns_1::test_ns_2::pathtestA]
2155    namespace eval ::test_ns_1::test_ns_2 {
2156        namespace path ::test_ns_1
2157    }
2158    lappend result [::test_ns_1::test_ns_2::pathtestA]
2159    rename ::test_ns_1::pathtestB {}
2160    lappend result [::test_ns_1::test_ns_2::pathtestA]
2161} -result "global,2,global, 1,2,global,::test_ns_1 global,2,global,::test_ns_1" -cleanup {
2162    namespace delete ::test_ns_1
2163    catch {rename ::pathtestB {}}
2164    catch {rename ::pathtestD {}}
2165}
2166test namespace-51.4 {name resolution path control} -body {
2167    namespace eval ::test_ns_1 {
2168        namespace eval test_ns_2 {
2169            proc pathtestA {} {
2170                ::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
2171            }
2172            proc pathtestC {} {
2173                ::return 2
2174            }
2175        }
2176        proc pathtestB {} {
2177            return 1
2178        }
2179        proc pathtestC {} {
2180            return 1
2181        }
2182    }
2183    proc ::pathtestB {} {
2184        return global
2185    }
2186    proc ::pathtestD {} {
2187        return global
2188    }
2189    set result [::test_ns_1::test_ns_2::pathtestA]
2190    namespace eval ::test_ns_1::test_ns_2 {
2191        namespace path ::test_ns_1
2192    }
2193    lappend result [::test_ns_1::test_ns_2::pathtestA]
2194    namespace eval ::test_ns_1::test_ns_2 {
2195        namespace path {}
2196    }
2197    lappend result [::test_ns_1::test_ns_2::pathtestA]
2198} -result "global,2,global, 1,2,global,::test_ns_1 global,2,global," -cleanup {
2199    namespace delete ::test_ns_1
2200    catch {rename ::pathtestB {}}
2201    catch {rename ::pathtestD {}}
2202}
2203test namespace-51.5 {name resolution path control} -body {
2204    namespace eval ::test_ns_1 {
2205        namespace eval test_ns_2 {
2206            proc pathtestA {} {
2207                ::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
2208            }
2209            proc pathtestC {} {
2210                ::return 2
2211            }
2212            namespace path ::test_ns_1
2213        }
2214        proc pathtestB {} {
2215            return 1
2216        }
2217        proc pathtestC {} {
2218            return 1
2219        }
2220        proc pathtestD {} {
2221            return 1
2222        }
2223    }
2224    proc ::pathtestB {} {
2225        return global
2226    }
2227    proc ::pathtestD {} {
2228        return global
2229    }
2230    set result [::test_ns_1::test_ns_2::pathtestA]
2231    namespace eval ::test_ns_1::test_ns_2 {
2232        namespace path {:: ::test_ns_1}
2233    }
2234    lappend result [::test_ns_1::test_ns_2::pathtestA]
2235    rename ::test_ns_1::test_ns_2::pathtestC {}
2236    lappend result [::test_ns_1::test_ns_2::pathtestA]
2237} -result "1,2,1,::test_ns_1 {global,2,global,:: ::test_ns_1} {global,1,global,:: ::test_ns_1}" -cleanup {
2238    namespace delete ::test_ns_1
2239    catch {rename ::pathtestB {}}
2240    catch {rename ::pathtestD {}}
2241}
2242test namespace-51.6 {name resolution path control} -body {
2243    namespace eval ::test_ns_1 {
2244        namespace eval test_ns_2 {
2245            proc pathtestA {} {
2246                ::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
2247            }
2248            proc pathtestC {} {
2249                ::return 2
2250            }
2251            namespace path ::test_ns_1
2252        }
2253        proc pathtestB {} {
2254            return 1
2255        }
2256        proc pathtestC {} {
2257            return 1
2258        }
2259        proc pathtestD {} {
2260            return 1
2261        }
2262    }
2263    proc ::pathtestB {} {
2264        return global
2265    }
2266    proc ::pathtestD {} {
2267        return global
2268    }
2269    set result [::test_ns_1::test_ns_2::pathtestA]
2270    namespace eval ::test_ns_1::test_ns_2 {
2271        namespace path {:: ::test_ns_1}
2272    }
2273    lappend result [::test_ns_1::test_ns_2::pathtestA]
2274    rename ::test_ns_1::test_ns_2::pathtestC {}
2275    lappend result [::test_ns_1::test_ns_2::pathtestA]
2276    proc ::pathtestC {} {
2277        return global
2278    }
2279    lappend result [::test_ns_1::test_ns_2::pathtestA]
2280} -result "1,2,1,::test_ns_1 {global,2,global,:: ::test_ns_1} {global,1,global,:: ::test_ns_1} {global,global,global,:: ::test_ns_1}" -cleanup {
2281    namespace delete ::test_ns_1
2282    catch {rename ::pathtestB {}}
2283    catch {rename ::pathtestD {}}
2284}
2285test namespace-51.7 {name resolution path control} -body {
2286    namespace eval ::test_ns_1 {
2287    }
2288    namespace eval ::test_ns_2 {
2289        namespace path ::test_ns_1
2290        proc getpath {} {namespace path}
2291    }
2292    list [::test_ns_2::getpath] [namespace delete ::test_ns_1] [::test_ns_2::getpath]
2293} -result {::test_ns_1 {} {}} -cleanup {
2294    catch {namespace delete ::test_ns_1}
2295    namespace delete ::test_ns_2
2296}
2297test namespace-51.8 {name resolution path control} -body {
2298    namespace eval ::test_ns_1 {
2299    }
2300    namespace eval ::test_ns_2 {
2301    }
2302    namespace eval ::test_ns_3 {
2303    }
2304    namespace eval ::test_ns_4 {
2305        namespace path {::test_ns_1 ::test_ns_2 ::test_ns_3}
2306        proc getpath {} {namespace path}
2307    }
2308    list [::test_ns_4::getpath] [namespace delete ::test_ns_2] [::test_ns_4::getpath]
2309} -result {{::test_ns_1 ::test_ns_2 ::test_ns_3} {} {::test_ns_1 ::test_ns_3}} -cleanup {
2310    catch {namespace delete ::test_ns_1}
2311    catch {namespace delete ::test_ns_2}
2312    catch {namespace delete ::test_ns_3}
2313    catch {namespace delete ::test_ns_4}
2314}
2315test namespace-51.9 {name resolution path control} -body {
2316    namespace eval ::test_ns_1 {
2317    }
2318    namespace eval ::test_ns_2 {
2319    }
2320    namespace eval ::test_ns_3 {
2321    }
2322    namespace eval ::test_ns_4 {
2323        namespace path {::test_ns_1 ::test_ns_2 ::test_ns_3}
2324        proc getpath {} {namespace path}
2325    }
2326    list [::test_ns_4::getpath] [namespace delete ::test_ns_2] [namespace eval ::test_ns_2 {}] [::test_ns_4::getpath]
2327} -result {{::test_ns_1 ::test_ns_2 ::test_ns_3} {} {} {::test_ns_1 ::test_ns_3}} -cleanup {
2328    catch {namespace delete ::test_ns_1}
2329    catch {namespace delete ::test_ns_2}
2330    catch {namespace delete ::test_ns_3}
2331    catch {namespace delete ::test_ns_4}
2332}
2333test namespace-51.10 {name resolution path control} -body {
2334    namespace eval ::test_ns_1 {
2335        namespace path does::not::exist
2336    }
2337} -returnCodes error -result {namespace "does::not::exist" not found in "::test_ns_1"} -cleanup {
2338    catch {namespace delete ::test_ns_1}
2339}
2340test namespace-51.11 {name resolution path control} -body {
2341    namespace eval ::test_ns_1 {
2342        proc foo {} {return 1}
2343    }
2344    namespace eval ::test_ns_2 {
2345        proc foo {} {return 2}
2346    }
2347    namespace eval ::test_ns_3 {
2348        namespace path ::test_ns_1
2349    }
2350    namespace eval ::test_ns_4 {
2351        namespace path {::test_ns_3 ::test_ns_2}
2352        foo
2353    }
2354} -result 2 -cleanup {
2355    catch {namespace delete ::test_ns_1}
2356    catch {namespace delete ::test_ns_2}
2357    catch {namespace delete ::test_ns_3}
2358    catch {namespace delete ::test_ns_4}
2359}
2360test namespace-51.12 {name resolution path control} -body {
2361    namespace eval ::test_ns_1 {
2362        proc foo {} {return 1}
2363    }
2364    namespace eval ::test_ns_2 {
2365        proc foo {} {return 2}
2366    }
2367    namespace eval ::test_ns_3 {
2368        namespace path ::test_ns_1
2369    }
2370    namespace eval ::test_ns_4 {
2371        namespace path {::test_ns_3 ::test_ns_2}
2372        list [foo] [namespace delete ::test_ns_3] [foo]
2373    }
2374} -result {2 {} 2} -cleanup {
2375    catch {namespace delete ::test_ns_1}
2376    catch {namespace delete ::test_ns_2}
2377    catch {namespace delete ::test_ns_3}
2378    catch {namespace delete ::test_ns_4}
2379}
2380
2381test namespace-51.13 {name resolution path control} -body {
2382    set ::result {}
2383    namespace eval ::test_ns_1 {
2384        proc foo {} {lappend ::result 1}
2385    }
2386    namespace eval ::test_ns_2 {
2387        proc foo {} {lappend ::result 2}
2388        trace add command foo delete {namespace eval ::test_ns_3 foo;#}
2389    }
2390    namespace eval ::test_ns_3 {
2391        proc foo {} {
2392            lappend ::result 3
2393            namespace delete [namespace current]
2394            ::test_ns_4::bar
2395        }
2396    }
2397    namespace eval ::test_ns_4 {
2398        namespace path {::test_ns_2 ::test_ns_3 ::test_ns_1}
2399        proc bar {} {
2400            list [foo] [namespace delete ::test_ns_2] [foo]
2401        }
2402        bar
2403    }
2404    # Should the result be "2 {} {2 3 2 1}" instead?
2405} -result {2 {} {2 3 1 1}} -cleanup {
2406    catch {namespace delete ::test_ns_1}
2407    catch {namespace delete ::test_ns_2}
2408    catch {namespace delete ::test_ns_3}
2409    catch {namespace delete ::test_ns_4}
2410}
2411test namespace-51.14 {name resolution path control} -body {
2412    foreach cmd [info commands foo*] {
2413        rename $cmd {}
2414    }
2415    proc foo0 {} {}
2416    namespace eval ::test_ns_1 {
2417        proc foo1 {} {}
2418    }
2419    namespace eval ::test_ns_2 {
2420        proc foo2 {} {}
2421    }
2422    namespace eval ::test_ns_3 {
2423        variable result {}
2424        lappend result [info commands foo*]
2425        namespace path {::test_ns_1 ::test_ns_2}
2426        lappend result [info commands foo*]
2427        proc foo2 {} {}
2428        lappend result [info commands foo*]
2429        rename foo2 {}
2430        lappend result [info commands foo*]
2431        namespace delete ::test_ns_1
2432        lappend result [info commands foo*]
2433    }
2434} -result {foo0 {foo1 foo2 foo0} {foo2 foo1 foo0} {foo1 foo2 foo0} {foo2 foo0}} -cleanup {
2435    catch {namespace delete ::test_ns_1}
2436    catch {namespace delete ::test_ns_2}
2437    catch {namespace delete ::test_ns_3}
2438}
2439test namespace-51.15 {namespace resolution path control} -body {
2440    namespace eval ::test_ns_2 {
2441        proc foo {} {return 2}
2442    }
2443    namespace eval ::test_ns_1 {
2444        namespace eval test_ns_2 {
2445            proc foo {} {return 1_2}
2446        }
2447        namespace eval test_ns_3 {
2448            namespace path ::test_ns_1
2449            test_ns_2::foo
2450        }
2451    }
2452} -result 1_2 -cleanup {
2453    namespace delete ::test_ns_1
2454    namespace delete ::test_ns_2
2455}
2456test namespace-51.16 {Bug 1566526} {
2457    interp create slave
2458    slave eval namespace eval demo namespace path ::
2459    interp delete slave
2460} {}
2461
2462# TIP 181 - namespace unknown tests
2463test namespace-52.1 {unknown: default handler ::unknown} {
2464    set result [list [namespace eval foobar { namespace unknown }]]
2465    lappend result [namespace eval :: { namespace unknown }]
2466    namespace delete foobar
2467    set result
2468} {{} ::unknown}
2469test namespace-52.2 {unknown: default resolution global} {
2470    proc ::foo {} { return "GLOBAL" }
2471    namespace eval ::bar { proc foo {} { return "NAMESPACE" } }
2472    namespace eval ::bar::jim { proc test {} { foo } }
2473    set result [::bar::jim::test]
2474    namespace delete ::bar
2475    rename ::foo {}
2476    set result
2477} {GLOBAL}
2478test namespace-52.3 {unknown: default resolution local} {
2479    proc ::foo {} { return "GLOBAL" }
2480    namespace eval ::bar {
2481        proc foo {} { return "NAMESPACE" }
2482        proc test {} { foo }
2483    }
2484    set result [::bar::test]
2485    namespace delete ::bar
2486    rename ::foo {}
2487    set result
2488} {NAMESPACE}
2489test namespace-52.4 {unknown: set handler} {
2490    namespace eval foo {
2491        namespace unknown [list dispatch]
2492        proc dispatch {args} { return $args }
2493        proc test {} {
2494            UnknownCmd a b c
2495        }
2496    }
2497    set result [foo::test]
2498    namespace delete foo
2499    set result
2500} {UnknownCmd a b c}
2501test namespace-52.5 {unknown: search path before unknown is unaltered} {
2502    proc ::test2 {args} { return "TEST2: $args" }
2503    namespace eval foo {
2504        namespace unknown [list dispatch]
2505        proc dispatch {args} { return "UNKNOWN: $args" }
2506        proc test1 {args} { return "TEST1: $args" }
2507        proc test {} {
2508            set result [list [test1 a b c]]
2509            lappend result [test2 a b c]
2510            lappend result [test3 a b c]
2511            return $result
2512        }
2513    }
2514    set result [foo::test]
2515    namespace delete foo
2516    rename ::test2 {}
2517    set result
2518} {{TEST1: a b c} {TEST2: a b c} {UNKNOWN: test3 a b c}}
2519test namespace-52.6 {unknown: deleting handler restores default} {
2520    rename ::unknown ::_unknown_orig
2521    proc ::unknown {args} { return "DEFAULT: $args" }
2522    namespace eval foo {
2523        namespace unknown dummy
2524        namespace unknown {}
2525    }
2526    set result [namespace eval foo { dummy a b c }]
2527    rename ::unknown {}
2528    rename ::_unknown_orig ::unknown
2529    namespace delete foo
2530    set result
2531} {DEFAULT: dummy a b c}
2532test namespace-52.7 {unknown: setting global unknown handler} {
2533    proc ::myunknown {args} { return "MYUNKNOWN: $args" }
2534    namespace eval :: { namespace unknown ::myunknown }
2535    set result [namespace eval foo { dummy a b c }]
2536    namespace eval :: { namespace unknown {} }
2537    rename ::myunknown {}
2538    namespace delete foo
2539    set result
2540} {MYUNKNOWN: dummy a b c}
2541test namespace-52.8 {unknown: destroying and redefining global namespace} {
2542    set i [interp create]
2543    $i hide proc
2544    $i hide namespace
2545    $i hide return
2546    $i invokehidden namespace delete ::
2547    $i expose return
2548    $i invokehidden proc unknown args { return "FINE" }
2549    $i eval { foo bar bob }
2550} {FINE}
2551test namespace-52.9 {unknown: refcounting} -setup {
2552    proc this args {
2553        unset args              ;# stop sharing
2554        set copy [namespace unknown]
2555        string length $copy     ;# shimmer away list rep
2556        info level 0
2557    }
2558    set handler [namespace unknown]
2559    namespace unknown {this is a test}
2560    catch {rename noSuchCommand {}}
2561} -body {
2562    noSuchCommand
2563} -cleanup {
2564    namespace unknown $handler
2565    rename this {}
2566} -result {this is a test noSuchCommand}
2567testConstraint testevalobjv [llength [info commands testevalobjv]]
2568test namespace-52.10 {unknown: with TCL_EVAL_GLOBAL} -constraints {
2569    testevalobjv
2570} -setup {
2571    rename ::unknown unknown.save
2572    proc ::unknown args {
2573        set caller [uplevel 1 {namespace current}]
2574        namespace eval $caller {
2575            variable foo
2576            return $foo
2577        }
2578    }
2579    catch {rename ::noSuchCommand {}}
2580} -body {
2581    namespace eval :: {
2582        variable foo SUCCESS
2583    }
2584    namespace eval test_ns_1 {
2585        variable foo FAIL
2586        testevalobjv 1 noSuchCommand
2587    }
2588} -cleanup {
2589    unset -nocomplain ::foo
2590    namespace delete test_ns_1
2591    rename ::unknown {}
2592    rename unknown.save ::unknown
2593} -result SUCCESS
2594test namespace-52.11 {unknown: with TCL_EVAL_INVOKE} -setup {
2595    set handler [namespace eval :: {namespace unknown}]
2596    namespace eval :: {namespace unknown unknown}
2597    rename ::unknown unknown.save
2598    namespace eval :: {
2599        proc unknown args {
2600            return SUCCESS
2601        }
2602    }
2603    catch {rename ::noSuchCommand {}}
2604    set ::slave [interp create]
2605} -body {
2606    $::slave alias bar noSuchCommand
2607    namespace eval test_ns_1 {
2608        namespace unknown unknown
2609        proc unknown args {
2610            return FAIL
2611        }
2612        $::slave eval bar
2613    }
2614} -cleanup {
2615    interp delete $::slave
2616    unset ::slave
2617    namespace delete test_ns_1
2618    rename ::unknown {}
2619    rename unknown.save ::unknown
2620    namespace eval :: [list namespace unknown $handler]
2621} -result SUCCESS
2622   
2623# cleanup
2624catch {rename cmd1 {}}
2625catch {unset l}
2626catch {unset msg}
2627catch {unset trigger}
2628namespace delete {*}[namespace children :: test_ns_*]
2629::tcltest::cleanupTests
2630return
2631
2632# Local Variables:
2633# mode: tcl
2634# End:
Note: See TracBrowser for help on using the repository browser.