# Functionality covered: this file contains a collection of tests for the
# procedures in tclNamesp.c that implement Tcl's basic support for
# namespaces. Other namespace-related tests appear in variable.test.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: namespace.test,v 1.27 2004/05/25 18:58:04 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# Clear out any namespaces called test_ns_*
catch {namespace delete {expand}[namespace children :: test_ns_*]}

test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} {
    namespace children :: test_ns_*
} {}

catch {unset l}
test namespace-2.1 {Tcl_GetCurrentNamespace} {
    list [namespace current] [namespace eval {} {namespace current}] \
        [namespace eval {} {namespace current}]
} {:: :: ::}
test namespace-2.2 {Tcl_GetCurrentNamespace} {
    set l {}
    lappend l [namespace current]
    namespace eval test_ns_1 {
        lappend l [namespace current]
        namespace eval foo {
            lappend l [namespace current]
        }
    }
    lappend l [namespace current]
    set l
} {:: ::test_ns_1 ::test_ns_1::foo ::}

test namespace-3.1 {Tcl_GetGlobalNamespace} {
    namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
    # namespace children uses Tcl_GetGlobalNamespace 
    namespace eval test_ns_1 {namespace children foo b*}
} {::test_ns_1::foo::bar}

test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} {
    namespace eval test_ns_1 {
        variable v 123
        proc p {} {
            variable v
            return $v
        }
    }
    test_ns_1::p    ;# does Tcl_PushCallFrame to push p's namespace
} {123}
test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} {
    namespace eval test_ns_1::baz {}  ;# does Tcl_PushCallFrame to create baz
    proc test_ns_1::baz::p {} {
        variable v
        set v 789
        set v}
    test_ns_1::baz::p
} {789}

test namespace-5.1 {Tcl_PopCallFrame, no vars} {
    namespace eval test_ns_1::blodge {}  ;# pushes then pops frame
} {}
test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
    proc test_ns_1::r {} {
        set a 123
    }
    test_ns_1::r   ;# pushes then pop's r's frame
} {123}

test namespace-6.1 {Tcl_CreateNamespace} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [lsort [namespace children :: test_ns_*]] \
        [namespace eval test_ns_1 {namespace current}] \
	[namespace eval test_ns_2 {namespace current}] \
	[namespace eval ::test_ns_3 {namespace current}] \
	[namespace eval ::test_ns_4 \
            {namespace eval foo {namespace current}}] \
	[namespace eval ::test_ns_5 \
            {namespace eval ::test_ns_6 {namespace current}}] \
        [lsort [namespace children :: test_ns_*]]
} {{} ::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}}
test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
    list [namespace eval :::test_ns_1::::foo {namespace current}] \
         [namespace eval test_ns_2:::::foo {namespace current}]
} {::test_ns_1::foo ::test_ns_2::foo}
test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
    list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg 
} {0 ::test_ns_7}
test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_1:: {
        namespace eval test_ns_2:: {}
        namespace eval test_ns_3:: {}
    }
    lsort [namespace children ::test_ns_1]
} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}]
test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} {
    set trigger {
        namespace eval test_ns_2 {namespace current}
    }
    set l {}
    lappend l [namespace eval test_ns_1 $trigger]
    namespace eval test_ns_1::test_ns_2 {}
    lappend l [namespace eval test_ns_1 $trigger]
} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2}

test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]
            return [namespace current]
        }
    }
    list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg
} {::test_ns_1 1 {invalid command name "test_ns_1::p"}}
test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
    namespace eval test_ns_2 {
        proc p {} {
            return [namespace current]
        }
    }
    list [test_ns_2::p] [namespace delete test_ns_2]
} {::test_ns_2 {}}

test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
    catch {interp delete test_interp}
    interp create test_interp
    interp eval test_interp {
        namespace eval test_ns_1 {
            namespace export p
            proc p {} {
                return [namespace current]
            }
        }
        namespace eval test_ns_2 {
            namespace import ::test_ns_1::p
            variable v 27
            proc q {} {
                variable v
                return "[p] $v"
            }
        }
        set x [test_ns_2::q]
        catch {set xxxx}
    }
    list [interp eval test_interp {test_ns_2::q}] \
         [interp eval test_interp {namespace delete ::}] \
         [catch {interp eval test_interp {set a 123}} msg] $msg \
         [interp delete test_interp]
} {{::test_ns_1 27} {} 1 {invalid command name "set"} {}}
test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
    namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
    list [namespace children test_ns_1] \
         [namespace delete test_ns_1::test_ns_2] \
         [namespace children test_ns_1]
} {::test_ns_1::test_ns_2 {} {}}
test namespace-8.3 {TclTeardownNamespace, delete child namespaces} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
    namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
    list [namespace children test_ns_1] \
         [namespace delete test_ns_1::test_ns_2] \
         [namespace children test_ns_1] \
         [catch {namespace children test_ns_1::test_ns_2} msg] $msg \
         [info commands test_ns_1::test_ns_2::test_ns_3a::*]
} {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}}
test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1 cmd2
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
        proc p {} {return foo}
    }
    list [lsort [info commands test_ns_import::*]] \
         [namespace delete test_ns_export] \
         [info commands test_ns_import::*]
} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p]

test namespace-9.1 {Tcl_Import, empty import pattern} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg
} {1 {empty import pattern}}
test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} {
    list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg
} {1 {unknown namespace in import pattern "fred::x"}}
test namespace-9.3 {Tcl_Import, import ns == export ns} {
    list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg
} {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}}
test namespace-9.4 {Tcl_Import, simple import} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
        proc p {} {return [cmd1 123]}
    }
    test_ns_import::p
} {cmd1: 123}
test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} {
    list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
} {1 {can't import command "cmd1": already exists}}
test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
    namespace eval test_ns_import {
        namespace import -force ::test_ns_export::*
        cmd1 555
    }
} {cmd1: 555}
test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
    }
    namespace eval test_ns_import {
        namespace import -force ::test_ns_export::*
    }
    list [test_ns_import::cmd1 a b c] \
         [test_ns_export::cmd1 d e f] \
         [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \
         [namespace origin test_ns_import::cmd1] \
         [namespace origin test_ns_export::cmd1] \
         [test_ns_import::cmd1 g h i] \
         [test_ns_export::cmd1 j k l]
} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}

test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace forget xyzzy::*} msg] $msg
} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_import {
        namespace forget ::test_ns_export::wombat
    }
} {}
test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
        proc p {} {return [cmd1 123]}
        set l {}
        lappend l [lsort [info commands ::test_ns_import::*]]
        namespace forget ::test_ns_export::cmd1
        lappend l [info commands ::test_ns_import::*]
        lappend l [catch {cmd1 777} msg] $msg
    }
} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]

test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
    }
    list [namespace origin set] [namespace origin test_ns_export::cmd1]
} {::set ::test_ns_export::cmd1}
test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {
    namespace eval test_ns_import1 {
        namespace import ::test_ns_export::*
        namespace export *
        proc p {} {namespace origin cmd1}
    }
    list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
} {::test_ns_export::cmd1 ::test_ns_export::cmd1}
test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
    namespace eval test_ns_import2 {
        namespace import ::test_ns_import1::*
        proc q {} {return [cmd1 123]}
    }
    list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
} {{cmd1: 123} ::test_ns_export::cmd1}

test namespace-12.1 {InvokeImportedCmd} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {namespace current}
    }
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
    }
    list [test_ns_import::cmd1]
} {::test_ns_export}

test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
    namespace eval test_ns_import {
        set l {}
        lappend l [info commands ::test_ns_import::*]
        namespace forget ::test_ns_export::cmd1
        lappend l [info commands ::test_ns_import::*]
    }
} {::test_ns_import::cmd1 {}}

test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    variable v 10
    namespace eval test_ns_1::test_ns_2 {
        variable v 20
    }
    namespace eval test_ns_2 {
        variable v 30
    }
    namespace eval test_ns_1 {
        list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
		[lsort [namespace children :: test_ns_*]]
    }
} [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
    namespace eval test_ns_1 {
        list [catch {set ::test_ns_777::v} msg] $msg \
             [catch {namespace children test_ns_777} msg] $msg
    }
} {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}}
test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
    namespace eval test_ns_1 {
        list $v $test_ns_2::v
    }
} {10 20}
test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval test_ns_1::test_ns_2 {
        namespace eval foo {}
    }
    namespace eval test_ns_1 {
        list [namespace children test_ns_2] \
             [catch {namespace children test_ns_1} msg] $msg
    }
} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval ::test_ns_2 {
        namespace eval bar {}
    }
    namespace eval test_ns_1 {
        set l [list [catch {namespace delete test_ns_2::bar} msg] $msg]
    }
    set l
} {1 {unknown namespace "test_ns_2::bar" in namespace delete command}}
test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval test_ns_1::test_ns_2 {
        namespace eval foo {}
    }
    namespace eval test_ns_1 {
        list [namespace children test_ns_2] \
             [catch {namespace children test_ns_1} msg] $msg
    }
} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
    namespace children test_ns_1:::
} {::test_ns_1::test_ns_2}
test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
    namespace children :::test_ns_1:::::test_ns_2:::
} {::test_ns_1::test_ns_2::foo}
test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
    set l {}
    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
    namespace eval test_ns_1::test_ns_2 {variable {} 2525}
    lappend l [set test_ns_1::test_ns_2::]
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
    catch {unset test_ns_1::test_ns_2::}
    set l {}
    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
    set test_ns_1::test_ns_2:: 314159
    lappend l [set test_ns_1::test_ns_2::]
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {
    catch {rename test_ns_1::test_ns_2:: {}}
    set l {}
    lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
    proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
    lappend l [test_ns_1::test_ns_2:: hello]
} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_1 {
        variable {}
        set test_ns_1::(x) y
    }
    set test_ns_1::(x)
} y
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
} {1 {can't create namespace "": only global namespace can have empty name}}

test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_delete {
        namespace eval test_ns_delete2 {}
        proc cmd {args} {namespace current}
    }
    list [namespace delete ::test_ns_delete::test_ns_delete2] \
         [namespace children ::test_ns_delete]
} {{} {}}
test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
    list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
} {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
test namespace-15.3 {Tcl_FindNamespace, relative name found} {
    namespace eval test_ns_delete {
        namespace eval test_ns_delete2 {}
        namespace eval test_ns_delete3 {}
        list [namespace delete test_ns_delete2] \
             [namespace children [namespace current]]
    }
} {{} ::test_ns_delete::test_ns_delete3}
test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
    namespace eval test_ns_delete2 {}
    namespace eval test_ns_delete {
        list [catch {namespace delete test_ns_delete2} msg] $msg
    }
} {1 {unknown namespace "test_ns_delete2" in namespace delete command}}

test namespace-16.1 {Tcl_FindCommand, absolute name found} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_1 {
        proc cmd {args} {return "[namespace current]::cmd: $args"}
        variable v "::test_ns_1::cmd"
        eval $v one
    }
} {::test_ns_1::cmd: one}
test namespace-16.2 {Tcl_FindCommand, absolute name found} {
    eval $test_ns_1::v two
} {::test_ns_1::cmd: two}
test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
    namespace eval test_ns_1 {
        variable v2 "::test_ns_1::ladidah"
        list [catch {eval $v2} msg] $msg
    }
} {1 {invalid command name "::test_ns_1::ladidah"}}

# save the "unknown" proc, which is redefined by the following two tests
catch {rename unknown unknown.old}
proc unknown {args} {
    return "unknown: $args"
}
test namespace-16.4 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
    ::test_ns_1::foobar x y z
} {unknown: ::test_ns_1::foobar x y z}
test namespace-16.5 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
    ::foobar 1 2 3 4 5
} {unknown: ::foobar 1 2 3 4 5}
test namespace-16.6 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
    test_ns_1::foobar x y z
} {unknown: test_ns_1::foobar x y z}
test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
    foobar 1 2 3 4 5
} {unknown: foobar 1 2 3 4 5}
# restore the "unknown" proc saved previously
catch {rename unknown {}}
catch {rename unknown.old unknown}

test namespace-16.8 {Tcl_FindCommand, relative name found} {
    namespace eval test_ns_1 {
        cmd a b c
    }
} {::test_ns_1::cmd: a b c}
test namespace-16.9 {Tcl_FindCommand, relative name found} {
    catch {rename cmd2 {}}
    proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
    namespace eval test_ns_1 {
       cmd2 a b c
    }
} {::::cmd2: a b c}
test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} {
    namespace eval test_ns_1 {
        proc cmd2 {args} {
            return "[namespace current]::cmd2 in test_ns_1: $args"
        }
        namespace eval test_ns_12 {
            cmd2 a b c
        }
    }
} {::::cmd2: a b c}
test namespace-16.11 {Tcl_FindCommand, relative name not found} {
    namespace eval test_ns_1 {
       list [catch {cmd3 a b c} msg] $msg
    }
} {1 {invalid command name "cmd3"}}

catch {unset x}
test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    set x 314159
    namespace eval test_ns_1 {
        set ::x
    }
} {314159}
test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
    namespace eval test_ns_1 {
        variable x 777
        set ::test_ns_1::x
    }
} {777}
test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {
            variable x 1111
        }
        set ::test_ns_1::test_ns_2::x
    }
} {1111}
test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {
            variable x 1111
        }
        list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
    }
} {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {
    namespace eval test_ns_1 {
        namespace eval test_ns_3 {
            variable ::test_ns_1::test_ns_2::x 2222
        }
    }
    set ::test_ns_1::test_ns_2::x
} {2222}
test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {
    namespace eval test_ns_1 {
        set x
    }
} {777}
test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
    namespace eval test_ns_1 {
        unset x
        set x  ;# must be global x now
    }
} {314159}
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
    namespace eval test_ns_1 {
        list [catch {set wuzzat} msg] $msg
    }
} {1 {can't read "wuzzat": no such variable}}
test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
    namespace eval test_ns_1 {
        variable a hello
    }
    set test_ns_1::a
} {hello}
test namespace-17.10 {Tcl_FindNamespaceVar, do not find zombies (Bug 959052)} {
    catch {unset x}
    catch {namespace delete test_ns_1 }
    catch {namespace delete test_ns_2}
    namespace eval test_ns_1 upvar x q
    namespace eval test_ns_2 set x 1
    catch {set ::x}
} 1
test namespace-17.11 {Tcl_FindNamespaceVar, do not find zombies (Bug 959052)} {
    catch {unset x}
    catch {namespace delete test_ns_1}
    trace add variable x write {;#}
    namespace eval test_ns_1 set x 1
    catch {set ::x}
} 1
test namespace-17.12 {Tcl_FindNamespaceVar, do not find zombies (Bug 959052)} {
    catch {unset x}
    catch {namespace delete test_ns_1} 
    namespace eval test_ns_1 {trace add variable x write {;#}}
    set ::x 0
    namespace eval test_ns_1 set x 1
    set ::x
} 1

catch {unset x}

catch {unset l}
catch {rename foo {}}
test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    proc foo {} {return "global foo"}
    namespace eval test_ns_1 {
        proc trigger {} {
            return [foo]
        }
    }
    set l ""
    lappend l [test_ns_1::trigger]
    namespace eval test_ns_1 {
        # force invalidation of cached ref to "foo" in proc trigger
        proc foo {} {return "foo in test_ns_1"}
    }
    lappend l [test_ns_1::trigger]
    set l
} {{global foo} {foo in test_ns_1}}
test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
    namespace eval test_ns_2 {
        proc foo {} {return "foo in ::test_ns_2"}
    }
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {}
        proc trigger {} {
            return [test_ns_2::foo]
        }
    }
    set l ""
    lappend l [test_ns_1::trigger]
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {
            # force invalidation of cached ref to "foo" in proc trigger
            proc foo {} {return "foo in ::test_ns_1::test_ns_2"}
        }
    }
    lappend l [test_ns_1::trigger]
    set l
} {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
catch {unset l}
catch {rename foo {}}

test namespace-19.1 {GetNamespaceFromObj, global name found} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
    namespace children ::test_ns_1
} {::test_ns_1::test_ns_2}
test namespace-19.2 {GetNamespaceFromObj, relative name found} {
    namespace eval test_ns_1 {
        namespace children test_ns_2
    }
} {}
test namespace-19.3 {GetNamespaceFromObj, name not found} {
    namespace eval test_ns_1 {
        list [catch {namespace children test_ns_99} msg] $msg
    }
} {1 {unknown namespace "test_ns_99" in namespace children command}}
test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
    namespace eval test_ns_1 {
        proc foo {} {
            return [namespace children test_ns_2]
        }
        list [catch {namespace children test_ns_99} msg] $msg
    }
    set l {}
    lappend l [test_ns_1::foo]
    namespace delete test_ns_1::test_ns_2
    namespace eval test_ns_1::test_ns_2::test_ns_3 {}
    lappend l [test_ns_1::foo]
    set l
} {{} ::test_ns_1::test_ns_2::test_ns_3}

test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace} msg] $msg
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} {
    list [catch {namespace wombat {}} msg] $msg
} {1 {bad option "wombat": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
    namespace ch :: test_ns_*
} {}

test namespace-21.1 {NamespaceChildrenCmd, no args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
    expr {[string first ::test_ns_1 [namespace children]] != -1}
} {1}
test namespace-21.2 {NamespaceChildrenCmd, no args} {
    namespace eval test_ns_1 {
        namespace children
    }
} {::test_ns_1::test_ns_2}
test namespace-21.3 {NamespaceChildrenCmd, ns name given} {
    namespace children ::test_ns_1
} {::test_ns_1::test_ns_2}
test namespace-21.4 {NamespaceChildrenCmd, ns name given} {
    namespace eval test_ns_1 {
        namespace children test_ns_2
    }
} {}
test namespace-21.5 {NamespaceChildrenCmd, too many args} {
    namespace eval test_ns_1 {
        list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
    }
} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
    namespace eval test_ns_1::test_ns_foo {}
    namespace children test_ns_1 *f*
} {::test_ns_1::test_ns_foo}
test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
    namespace eval test_ns_1::test_ns_foo {}
    lsort [namespace children test_ns_1 test*]
} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]

test namespace-22.1 {NamespaceCodeCmd, bad args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace code} msg] $msg \
         [catch {namespace code xxx yyy} msg] $msg
} {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}}
test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} {
    namespace eval test_ns_1 {
        proc cmd {} {return "test_ns_1::cmd"}
    }
    namespace code {namespace inscope ::test_ns_1 cmd}
} {namespace inscope ::test_ns_1 cmd}
test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} {
    namespace code {namespace     inscope     ::test_ns_1 cmd}
} {namespace     inscope     ::test_ns_1 cmd}
test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {
    namespace code unknown
} {::namespace inscope :: unknown}
test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
    namespace eval test_ns_1 {
        namespace code cmd
    }
} {::namespace inscope ::test_ns_1 cmd}
test namespace-22.6 {NamespaceCodeCmd, in other namespace} { 
    namespace eval test_ns_1 { 
	variable v 42 
    } 
    namespace eval test_ns_2 { 
	proc namespace args {} 
    } 
    namespace eval test_ns_2 [namespace eval test_ns_1 { 
	namespace code {set v} 
    }] 
} {42} 

test namespace-23.1 {NamespaceCurrentCmd, bad args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace current xxx} msg] $msg \
         [catch {namespace current xxx yyy} msg] $msg
} {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}}
test namespace-23.2 {NamespaceCurrentCmd, at global level} {
    namespace current
} {::}
test namespace-23.3 {NamespaceCurrentCmd, in nested ns} {
    namespace eval test_ns_1::test_ns_2 {
        namespace current
    }
} {::test_ns_1::test_ns_2}

test namespace-24.1 {NamespaceDeleteCmd, no args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace delete
} {}
test namespace-24.2 {NamespaceDeleteCmd, one arg} {
    namespace eval test_ns_1::test_ns_2 {}
    namespace delete ::test_ns_1
} {}
test namespace-24.3 {NamespaceDeleteCmd, two args} {
    namespace eval test_ns_1::test_ns_2 {}
    list [namespace delete ::test_ns_1::test_ns_2] [namespace delete ::test_ns_1]
} {{} {}}
test namespace-24.4 {NamespaceDeleteCmd, unknown ns} {
    list [catch {namespace delete ::test_ns_foo} msg] $msg
} {1 {unknown namespace "::test_ns_foo" in namespace delete command}}

test namespace-25.1 {NamespaceEvalCmd, bad args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace eval} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
test namespace-25.2 {NamespaceEvalCmd, bad args} {
    list [catch {namespace test_ns_1} msg] $msg
} {1 {bad option "test_ns_1": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
catch {unset v}
test namespace-25.3 {NamespaceEvalCmd, new namespace} {
    set v 123
    namespace eval test_ns_1 {
        variable v 314159
        proc p {} {
            variable v
            return $v
        }
    }
    test_ns_1::p
} {314159}
test namespace-25.4 {NamespaceEvalCmd, existing namespace} {
    namespace eval test_ns_1 {
        proc q {} {return [expr {[p]+1}]}
    }
    test_ns_1::q
} {314160}
test namespace-25.5 {NamespaceEvalCmd, multiple args} {
    namespace eval test_ns_1 "set" "v"
} {314159}
test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
    list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $errorInfo
} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
    while executing
"xxxx"
    (in namespace eval "::test_ns_1" script line 1)
    invoked from within
"namespace eval test_ns_1 {xxxx}"}}
catch {unset v}

test namespace-26.1 {NamespaceExportCmd, no args and new ns} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace export
} {}
test namespace-26.2 {NamespaceExportCmd, just -clear arg} {
    namespace export -clear
} {}
test namespace-26.3 {NamespaceExportCmd, pattern can't specify a namespace} {
    namespace eval test_ns_1 {
        list [catch {namespace export ::zzz} msg] $msg
    }
} {1 {invalid export pattern "::zzz": pattern can't specify a namespace}}
test namespace-26.4 {NamespaceExportCmd, one pattern} {
    namespace eval test_ns_1 {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
        proc cmd3 {args} {return "cmd3: $args"}
        proc cmd4 {args} {return "cmd4: $args"}
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
    }
    list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
} {::test_ns_2::cmd1 {cmd1: hello}}
test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {
    namespace eval test_ns_1 {
        namespace export cmd1 cmd3
    }
    namespace eval test_ns_2 {
        namespace import -force ::test_ns_1::*
    }
    list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello]
} [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}]
test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} {
    namespace eval test_ns_1 {
        namespace export
    }
} {cmd1 cmd3}
test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
    namespace eval test_ns_1 {
        namespace export -clear cmd4
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
    }
    list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
} [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]

test namespace-27.1 {NamespaceForgetCmd, no args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace forget
} {}
test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} {
    list [catch {namespace forget ::test_ns_1::xxx} msg] $msg
} {1 {unknown namespace in namespace forget pattern "::test_ns_1::xxx"}}
test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} {
    namespace eval test_ns_1 {
        namespace export cmd*
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
        namespace forget ::test_ns_1::cmd1
    }
    info commands ::test_ns_2::*
} {::test_ns_2::cmd2}

test namespace-28.1 {NamespaceImportCmd, no args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace import
} {}
test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} {
    namespace import -force
} {}
test namespace-28.3 {NamespaceImportCmd, arg is imported} {
    namespace eval test_ns_1 {
        namespace export cmd2
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
        namespace forget ::test_ns_1::cmd1
    }
    info commands test_ns_2::*
} {::test_ns_2::cmd2}

test namespace-29.1 {NamespaceInscopeCmd, bad args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace inscope} msg] $msg
} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
test namespace-29.2 {NamespaceInscopeCmd, bad args} {
    list [catch {namespace inscope ::} msg] $msg
} {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} {
    list [catch {namespace inscope test_ns_1 {set v}} msg] $msg
} {1 {unknown namespace "test_ns_1" in inscope namespace command}}
test namespace-29.4 {NamespaceInscopeCmd, simple case} {
    namespace eval test_ns_1 {
        variable v 747
        proc cmd {args} {
            variable v
            return "[namespace current]::cmd: v=$v, args=$args"
        }
    }
    namespace inscope test_ns_1 cmd
} {::test_ns_1::cmd: v=747, args=}
test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
    list [namespace inscope test_ns_1 cmd x y z] \
         [namespace eval test_ns_1 [concat cmd [list x y z]]]
} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}

test namespace-30.1 {NamespaceOriginCmd, bad args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace origin} msg] $msg
} {1 {wrong # args: should be "namespace origin name"}}
test namespace-30.2 {NamespaceOriginCmd, bad args} {
    list [catch {namespace origin x y} msg] $msg
} {1 {wrong # args: should be "namespace origin name"}}
test namespace-30.3 {NamespaceOriginCmd, command not found} {
    list [catch {namespace origin fred} msg] $msg
} {1 {invalid command name "fred"}}
test namespace-30.4 {NamespaceOriginCmd, command isn't imported} {
    namespace origin set
} {::set}
test namespace-30.5 {NamespaceOriginCmd, imported command} {
    namespace eval test_ns_1 {
        namespace export cmd*
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_2 {
        namespace export *
        namespace import ::test_ns_1::*
        proc p {} {}
    }
    namespace eval test_ns_3 {
        namespace import ::test_ns_2::*
        list [namespace origin foreach] \
             [namespace origin p] \
             [namespace origin cmd1] \
             [namespace origin ::test_ns_2::cmd2]
    }
} {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2}

test namespace-31.1 {NamespaceParentCmd, bad args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace parent a b} msg] $msg
} {1 {wrong # args: should be "namespace parent ?name?"}}
test namespace-31.2 {NamespaceParentCmd, no args} {
    namespace parent
} {}
test namespace-31.3 {NamespaceParentCmd, namespace specified} {
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {
            namespace eval test_ns_3 {}
        }
    }
    list [namespace parent ::] \
         [namespace parent test_ns_1::test_ns_2] \
         [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}]
} {{} ::test_ns_1 ::test_ns_1}
test namespace-31.4 {NamespaceParentCmd, bad namespace specified} {
    list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg
} {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}}

test namespace-32.1 {NamespaceQualifiersCmd, bad args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace qualifiers} msg] $msg
} {1 {wrong # args: should be "namespace qualifiers string"}}
test namespace-32.2 {NamespaceQualifiersCmd, bad args} {
    list [catch {namespace qualifiers x y} msg] $msg
} {1 {wrong # args: should be "namespace qualifiers string"}}
test namespace-32.3 {NamespaceQualifiersCmd, simple name} {
    namespace qualifiers foo
} {}
test namespace-32.4 {NamespaceQualifiersCmd, leading ::} {
    namespace qualifiers ::x::y::z
} {::x::y}
test namespace-32.5 {NamespaceQualifiersCmd, no leading ::} {
    namespace qualifiers a::b
} {a}
test namespace-32.6 {NamespaceQualifiersCmd, :: argument} {
    namespace qualifiers ::
} {}
test namespace-32.7 {NamespaceQualifiersCmd, odd number of :s} {
    namespace qualifiers :::::
} {}
test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} {
    namespace qualifiers foo:::
} {foo}

test namespace-33.1 {NamespaceTailCmd, bad args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace tail} msg] $msg
} {1 {wrong # args: should be "namespace tail string"}}
test namespace-33.2 {NamespaceTailCmd, bad args} {
    list [catch {namespace tail x y} msg] $msg
} {1 {wrong # args: should be "namespace tail string"}}
test namespace-33.3 {NamespaceTailCmd, simple name} {
    namespace tail foo
} {foo}
test namespace-33.4 {NamespaceTailCmd, leading ::} {
    namespace tail ::x::y::z
} {z}
test namespace-33.5 {NamespaceTailCmd, no leading ::} {
    namespace tail a::b
} {b}
test namespace-33.6 {NamespaceTailCmd, :: argument} {
    namespace tail ::
} {}
test namespace-33.7 {NamespaceTailCmd, odd number of :s} {
    namespace tail :::::
} {}
test namespace-33.8 {NamespaceTailCmd, odd number of :s} {
    namespace tail foo:::
} {}

test namespace-34.1 {NamespaceWhichCmd, bad args} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    list [catch {namespace which} msg] $msg
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
test namespace-34.2 {NamespaceWhichCmd, bad args} {
    list [catch {namespace which -fred} msg] $msg
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
test namespace-34.3 {NamespaceWhichCmd, bad args} {
    list [catch {namespace which -command} msg] $msg
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
test namespace-34.4 {NamespaceWhichCmd, bad args} {
    list [catch {namespace which a b} msg] $msg
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
test namespace-34.5 {NamespaceWhichCmd, command lookup} {
    namespace eval test_ns_1 {
        namespace export cmd*
        variable v1 111
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_2 {
        namespace export *
        namespace import ::test_ns_1::*
        variable v2 222
        proc p {} {}
    }
    namespace eval test_ns_3 {
        namespace import ::test_ns_2::*
        variable v3 333
        list [namespace which -command foreach] \
             [namespace which -command p] \
             [namespace which -command cmd1] \
             [namespace which -command ::test_ns_2::cmd2] \
             [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
    }
} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
test namespace-34.6 {NamespaceWhichCmd, -command is default} {
    namespace eval test_ns_3 {
        list [namespace which foreach] \
             [namespace which p] \
             [namespace which cmd1] \
             [namespace which ::test_ns_2::cmd2]
    }
} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
    namespace eval test_ns_3 {
        list [namespace which -variable env] \
             [namespace which -variable v3] \
             [namespace which -variable ::test_ns_2::v2] \
             [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
    }
} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}

test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]
            return [namespace current]
        }
    }
    test_ns_1::p
} {::test_ns_1}
test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
    namespace eval test_ns_1 {
        proc q {} {
            return [namespace current]
        }
    }
    list [test_ns_1::q] \
         [namespace delete test_ns_1] \
         [catch {test_ns_1::q} msg] $msg
} {::test_ns_1 {} 1 {invalid command name "test_ns_1::q"}}

catch {unset x}
catch {unset y}
test namespace-36.1 {DupNsNameInternalRep} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_1 {}
    set x "::test_ns_1"
    list [namespace parent $x] [set y $x] [namespace parent $y]
} {:: ::test_ns_1 ::}
catch {unset x}
catch {unset y}

test namespace-37.1 {SetNsNameFromAny, ns name found} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
    namespace eval test_ns_1 {
        namespace children ::test_ns_1
    }
} {::test_ns_1::test_ns_2}
test namespace-37.2 {SetNsNameFromAny, ns name not found} {
    namespace eval test_ns_1 {
        list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg
    }
} {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}}

test namespace-38.1 {UpdateStringOfNsName} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name
    list [namespace eval {} {namespace current}] \
         [namespace eval {} {namespace current}]
} {:: ::}

test namespace-39.1 {NamespaceExistsCmd} {
    catch {namespace delete {expand}[namespace children :: test_ns_*]}
    namespace eval ::test_ns_z::test_me { variable foo }
    list [namespace exists ::] \
	    [namespace exists ::bogus_namespace] \
	    [namespace exists ::test_ns_z] \
	    [namespace exists test_ns_z] \
	    [namespace exists ::test_ns_z::foo] \
	    [namespace exists ::test_ns_z::test_me] \
	    [namespace eval ::test_ns_z { namespace exists ::test_me }] \
	    [namespace eval ::test_ns_z { namespace exists test_me }] \
	    [namespace exists :::::test_ns_z]
} {1 0 1 1 0 1 0 1 1}
test namespace-39.2 {NamespaceExistsCmd error} {
    list [catch {namespace exists} msg] $msg
} {1 {wrong # args: should be "namespace exists name"}}
test namespace-39.3 {NamespaceExistsCmd error} {
    list [catch {namespace exists a b} msg] $msg
} {1 {wrong # args: should be "namespace exists name"}}

test namespace-40.1 {Ignoring namespace proc "unknown"} {
    rename unknown _unknown
    proc unknown args {return global}
    namespace eval ns {proc unknown args {return local}}
    set l [list [namespace eval ns aaa bbb] [namespace eval ns aaa]]
    rename unknown {}   
    rename _unknown unknown
    namespace delete ns
    set l
} {global global}

test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
    set res {}
    namespace eval ns {
	set res {}
	proc test {} {
	    set ::g 0
	}  
	lappend ::res [test]
	proc set {a b} {
	    ::set a [incr b]
	}
	lappend ::res [test]
    }
    namespace delete ns
    set res
} {0 1}

test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} {
    set res {}
    namespace eval ns {}
    proc ns::a {i} {
	variable b
	proc set args {return "New proc is called"}
	return [set b $i]
    }
    ns::a 1
    set res [ns::a 2]
    namespace delete ns
    set res
} {New proc is called}

test namespace-41.3 {Shadowing byte-compiled commands, Bugs: 231259, 729692} {
    set res {}
    namespace eval ns {
	variable b 0
    }

    proc ns::a {i} {
	variable b
	proc set args {return "New proc is called"}
	return [set b $i]
    }
    
    set res [list [ns::a 1] $ns::b]
    namespace delete ns
    set res
} {{New proc is called} 0}

# Ensembles (TIP#112)

test namespace-42.1 {ensembles: basic} {
    namespace eval ns {
	namespace export x
	proc x {} {format 1}
	namespace ensemble create
    }
    list [info command ns] [ns x] [namespace delete ns] [info command ns]
} {ns 1 {} {}}
test namespace-42.2 {ensembles: basic} {
    namespace eval ns {
	namespace export x
	proc x {} {format 1}
	namespace ensemble create
    }
    rename ns foo
    list [info command foo] [foo x] [namespace delete ns] [info command foo]
} {foo 1 {} {}}
test namespace-42.3 {ensembles: basic} {
    namespace eval ns {
	namespace export x*
	proc x1 {} {format 1}
	proc x2 {} {format 2}
	namespace ensemble create
    }
    set result [list [ns x1] [ns x2]]
    lappend result [catch {ns x} msg] $msg
    rename ns {}
    lappend result [info command ns::x1]
    namespace delete ns
    lappend result [info command ns::x1]
} {1 2 1 {unknown or ambiguous subcommand "x": must be x1, or x2} ::ns::x1 {}}
test namespace-42.4 {ensembles: basic} {
    namespace eval ns {
	namespace export y*
	proc x1 {} {format 1}
	proc x2 {} {format 2}
	namespace ensemble create
    }
    set result [list [catch {ns x} msg] $msg]
    namespace delete ns
    set result
} {1 {unknown subcommand "x": namespace ::ns does not export any commands}}
test namespace-42.5 {ensembles: basic} {
    namespace eval ns {
	namespace export x*
	proc x1 {} {format 1}
	proc x2 {} {format 2}
	proc x3 {} {format 3}
	namespace ensemble create
    }
    set result [list [catch {ns x} msg] $msg]
    namespace delete ns
    set result
} {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}}
test namespace-42.6 {ensembles: nested} {
    namespace eval ns {
	namespace export x*
	namespace eval x0 {
	    proc z {} {format 0}
	    namespace export z
	    namespace ensemble create
	}
	proc x1 {} {format 1}
	proc x2 {} {format 2}
	proc x3 {} {format 3}
	namespace ensemble create
    }
    set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]]
    namespace delete ns
    set result
} {0 1 2 3}
test namespace-42.7 {ensembles: nested} {
    namespace eval ns {
	namespace export x*
	namespace eval x0 {
	    proc z {} {list [info level] [info level 1]}
	    namespace export z
	    namespace ensemble create
	}
	proc x1 {} {format 1}
	proc x2 {} {format 2}
	proc x3 {} {format 3}
	namespace ensemble create
    }
    set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]]
    namespace delete ns
    set result
} {{1 ::ns::x0::z} 1 2 3}

test namespace-43.1 {ensembles: dict-driven} {
    namespace eval ns {
	namespace export x*
	proc x1 {} {format 1}
	proc x2 {} {format 2}
	namespace ensemble create -map {a x1 b x2}
    }
    set result [list [catch {ns c} msg] $msg [namespace ensemble exists ns]]
    rename ns {}
    lappend result [namespace ensemble exists ns]
} {1 {unknown or ambiguous subcommand "c": must be a, or b} 1 0}
test namespace-43.2 {ensembles: dict-driven} {
    namespace eval ns {
	namespace export x*
	proc x1 {args} {list 1 $args}
	proc x2 {args} {list 2 [llength $args]}
	namespace ensemble create -map {
	    a ::ns::x1 b ::ns::x2 c {::ns::x1 .} d {::ns::x2 .}
	}
    }
    set result [list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo]]
    namespace delete ns
    set result
} {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}}
set SETUP {
    namespace eval ns {
	namespace export a b
	proc a args {format 1,[llength $args]}
	proc b args {format 2,[llength $args]}
	proc c args {format 3,[llength $args]}
	proc d args {format 4,[llength $args]}
	namespace ensemble create -subcommands {b c}
    }
}
test namespace-43.3 {ensembles: list-driven} -setup $SETUP -body {
    namespace delete ns
} -result {}
test namespace-43.4 {ensembles: list-driven} -setup $SETUP -body {
    ns a foo bar boo spong wibble
} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "a": must be b, or c}
test namespace-43.5 {ensembles: list-driven} -setup $SETUP -body {
    ns b foo bar boo spong wibble
} -cleanup {namespace delete ns} -result 2,5
test namespace-43.6 {ensembles: list-driven} -setup $SETUP -body {
    ns c foo bar boo spong wibble
} -cleanup {namespace delete ns} -result 3,5
test namespace-43.7 {ensembles: list-driven} -setup $SETUP -body {
    ns d foo bar boo spong wibble
} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "d": must be b, or c}
set SETUP {
    namespace eval ns {
	namespace export a b
	proc a args {format 1,[llength $args]}
	proc b args {format 2,[llength $args]}
	proc c args {format 3,[llength $args]}
	proc d args {format 4,[llength $args]}
	namespace ensemble create -subcommands {b c} -map {c ::ns::d}
    }
}
test namespace-43.8 {ensembles: list-and-map-driven} -setup $SETUP -body {
    namespace delete ns
} -result {}
test namespace-43.9 {ensembles: list-and-map-driven} -setup $SETUP -body {
    ns a foo bar boo spong wibble
} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "a": must be b, or c}
test namespace-43.10 {ensembles: list-and-map-driven} -setup $SETUP -body {
    ns b foo bar boo spong wibble
} -cleanup {namespace delete ns} -result 2,5
test namespace-43.11 {ensembles: list-and-map-driven} -setup $SETUP -body {
    ns c foo bar boo spong wibble
} -cleanup {namespace delete ns} -result 4,5
test namespace-43.12 {ensembles: list-and-map-driven} -setup $SETUP -body {
    ns d foo bar boo spong wibble
} -cleanup {namespace delete ns} -returnCodes error -result {unknown or ambiguous subcommand "d": must be b, or c}
set SETUP {
    namespace eval ns {
	namespace export *
	proc foo args {format bar}
	proc spong args {format wibble}
	namespace ensemble create -prefixes off
    }
}
test namespace-43.13 {ensembles: turn off prefixes} -setup $SETUP -body {
    namespace delete ns
} -result {}
test namespace-43.14 {ensembles: turn off prefixes} -setup $SETUP -body {
    ns fo
} -cleanup {namespace delete ns} -returnCodes error -result {unknown subcommand "fo": must be foo, or spong}
test namespace-43.15 {ensembles: turn off prefixes} -setup $SETUP -body {
    ns foo
} -cleanup {namespace delete ns} -result bar
test namespace-43.16 {ensembles: turn off prefixes} -setup $SETUP -body {
    ns s
} -cleanup {namespace delete ns} -returnCodes error -result {unknown subcommand "s": must be foo, or spong}
test namespace-43.17 {ensembles: turn off prefixes} -setup $SETUP -body {
    ns spong
} -cleanup {namespace delete ns} -result wibble

test namespace-44.1 {ensemble: errors} {
    list [catch {namespace ensemble} msg] $msg
} {1 {wrong # args: should be "namespace ensemble subcommand ?arg ...?"}}
test namespace-44.2 {ensemble: errors} {
    list [catch {namespace ensemble ?} msg] $msg
} {1 {bad subcommand "?": must be configure, create, or exists}}
test namespace-44.3 {ensemble: errors} {
    namespace eval ns {
	list [catch {namespace ensemble create -map x} msg] $msg
    }
} {1 {missing value to go with key}}
test namespace-44.4 {ensemble: errors} {
    namespace eval ns {
	list [catch {namespace ensemble create -map {x {}}} msg] $msg
    }
} {1 {ensemble subcommand implementations must be non-empty lists}}
test namespace-44.5 {ensemble: errors} -setup {
    namespace ensemble create -command foobar -subcommands {foobarcget foobarconfigure}
} -body {
    foobar foobarcon
} -cleanup {
    rename foobar {}
} -returnCodes error -result {invalid command name "::foobarconfigure"}

test namespace-45.1 {ensemble: introspection} {
    namespace eval ns {
	namespace export x
	proc x {} {}
	namespace ensemble create
	set ::result [namespace ensemble configure ::ns]
    }
    namespace delete ns
    set result
} {-map {} -namespace ::ns -prefixes 1 -subcommands {} -unknown {}}
test namespace-45.2 {ensemble: introspection} {
    namespace eval ns {
	namespace export x
	proc x {} {}
	namespace ensemble create -map {A x}
	set ::result [namespace ensemble configure ::ns -map]
    }
    namespace delete ns
    set result
} {A ::ns::x}

test namespace-46.1 {ensemble: modification} {
    namespace eval ns {
	namespace export x
	proc x {} {format 123}

	# Ensemble maps A->x
	namespace ensemble create -command ns -map {A ::ns::x}
	set ::result [list [namespace ensemble configure ns -map] [ns A]]

	# Ensemble maps B->x
	namespace ensemble configure ns -map {B ::ns::x}
	lappend ::result [namespace ensemble configure ns -map] [ns B]

	# Ensemble maps x->x
	namespace ensemble configure ns -map {}
	lappend ::result [namespace ensemble configure ns -map] [ns x]
    }
    namespace delete ns
    set result
} {{A ::ns::x} 123 {B ::ns::x} 123 {} 123}
test namespace-46.2 {ensemble: ensembles really use current export list} {
    namespace eval ns {
	namespace export x1
	proc x1 {} {format 1}
	proc x2 {} {format 1}
	namespace ensemble create
    }
    catch {ns ?} msg; set result [list $msg]
    namespace eval ns {namespace export x*}
    catch {ns ?} msg; lappend result $msg
    rename ns::x1 {}
    catch {ns ?} msg; lappend result $msg
    namespace delete ns
    set result
} {{unknown or ambiguous subcommand "?": must be x1} {unknown or ambiguous subcommand "?": must be x1, or x2} {unknown or ambiguous subcommand "?": must be x2}}
test namespace-46.3 {ensemble: implementation errors} {
    namespace eval ns {
	variable count 0
	namespace ensemble create -map {
	    a {::lappend ::result}
	    b {::incr ::ns::count}
	}
    }
    set result {}
    lappend result [catch { ns } msg] $msg
    ns a [ns b 10]
    catch {rename p {}}
    rename ns p
    p a [p b 3000]
    lappend result $ns::count
    namespace delete ns
    lappend result [info command p]
} {1 {wrong # args: should be "ns subcommand ?argument ...?"} 10 3010 3010 {}}
test namespace-46.4 {ensemble: implementation errors} {
    namespace eval ns {
	namespace ensemble create
    }
    set result [info command ns]
    lappend result [catch {ns ?} msg] $msg
    namespace delete ns
    set result
} {ns 1 {unknown subcommand "?": namespace ::ns does not export any commands}}
test namespace-46.5 {ensemble: implementation errors} {
    namespace eval ns {
	namespace ensemble create -map {foo ::error}
    }
    list [catch {ns foo bar} msg] $msg $::errorInfo [namespace delete ns]
} {1 bar {bar
    while executing
"::error bar"
    invoked from within
"ns foo bar"} {}}
test namespace-46.6 {ensemble: implementation renames/deletes itself} {
    namespace eval ns {
	namespace ensemble create -map {to ::rename}
    }
    ns to ns foo
    foo to foo bar
    bar to bar spong
    spong to spong {}
    namespace delete ns
} {}
test namespace-46.7 {ensemble: implementation deletes its namespace} {
    namespace eval ns {
	namespace ensemble create -map {kill {::namespace delete}}
    }
    ns kill ns
} {}
test namespace-46.8 {ensemble: implementation deletes its namespace} {
    namespace eval ns {
	namespace export *
	proc foo {} {
	    variable x 1
	    bar
	    # Tricky; what is the correct return value anyway?
	    info exist x
	}
	proc bar {} {
	    namespace delete [namespace current]
	}
	namespace ensemble create
    }
    list [ns foo] [info exist ns::x]
} {1 0}
test namespace-46.9 {ensemble: configuring really configures things} {
    namespace eval ns {
	namespace ensemble create -map {a a} -prefixes 0
    }
    set result [list [catch {ns x} msg] $msg]
    namespace ensemble configure ns -map {b b}
    lappend result [catch {ns x} msg] $msg
    namespace delete ns
    set result
} {1 {unknown subcommand "x": must be a} 1 {unknown subcommand "x": must be b}}

test namespace-47.1 {ensemble: unknown handler} {
    set log {}
    namespace eval ns {
	namespace export {[a-z]*}
	proc Magic {ensemble subcmd args} {
	    global log
	    if {[string match {[a-z]*} $subcmd]} {
		lappend log "making $subcmd"
		proc $subcmd args {
		    global log
		    lappend log "running [info level 0]"
		    llength $args
		}
	    } else {
		lappend log "unknown $subcmd - args = $args"
		return -code error \
			"unknown or protected subcommand \"$subcmd\""
	    }
	}
	namespace ensemble create -unknown ::ns::Magic
    }
    set result {}
    lappend result [catch {ns a b c} msg] $msg
    lappend result [catch {ns a b c} msg] $msg
    lappend result [catch {ns b c d} msg] $msg
    lappend result [catch {ns c d e} msg] $msg
    lappend result [catch {ns Magic foo bar spong wibble} msg] $msg
    list $result [lsort [info commands ::ns::*]] $log [namespace delete ns]
} {{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}} {}}
test namespace-47.2 {ensemble: unknown handler} {
    namespace eval ns {
	namespace export {[a-z]*}
	proc Magic {ensemble subcmd args} {
	    error foobar
	}
	namespace ensemble create -unknown ::ns::Magic
    }
    list [catch {ns spong} msg] $msg $errorInfo [namespace delete ns]
} {1 foobar {foobar
    while executing
"error foobar"
    (procedure "::ns::Magic" line 2)
    invoked from within
"::ns::Magic ::ns spong"
    (ensemble unknown subcommand handler)
    invoked from within
"ns spong"} {}}
test namespace-47.3 {ensemble: unknown handler} {
    namespace eval ns {
	variable count 0
	namespace export {[a-z]*}
	proc a {} {}
	proc c {} {}
	proc Magic {ensemble subcmd args} {
	    variable count
	    incr count
	    proc b {} {}
	}
	namespace ensemble create -unknown ::ns::Magic
    }
    list [catch {ns spong} msg] $msg $ns::count [namespace delete ns]
} {1 {unknown or ambiguous subcommand "spong": must be a, b, or c} 1 {}}
test namespace-47.4 {ensemble: unknown handler} {
    namespace eval ns {
	namespace export {[a-z]*}
	proc Magic {ensemble subcmd args} {
	    return -code break
	}
	namespace ensemble create -unknown ::ns::Magic
    }
    list [catch {ns spong} msg] $msg $errorInfo [namespace delete ns]
} {1 {unknown subcommand handler returned bad code: break} {unknown subcommand handler returned bad code: break
    result of ensemble unknown subcommand handler: ::ns::Magic ::ns spong
    invoked from within
"ns spong"} {}}
test namespace-47.5 {ensemble: unknown handler} {
    namespace ensemble create -command foo -unknown bar
    proc bar {args} {
	global result target
	lappend result "LOG $args"
	return $target
    }
    set result {}
    set target {}
    lappend result [catch {foo bar} msg] $msg
    set target {lappend result boo hoo}
    lappend result [catch {foo bar} msg] $msg [namespace ensemble config foo]
    rename foo {}
    set result
} {{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}}
test namespace-47.6 {ensemble: unknown handler} {
    namespace ensemble create -command foo -unknown bar
    proc bar {args} {
	return "\{"
    }
    set result [list [catch {foo bar} msg] $msg $errorInfo]
    rename foo {}
    set result
} {1 {unmatched open brace in list} {unmatched open brace in list
    while parsing result of ensemble unknown subcommand handler
    invoked from within
"foo bar"}}

# cleanup
catch {rename cmd1 {}}
catch {unset l}
catch {unset msg}
catch {unset trigger}
namespace delete {expand}[namespace children :: test_ns_*]
::tcltest::cleanupTests
return