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