sl@0: # Functionality covered: this file contains a collection of tests for the sl@0: # procedures in tclNamesp.c that implement Tcl's basic support for sl@0: # namespaces. Other namespace-related tests appear in variable.test. sl@0: # sl@0: # Sourcing this file into Tcl runs the tests and generates output for sl@0: # errors. No output means no errors were found. sl@0: # sl@0: # Copyright (c) 1997 Sun Microsystems, Inc. sl@0: # Copyright (c) 1998-2000 by Scriptics Corporation. sl@0: # sl@0: # See the file "license.terms" for information on usage and redistribution sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES. sl@0: # sl@0: # RCS: @(#) $Id: namespace.test,v 1.21.2.10 2006/10/04 17:59:06 dgp Exp $ sl@0: sl@0: if {[lsearch [namespace children] ::tcltest] == -1} { sl@0: package require tcltest 2 sl@0: namespace import -force ::tcltest::* sl@0: } sl@0: sl@0: # Clear out any namespaces called test_ns_* sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: sl@0: test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} { sl@0: namespace children :: test_ns_* sl@0: } {} sl@0: sl@0: catch {unset l} sl@0: test namespace-2.1 {Tcl_GetCurrentNamespace} { sl@0: list [namespace current] [namespace eval {} {namespace current}] \ sl@0: [namespace eval {} {namespace current}] sl@0: } {:: :: ::} sl@0: test namespace-2.2 {Tcl_GetCurrentNamespace} { sl@0: set l {} sl@0: lappend l [namespace current] sl@0: namespace eval test_ns_1 { sl@0: lappend l [namespace current] sl@0: namespace eval foo { sl@0: lappend l [namespace current] sl@0: } sl@0: } sl@0: lappend l [namespace current] sl@0: set l sl@0: } {:: ::test_ns_1 ::test_ns_1::foo ::} sl@0: sl@0: test namespace-3.1 {Tcl_GetGlobalNamespace} { sl@0: namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } } sl@0: # namespace children uses Tcl_GetGlobalNamespace sl@0: namespace eval test_ns_1 {namespace children foo b*} sl@0: } {::test_ns_1::foo::bar} sl@0: sl@0: test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} { sl@0: namespace eval test_ns_1 { sl@0: variable v 123 sl@0: proc p {} { sl@0: variable v sl@0: return $v sl@0: } sl@0: } sl@0: test_ns_1::p ;# does Tcl_PushCallFrame to push p's namespace sl@0: } {123} sl@0: test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} { sl@0: namespace eval test_ns_1::baz {} ;# does Tcl_PushCallFrame to create baz sl@0: proc test_ns_1::baz::p {} { sl@0: variable v sl@0: set v 789 sl@0: set v} sl@0: test_ns_1::baz::p sl@0: } {789} sl@0: sl@0: test namespace-5.1 {Tcl_PopCallFrame, no vars} { sl@0: namespace eval test_ns_1::blodge {} ;# pushes then pops frame sl@0: } {} sl@0: test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} { sl@0: proc test_ns_1::r {} { sl@0: set a 123 sl@0: } sl@0: test_ns_1::r ;# pushes then pop's r's frame sl@0: } {123} sl@0: sl@0: test namespace-6.1 {Tcl_CreateNamespace} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [lsort [namespace children :: test_ns_*]] \ sl@0: [namespace eval test_ns_1 {namespace current}] \ sl@0: [namespace eval test_ns_2 {namespace current}] \ sl@0: [namespace eval ::test_ns_3 {namespace current}] \ sl@0: [namespace eval ::test_ns_4 \ sl@0: {namespace eval foo {namespace current}}] \ sl@0: [namespace eval ::test_ns_5 \ sl@0: {namespace eval ::test_ns_6 {namespace current}}] \ sl@0: [lsort [namespace children :: test_ns_*]] sl@0: } {{} ::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4::foo ::test_ns_6 {::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4 ::test_ns_5 ::test_ns_6}} sl@0: test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} { sl@0: list [namespace eval :::test_ns_1::::foo {namespace current}] \ sl@0: [namespace eval test_ns_2:::::foo {namespace current}] sl@0: } {::test_ns_1::foo ::test_ns_2::foo} sl@0: test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} { sl@0: list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg sl@0: } {0 ::test_ns_7} sl@0: test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_1:: { sl@0: namespace eval test_ns_2:: {} sl@0: namespace eval test_ns_3:: {} sl@0: } sl@0: lsort [namespace children ::test_ns_1] sl@0: } [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}] sl@0: test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} { sl@0: set trigger { sl@0: namespace eval test_ns_2 {namespace current} sl@0: } sl@0: set l {} sl@0: lappend l [namespace eval test_ns_1 $trigger] sl@0: namespace eval test_ns_1::test_ns_2 {} sl@0: lappend l [namespace eval test_ns_1 $trigger] sl@0: } {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2} sl@0: sl@0: test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_1 { sl@0: proc p {} { sl@0: namespace delete [namespace current] sl@0: return [namespace current] sl@0: } sl@0: } sl@0: list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg sl@0: } {::test_ns_1 1 {invalid command name "test_ns_1::p"}} sl@0: test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} { sl@0: namespace eval test_ns_2 { sl@0: proc p {} { sl@0: return [namespace current] sl@0: } sl@0: } sl@0: list [test_ns_2::p] [namespace delete test_ns_2] sl@0: } {::test_ns_2 {}} sl@0: test namespace-7.3 {recursive Tcl_DeleteNamespace, active call frames in ns} { sl@0: # [Bug 1355942] sl@0: namespace eval test_ns_2 { sl@0: set x 1 sl@0: trace add variable x unset "namespace delete [namespace current];#" sl@0: namespace delete [namespace current] sl@0: } sl@0: } {} sl@0: test namespace-7.4 {recursive Tcl_DeleteNamespace, active call frames in ns} { sl@0: # [Bug 1355942] sl@0: namespace eval test_ns_2 { sl@0: proc x {} {} sl@0: trace add command x delete "namespace delete [namespace current];#" sl@0: namespace delete [namespace current] sl@0: } sl@0: } {} sl@0: test namespace-7.5 {recursive Tcl_DeleteNamespace, no active call frames in ns} { sl@0: # [Bug 1355942] sl@0: namespace eval test_ns_2 { sl@0: set x 1 sl@0: trace add variable x unset "namespace delete [namespace current];#" sl@0: } sl@0: namespace delete test_ns_2 sl@0: } {} sl@0: test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns} { sl@0: # [Bug 1355942] sl@0: namespace eval test_ns_2 { sl@0: proc x {} {} sl@0: trace add command x delete "namespace delete [namespace current];#" sl@0: } sl@0: namespace delete test_ns_2 sl@0: } {} sl@0: sl@0: test namespace-8.1 {TclTeardownNamespace, delete global namespace} { sl@0: catch {interp delete test_interp} sl@0: interp create test_interp sl@0: interp eval test_interp { sl@0: namespace eval test_ns_1 { sl@0: namespace export p sl@0: proc p {} { sl@0: return [namespace current] sl@0: } sl@0: } sl@0: namespace eval test_ns_2 { sl@0: namespace import ::test_ns_1::p sl@0: variable v 27 sl@0: proc q {} { sl@0: variable v sl@0: return "[p] $v" sl@0: } sl@0: } sl@0: set x [test_ns_2::q] sl@0: catch {set xxxx} sl@0: } sl@0: list [interp eval test_interp {test_ns_2::q}] \ sl@0: [interp eval test_interp {namespace delete ::}] \ sl@0: [catch {interp eval test_interp {set a 123}} msg] $msg \ sl@0: [interp delete test_interp] sl@0: } {{::test_ns_1 27} {} 1 {invalid command name "set"} {}} sl@0: test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}} sl@0: namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}} sl@0: list [namespace children test_ns_1] \ sl@0: [namespace delete test_ns_1::test_ns_2] \ sl@0: [namespace children test_ns_1] sl@0: } {::test_ns_1::test_ns_2 {} {}} sl@0: test namespace-8.3 {TclTeardownNamespace, delete child namespaces} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}} sl@0: namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}} sl@0: list [namespace children test_ns_1] \ sl@0: [namespace delete test_ns_1::test_ns_2] \ sl@0: [namespace children test_ns_1] \ sl@0: [catch {namespace children test_ns_1::test_ns_2} msg] $msg \ sl@0: [info commands test_ns_1::test_ns_2::test_ns_3a::*] sl@0: } {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}} sl@0: test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_export { sl@0: namespace export cmd1 cmd2 sl@0: proc cmd1 {args} {return "cmd1: $args"} sl@0: proc cmd2 {args} {return "cmd2: $args"} sl@0: } sl@0: namespace eval test_ns_import { sl@0: namespace import ::test_ns_export::* sl@0: proc p {} {return foo} sl@0: } sl@0: list [lsort [info commands test_ns_import::*]] \ sl@0: [namespace delete test_ns_export] \ sl@0: [info commands test_ns_import::*] sl@0: } [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p] sl@0: test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} { sl@0: interp create slave sl@0: slave eval {trace add execution error leave {namespace delete :: ;#}} sl@0: catch {slave eval error foo bar baz} sl@0: interp delete slave sl@0: set ::errorInfo sl@0: } {bar sl@0: invoked from within sl@0: "slave eval error foo bar baz"} sl@0: test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} { sl@0: interp create slave sl@0: slave eval {trace add variable errorCode write {namespace delete :: ;#}} sl@0: catch {slave eval error foo bar baz} sl@0: interp delete slave sl@0: set ::errorInfo sl@0: } {bar sl@0: invoked from within sl@0: "slave eval error foo bar baz"} sl@0: test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} { sl@0: interp create slave sl@0: slave eval {trace add execution error leave {namespace delete :: ;#}} sl@0: catch {slave eval error foo bar baz} sl@0: interp delete slave sl@0: set ::errorCode sl@0: } baz sl@0: sl@0: test namespace-9.1 {Tcl_Import, empty import pattern} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg sl@0: } {1 {empty import pattern}} sl@0: test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} { sl@0: list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg sl@0: } {1 {unknown namespace in import pattern "fred::x"}} sl@0: test namespace-9.3 {Tcl_Import, import ns == export ns} { sl@0: list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg sl@0: } {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}} sl@0: test namespace-9.4 {Tcl_Import, simple import} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_export { sl@0: namespace export cmd1 sl@0: proc cmd1 {args} {return "cmd1: $args"} sl@0: proc cmd2 {args} {return "cmd2: $args"} sl@0: } sl@0: namespace eval test_ns_import { sl@0: namespace import ::test_ns_export::* sl@0: proc p {} {return [cmd1 123]} sl@0: } sl@0: test_ns_import::p sl@0: } {cmd1: 123} sl@0: test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} { sl@0: list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg sl@0: } {0 {}} sl@0: test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} { sl@0: namespace eval test_ns_import { sl@0: namespace import -force ::test_ns_export::* sl@0: cmd1 555 sl@0: } sl@0: } {cmd1: 555} sl@0: test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_export { sl@0: namespace export cmd1 sl@0: proc cmd1 {args} {return "cmd1: $args"} sl@0: } sl@0: namespace eval test_ns_import { sl@0: namespace import -force ::test_ns_export::* sl@0: } sl@0: list [test_ns_import::cmd1 a b c] \ sl@0: [test_ns_export::cmd1 d e f] \ sl@0: [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \ sl@0: [namespace origin test_ns_import::cmd1] \ sl@0: [namespace origin test_ns_export::cmd1] \ sl@0: [test_ns_import::cmd1 g h i] \ sl@0: [test_ns_export::cmd1 j k l] sl@0: } {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}} sl@0: sl@0: test namespace-9.8 {Tcl_Import: Bug 1017299} -setup { sl@0: namespace eval one { sl@0: namespace export cmd sl@0: proc cmd {} {} sl@0: } sl@0: namespace eval two { sl@0: namespace export cmd sl@0: proc other args {} sl@0: } sl@0: namespace eval two \ sl@0: [list namespace import [namespace current]::one::cmd] sl@0: namespace eval three \ sl@0: [list namespace import [namespace current]::two::cmd] sl@0: namespace eval three { sl@0: rename cmd other sl@0: namespace export other sl@0: } sl@0: } -body { sl@0: namespace eval two [list namespace import -force \ sl@0: [namespace current]::three::other] sl@0: namespace origin two::other sl@0: } -cleanup { sl@0: namespace delete one two three sl@0: } -match glob -result *::one::cmd sl@0: sl@0: test namespace-9.9 {Tcl_Import: Bug 1017299} -setup { sl@0: namespace eval one { sl@0: namespace export cmd sl@0: proc cmd {} {} sl@0: } sl@0: namespace eval two namespace export cmd sl@0: namespace eval two \ sl@0: [list namespace import [namespace current]::one::cmd] sl@0: namespace eval three namespace export cmd sl@0: namespace eval three \ sl@0: [list namespace import [namespace current]::two::cmd] sl@0: } -body { sl@0: namespace eval two [list namespace import -force \ sl@0: [namespace current]::three::cmd] sl@0: namespace origin two::cmd sl@0: } -cleanup { sl@0: namespace delete one two three sl@0: } -returnCodes error -match glob -result {import pattern * would create a loop*} sl@0: sl@0: test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace forget xyzzy::*} msg] $msg sl@0: } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}} sl@0: test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} { sl@0: namespace eval test_ns_export { sl@0: namespace export cmd1 sl@0: proc cmd1 {args} {return "cmd1: $args"} sl@0: proc cmd2 {args} {return "cmd2: $args"} sl@0: } sl@0: namespace eval test_ns_import { sl@0: namespace forget ::test_ns_export::wombat sl@0: } sl@0: } {} sl@0: test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} { sl@0: namespace eval test_ns_import { sl@0: namespace import ::test_ns_export::* sl@0: proc p {} {return [cmd1 123]} sl@0: set l {} sl@0: lappend l [lsort [info commands ::test_ns_import::*]] sl@0: namespace forget ::test_ns_export::cmd1 sl@0: lappend l [info commands ::test_ns_import::*] sl@0: lappend l [catch {cmd1 777} msg] $msg sl@0: } sl@0: } [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}] sl@0: sl@0: test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup { sl@0: namespace eval origin { sl@0: namespace export cmd sl@0: proc cmd {} {} sl@0: } sl@0: namespace eval unrelated { sl@0: proc cmd {} {} sl@0: } sl@0: namespace eval my \ sl@0: [list namespace import [namespace current]::origin::cmd] sl@0: } -body { sl@0: namespace eval my \ sl@0: [list namespace forget [namespace current]::unrelated::cmd] sl@0: my::cmd sl@0: } -cleanup { sl@0: namespace delete origin unrelated my sl@0: } sl@0: sl@0: test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup { sl@0: namespace eval origin { sl@0: namespace export cmd sl@0: proc cmd {} {} sl@0: } sl@0: namespace eval my \ sl@0: [list namespace import [namespace current]::origin::cmd] sl@0: namespace eval my rename cmd newname sl@0: } -body { sl@0: namespace eval my \ sl@0: [list namespace forget [namespace current]::origin::cmd] sl@0: my::newname sl@0: } -cleanup { sl@0: namespace delete origin my sl@0: } -returnCodes error -match glob -result * sl@0: sl@0: test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup { sl@0: namespace eval origin { sl@0: namespace export cmd sl@0: proc cmd {} {} sl@0: } sl@0: namespace eval my \ sl@0: [list namespace import [namespace current]::origin::cmd] sl@0: namespace eval your {} sl@0: namespace eval my \ sl@0: [list rename cmd [namespace current]::your::newname] sl@0: } -body { sl@0: namespace eval your namespace forget newname sl@0: your::newname sl@0: } -cleanup { sl@0: namespace delete origin my your sl@0: } -returnCodes error -match glob -result * sl@0: sl@0: test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup { sl@0: namespace eval origin { sl@0: namespace export cmd sl@0: proc cmd {} {} sl@0: } sl@0: namespace eval link namespace export cmd sl@0: namespace eval link \ sl@0: [list namespace import [namespace current]::origin::cmd] sl@0: namespace eval link2 namespace export cmd sl@0: namespace eval link2 \ sl@0: [list namespace import [namespace current]::link::cmd] sl@0: namespace eval my \ sl@0: [list namespace import [namespace current]::link2::cmd] sl@0: } -body { sl@0: namespace eval my \ sl@0: [list namespace forget [namespace current]::origin::cmd] sl@0: my::cmd sl@0: } -cleanup { sl@0: namespace delete origin link link2 my sl@0: } -returnCodes error -match glob -result * sl@0: sl@0: test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup { sl@0: namespace eval origin { sl@0: namespace export cmd sl@0: proc cmd {} {} sl@0: } sl@0: namespace eval link namespace export cmd sl@0: namespace eval link \ sl@0: [list namespace import [namespace current]::origin::cmd] sl@0: namespace eval link2 namespace export cmd sl@0: namespace eval link2 \ sl@0: [list namespace import [namespace current]::link::cmd] sl@0: namespace eval my \ sl@0: [list namespace import [namespace current]::link2::cmd] sl@0: } -body { sl@0: namespace eval my \ sl@0: [list namespace forget [namespace current]::link::cmd] sl@0: my::cmd sl@0: } -cleanup { sl@0: namespace delete origin link link2 my sl@0: } sl@0: sl@0: test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup { sl@0: namespace eval origin { sl@0: namespace export cmd sl@0: proc cmd {} {} sl@0: } sl@0: namespace eval link namespace export cmd sl@0: namespace eval link \ sl@0: [list namespace import [namespace current]::origin::cmd] sl@0: namespace eval link2 namespace export cmd sl@0: namespace eval link2 \ sl@0: [list namespace import [namespace current]::link::cmd] sl@0: namespace eval my \ sl@0: [list namespace import [namespace current]::link2::cmd] sl@0: } -body { sl@0: namespace eval my \ sl@0: [list namespace forget [namespace current]::link2::cmd] sl@0: my::cmd sl@0: } -cleanup { sl@0: namespace delete origin link link2 my sl@0: } -returnCodes error -match glob -result * sl@0: sl@0: test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_export { sl@0: namespace export cmd1 sl@0: proc cmd1 {args} {return "cmd1: $args"} sl@0: } sl@0: list [namespace origin set] [namespace origin test_ns_export::cmd1] sl@0: } {::set ::test_ns_export::cmd1} sl@0: test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} { sl@0: namespace eval test_ns_import1 { sl@0: namespace import ::test_ns_export::* sl@0: namespace export * sl@0: proc p {} {namespace origin cmd1} sl@0: } sl@0: list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1] sl@0: } {::test_ns_export::cmd1 ::test_ns_export::cmd1} sl@0: test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} { sl@0: namespace eval test_ns_import2 { sl@0: namespace import ::test_ns_import1::* sl@0: proc q {} {return [cmd1 123]} sl@0: } sl@0: list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1] sl@0: } {{cmd1: 123} ::test_ns_export::cmd1} sl@0: sl@0: test namespace-12.1 {InvokeImportedCmd} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_export { sl@0: namespace export cmd1 sl@0: proc cmd1 {args} {namespace current} sl@0: } sl@0: namespace eval test_ns_import { sl@0: namespace import ::test_ns_export::* sl@0: } sl@0: list [test_ns_import::cmd1] sl@0: } {::test_ns_export} sl@0: sl@0: test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} { sl@0: namespace eval test_ns_import { sl@0: set l {} sl@0: lappend l [info commands ::test_ns_import::*] sl@0: namespace forget ::test_ns_export::cmd1 sl@0: lappend l [info commands ::test_ns_import::*] sl@0: } sl@0: } {::test_ns_import::cmd1 {}} sl@0: sl@0: test namespace-14.1 {TclGetNamespaceForQualName, absolute names} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: variable v 10 sl@0: namespace eval test_ns_1::test_ns_2 { sl@0: variable v 20 sl@0: } sl@0: namespace eval test_ns_2 { sl@0: variable v 30 sl@0: } sl@0: namespace eval test_ns_1 { sl@0: list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \ sl@0: [lsort [namespace children :: test_ns_*]] sl@0: } sl@0: } [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]] sl@0: test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} { sl@0: namespace eval test_ns_1 { sl@0: list [catch {set ::test_ns_777::v} msg] $msg \ sl@0: [catch {namespace children test_ns_777} msg] $msg sl@0: } sl@0: } {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}} sl@0: test namespace-14.3 {TclGetNamespaceForQualName, relative names} { sl@0: namespace eval test_ns_1 { sl@0: list $v $test_ns_2::v sl@0: } sl@0: } {10 20} sl@0: test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { sl@0: namespace eval test_ns_1::test_ns_2 { sl@0: namespace eval foo {} sl@0: } sl@0: namespace eval test_ns_1 { sl@0: list [namespace children test_ns_2] \ sl@0: [catch {namespace children test_ns_1} msg] $msg sl@0: } sl@0: } {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}} sl@0: test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { sl@0: namespace eval ::test_ns_2 { sl@0: namespace eval bar {} sl@0: } sl@0: namespace eval test_ns_1 { sl@0: set l [list [catch {namespace delete test_ns_2::bar} msg] $msg] sl@0: } sl@0: set l sl@0: } {1 {unknown namespace "test_ns_2::bar" in namespace delete command}} sl@0: test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { sl@0: namespace eval test_ns_1::test_ns_2 { sl@0: namespace eval foo {} sl@0: } sl@0: namespace eval test_ns_1 { sl@0: list [namespace children test_ns_2] \ sl@0: [catch {namespace children test_ns_1} msg] $msg sl@0: } sl@0: } {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}} sl@0: test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} { sl@0: namespace children test_ns_1::: sl@0: } {::test_ns_1::test_ns_2} sl@0: test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} { sl@0: namespace children :::test_ns_1:::::test_ns_2::: sl@0: } {::test_ns_1::test_ns_2::foo} sl@0: test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} { sl@0: set l {} sl@0: lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg sl@0: namespace eval test_ns_1::test_ns_2 {variable {} 2525} sl@0: lappend l [set test_ns_1::test_ns_2::] sl@0: } {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525} sl@0: test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} { sl@0: catch {unset test_ns_1::test_ns_2::} sl@0: set l {} sl@0: lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg sl@0: set test_ns_1::test_ns_2:: 314159 sl@0: lappend l [set test_ns_1::test_ns_2::] sl@0: } {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159} sl@0: test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} { sl@0: catch {rename test_ns_1::test_ns_2:: {}} sl@0: set l {} sl@0: lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg sl@0: proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"} sl@0: lappend l [test_ns_1::test_ns_2:: hello] sl@0: } {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}} sl@0: test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_1 { sl@0: variable {} sl@0: set test_ns_1::(x) y sl@0: } sl@0: set test_ns_1::(x) sl@0: } y sl@0: test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg sl@0: } {1 {can't create namespace "": only global namespace can have empty name}} sl@0: sl@0: test namespace-15.1 {Tcl_FindNamespace, absolute name found} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_delete { sl@0: namespace eval test_ns_delete2 {} sl@0: proc cmd {args} {namespace current} sl@0: } sl@0: list [namespace delete ::test_ns_delete::test_ns_delete2] \ sl@0: [namespace children ::test_ns_delete] sl@0: } {{} {}} sl@0: test namespace-15.2 {Tcl_FindNamespace, absolute name not found} { sl@0: list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg sl@0: } {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}} sl@0: test namespace-15.3 {Tcl_FindNamespace, relative name found} { sl@0: namespace eval test_ns_delete { sl@0: namespace eval test_ns_delete2 {} sl@0: namespace eval test_ns_delete3 {} sl@0: list [namespace delete test_ns_delete2] \ sl@0: [namespace children [namespace current]] sl@0: } sl@0: } {{} ::test_ns_delete::test_ns_delete3} sl@0: test namespace-15.4 {Tcl_FindNamespace, relative name not found} { sl@0: namespace eval test_ns_delete2 {} sl@0: namespace eval test_ns_delete { sl@0: list [catch {namespace delete test_ns_delete2} msg] $msg sl@0: } sl@0: } {1 {unknown namespace "test_ns_delete2" in namespace delete command}} sl@0: sl@0: test namespace-16.1 {Tcl_FindCommand, absolute name found} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_1 { sl@0: proc cmd {args} {return "[namespace current]::cmd: $args"} sl@0: variable v "::test_ns_1::cmd" sl@0: eval $v one sl@0: } sl@0: } {::test_ns_1::cmd: one} sl@0: test namespace-16.2 {Tcl_FindCommand, absolute name found} { sl@0: eval $test_ns_1::v two sl@0: } {::test_ns_1::cmd: two} sl@0: test namespace-16.3 {Tcl_FindCommand, absolute name not found} { sl@0: namespace eval test_ns_1 { sl@0: variable v2 "::test_ns_1::ladidah" sl@0: list [catch {eval $v2} msg] $msg sl@0: } sl@0: } {1 {invalid command name "::test_ns_1::ladidah"}} sl@0: sl@0: # save the "unknown" proc, which is redefined by the following two tests sl@0: catch {rename unknown unknown.old} sl@0: proc unknown {args} { sl@0: return "unknown: $args" sl@0: } sl@0: test namespace-16.4 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} { sl@0: ::test_ns_1::foobar x y z sl@0: } {unknown: ::test_ns_1::foobar x y z} sl@0: test namespace-16.5 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} { sl@0: ::foobar 1 2 3 4 5 sl@0: } {unknown: ::foobar 1 2 3 4 5} sl@0: test namespace-16.6 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} { sl@0: test_ns_1::foobar x y z sl@0: } {unknown: test_ns_1::foobar x y z} sl@0: test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} { sl@0: foobar 1 2 3 4 5 sl@0: } {unknown: foobar 1 2 3 4 5} sl@0: # restore the "unknown" proc saved previously sl@0: catch {rename unknown {}} sl@0: catch {rename unknown.old unknown} sl@0: sl@0: test namespace-16.8 {Tcl_FindCommand, relative name found} { sl@0: namespace eval test_ns_1 { sl@0: cmd a b c sl@0: } sl@0: } {::test_ns_1::cmd: a b c} sl@0: test namespace-16.9 {Tcl_FindCommand, relative name found} { sl@0: catch {rename cmd2 {}} sl@0: proc cmd2 {args} {return "[namespace current]::cmd2: $args"} sl@0: namespace eval test_ns_1 { sl@0: cmd2 a b c sl@0: } sl@0: } {::::cmd2: a b c} sl@0: test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} { sl@0: namespace eval test_ns_1 { sl@0: proc cmd2 {args} { sl@0: return "[namespace current]::cmd2 in test_ns_1: $args" sl@0: } sl@0: namespace eval test_ns_12 { sl@0: cmd2 a b c sl@0: } sl@0: } sl@0: } {::::cmd2: a b c} sl@0: test namespace-16.11 {Tcl_FindCommand, relative name not found} { sl@0: namespace eval test_ns_1 { sl@0: list [catch {cmd3 a b c} msg] $msg sl@0: } sl@0: } {1 {invalid command name "cmd3"}} sl@0: sl@0: catch {unset x} sl@0: test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: set x 314159 sl@0: namespace eval test_ns_1 { sl@0: set ::x sl@0: } sl@0: } {314159} sl@0: test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} { sl@0: namespace eval test_ns_1 { sl@0: variable x 777 sl@0: set ::test_ns_1::x sl@0: } sl@0: } {777} sl@0: test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} { sl@0: namespace eval test_ns_1 { sl@0: namespace eval test_ns_2 { sl@0: variable x 1111 sl@0: } sl@0: set ::test_ns_1::test_ns_2::x sl@0: } sl@0: } {1111} sl@0: test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} { sl@0: namespace eval test_ns_1 { sl@0: namespace eval test_ns_2 { sl@0: variable x 1111 sl@0: } sl@0: list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg sl@0: } sl@0: } {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}} sl@0: test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} { sl@0: namespace eval test_ns_1 { sl@0: namespace eval test_ns_3 { sl@0: variable ::test_ns_1::test_ns_2::x 2222 sl@0: } sl@0: } sl@0: set ::test_ns_1::test_ns_2::x sl@0: } {2222} sl@0: test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} { sl@0: namespace eval test_ns_1 { sl@0: set x sl@0: } sl@0: } {777} sl@0: test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} { sl@0: namespace eval test_ns_1 { sl@0: unset x sl@0: set x ;# must be global x now sl@0: } sl@0: } {314159} sl@0: test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} { sl@0: namespace eval test_ns_1 { sl@0: list [catch {set wuzzat} msg] $msg sl@0: } sl@0: } {1 {can't read "wuzzat": no such variable}} sl@0: test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} { sl@0: namespace eval test_ns_1 { sl@0: variable a hello sl@0: } sl@0: set test_ns_1::a sl@0: } {hello} sl@0: catch {unset x} sl@0: sl@0: catch {unset l} sl@0: catch {rename foo {}} sl@0: test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: proc foo {} {return "global foo"} sl@0: namespace eval test_ns_1 { sl@0: proc trigger {} { sl@0: return [foo] sl@0: } sl@0: } sl@0: set l "" sl@0: lappend l [test_ns_1::trigger] sl@0: namespace eval test_ns_1 { sl@0: # force invalidation of cached ref to "foo" in proc trigger sl@0: proc foo {} {return "foo in test_ns_1"} sl@0: } sl@0: lappend l [test_ns_1::trigger] sl@0: set l sl@0: } {{global foo} {foo in test_ns_1}} sl@0: test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} { sl@0: namespace eval test_ns_2 { sl@0: proc foo {} {return "foo in ::test_ns_2"} sl@0: } sl@0: namespace eval test_ns_1 { sl@0: namespace eval test_ns_2 {} sl@0: proc trigger {} { sl@0: return [test_ns_2::foo] sl@0: } sl@0: } sl@0: set l "" sl@0: lappend l [test_ns_1::trigger] sl@0: namespace eval test_ns_1 { sl@0: namespace eval test_ns_2 { sl@0: # force invalidation of cached ref to "foo" in proc trigger sl@0: proc foo {} {return "foo in ::test_ns_1::test_ns_2"} sl@0: } sl@0: } sl@0: lappend l [test_ns_1::trigger] sl@0: set l sl@0: } {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}} sl@0: catch {unset l} sl@0: catch {rename foo {}} sl@0: sl@0: test namespace-19.1 {GetNamespaceFromObj, global name found} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_1::test_ns_2 {} sl@0: namespace children ::test_ns_1 sl@0: } {::test_ns_1::test_ns_2} sl@0: test namespace-19.2 {GetNamespaceFromObj, relative name found} { sl@0: namespace eval test_ns_1 { sl@0: namespace children test_ns_2 sl@0: } sl@0: } {} sl@0: test namespace-19.3 {GetNamespaceFromObj, name not found} { sl@0: namespace eval test_ns_1 { sl@0: list [catch {namespace children test_ns_99} msg] $msg sl@0: } sl@0: } {1 {unknown namespace "test_ns_99" in namespace children command}} sl@0: test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} { sl@0: namespace eval test_ns_1 { sl@0: proc foo {} { sl@0: return [namespace children test_ns_2] sl@0: } sl@0: list [catch {namespace children test_ns_99} msg] $msg sl@0: } sl@0: set l {} sl@0: lappend l [test_ns_1::foo] sl@0: namespace delete test_ns_1::test_ns_2 sl@0: namespace eval test_ns_1::test_ns_2::test_ns_3 {} sl@0: lappend l [test_ns_1::foo] sl@0: set l sl@0: } {{} ::test_ns_1::test_ns_2::test_ns_3} sl@0: sl@0: test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace} msg] $msg sl@0: } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}} sl@0: test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} { sl@0: list [catch {namespace wombat {}} msg] $msg sl@0: } {1 {bad option "wombat": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}} sl@0: test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} { sl@0: namespace ch :: test_ns_* sl@0: } {} sl@0: sl@0: test namespace-21.1 {NamespaceChildrenCmd, no args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_1::test_ns_2 {} sl@0: expr {[string first ::test_ns_1 [namespace children]] != -1} sl@0: } {1} sl@0: test namespace-21.2 {NamespaceChildrenCmd, no args} { sl@0: namespace eval test_ns_1 { sl@0: namespace children sl@0: } sl@0: } {::test_ns_1::test_ns_2} sl@0: test namespace-21.3 {NamespaceChildrenCmd, ns name given} { sl@0: namespace children ::test_ns_1 sl@0: } {::test_ns_1::test_ns_2} sl@0: test namespace-21.4 {NamespaceChildrenCmd, ns name given} { sl@0: namespace eval test_ns_1 { sl@0: namespace children test_ns_2 sl@0: } sl@0: } {} sl@0: test namespace-21.5 {NamespaceChildrenCmd, too many args} { sl@0: namespace eval test_ns_1 { sl@0: list [catch {namespace children test_ns_2 xxx yyy} msg] $msg sl@0: } sl@0: } {1 {wrong # args: should be "namespace children ?name? ?pattern?"}} sl@0: test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} { sl@0: namespace eval test_ns_1::test_ns_foo {} sl@0: namespace children test_ns_1 *f* sl@0: } {::test_ns_1::test_ns_foo} sl@0: test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} { sl@0: namespace eval test_ns_1::test_ns_foo {} sl@0: lsort [namespace children test_ns_1 test*] sl@0: } [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}] sl@0: sl@0: test namespace-22.1 {NamespaceCodeCmd, bad args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace code} msg] $msg \ sl@0: [catch {namespace code xxx yyy} msg] $msg sl@0: } {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}} sl@0: test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} { sl@0: namespace eval test_ns_1 { sl@0: proc cmd {} {return "test_ns_1::cmd"} sl@0: } sl@0: namespace code {namespace inscope ::test_ns_1 cmd} sl@0: } {namespace inscope ::test_ns_1 cmd} sl@0: test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} { sl@0: namespace code {namespace inscope ::test_ns_1 cmd} sl@0: } {namespace inscope ::test_ns_1 cmd} sl@0: test namespace-22.4 {NamespaceCodeCmd, in :: namespace} { sl@0: namespace code unknown sl@0: } {::namespace inscope :: unknown} sl@0: test namespace-22.5 {NamespaceCodeCmd, in other namespace} { sl@0: namespace eval test_ns_1 { sl@0: namespace code cmd sl@0: } sl@0: } {::namespace inscope ::test_ns_1 cmd} sl@0: test namespace-22.6 {NamespaceCodeCmd, in other namespace} { sl@0: namespace eval test_ns_1 { sl@0: variable v 42 sl@0: } sl@0: namespace eval test_ns_2 { sl@0: proc namespace args {} sl@0: } sl@0: namespace eval test_ns_2 [namespace eval test_ns_1 { sl@0: namespace code {set v} sl@0: }] sl@0: } {42} sl@0: sl@0: test namespace-23.1 {NamespaceCurrentCmd, bad args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace current xxx} msg] $msg \ sl@0: [catch {namespace current xxx yyy} msg] $msg sl@0: } {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}} sl@0: test namespace-23.2 {NamespaceCurrentCmd, at global level} { sl@0: namespace current sl@0: } {::} sl@0: test namespace-23.3 {NamespaceCurrentCmd, in nested ns} { sl@0: namespace eval test_ns_1::test_ns_2 { sl@0: namespace current sl@0: } sl@0: } {::test_ns_1::test_ns_2} sl@0: sl@0: test namespace-24.1 {NamespaceDeleteCmd, no args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace delete sl@0: } {} sl@0: test namespace-24.2 {NamespaceDeleteCmd, one arg} { sl@0: namespace eval test_ns_1::test_ns_2 {} sl@0: namespace delete ::test_ns_1 sl@0: } {} sl@0: test namespace-24.3 {NamespaceDeleteCmd, two args} { sl@0: namespace eval test_ns_1::test_ns_2 {} sl@0: list [namespace delete ::test_ns_1::test_ns_2] [namespace delete ::test_ns_1] sl@0: } {{} {}} sl@0: test namespace-24.4 {NamespaceDeleteCmd, unknown ns} { sl@0: list [catch {namespace delete ::test_ns_foo} msg] $msg sl@0: } {1 {unknown namespace "::test_ns_foo" in namespace delete command}} sl@0: sl@0: test namespace-25.1 {NamespaceEvalCmd, bad args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace eval} msg] $msg sl@0: } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}} sl@0: test namespace-25.2 {NamespaceEvalCmd, bad args} { sl@0: list [catch {namespace test_ns_1} msg] $msg sl@0: } {1 {bad option "test_ns_1": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}} sl@0: catch {unset v} sl@0: test namespace-25.3 {NamespaceEvalCmd, new namespace} { sl@0: set v 123 sl@0: namespace eval test_ns_1 { sl@0: variable v 314159 sl@0: proc p {} { sl@0: variable v sl@0: return $v sl@0: } sl@0: } sl@0: test_ns_1::p sl@0: } {314159} sl@0: test namespace-25.4 {NamespaceEvalCmd, existing namespace} { sl@0: namespace eval test_ns_1 { sl@0: proc q {} {return [expr {[p]+1}]} sl@0: } sl@0: test_ns_1::q sl@0: } {314160} sl@0: test namespace-25.5 {NamespaceEvalCmd, multiple args} { sl@0: namespace eval test_ns_1 "set" "v" sl@0: } {314159} sl@0: test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} { sl@0: list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $errorInfo sl@0: } {1 {invalid command name "xxxx"} {invalid command name "xxxx" sl@0: while executing sl@0: "xxxx" sl@0: (in namespace eval "::test_ns_1" script line 1) sl@0: invoked from within sl@0: "namespace eval test_ns_1 {xxxx}"}} sl@0: test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} { sl@0: list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $errorInfo sl@0: } {1 foo {bar sl@0: (in namespace eval "::test_ns_1" script line 1) sl@0: invoked from within sl@0: "namespace eval test_ns_1 {error foo bar baz}"}} sl@0: test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} knownBug { sl@0: list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $errorInfo sl@0: } {1 foo {bar sl@0: (in namespace eval "::test_ns_1" script line 1) sl@0: invoked from within sl@0: "namespace eval test_ns_1 error foo bar baz"}} sl@0: catch {unset v} sl@0: test namespace-25.9 {NamespaceEvalCmd, 545325} { sl@0: namespace eval test_ns_1 info level 0 sl@0: } {namespace eval test_ns_1 info level 0} sl@0: sl@0: test namespace-26.1 {NamespaceExportCmd, no args and new ns} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace export sl@0: } {} sl@0: test namespace-26.2 {NamespaceExportCmd, just -clear arg} { sl@0: namespace export -clear sl@0: } {} sl@0: test namespace-26.3 {NamespaceExportCmd, pattern can't specify a namespace} { sl@0: namespace eval test_ns_1 { sl@0: list [catch {namespace export ::zzz} msg] $msg sl@0: } sl@0: } {1 {invalid export pattern "::zzz": pattern can't specify a namespace}} sl@0: test namespace-26.4 {NamespaceExportCmd, one pattern} { sl@0: namespace eval test_ns_1 { sl@0: namespace export cmd1 sl@0: proc cmd1 {args} {return "cmd1: $args"} sl@0: proc cmd2 {args} {return "cmd2: $args"} sl@0: proc cmd3 {args} {return "cmd3: $args"} sl@0: proc cmd4 {args} {return "cmd4: $args"} sl@0: } sl@0: namespace eval test_ns_2 { sl@0: namespace import ::test_ns_1::* sl@0: } sl@0: list [info commands test_ns_2::*] [test_ns_2::cmd1 hello] sl@0: } {::test_ns_2::cmd1 {cmd1: hello}} sl@0: test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} { sl@0: namespace eval test_ns_1 { sl@0: namespace export cmd1 cmd3 sl@0: } sl@0: namespace eval test_ns_2 { sl@0: namespace import -force ::test_ns_1::* sl@0: } sl@0: list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello] sl@0: } [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}] sl@0: test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} { sl@0: namespace eval test_ns_1 { sl@0: namespace export sl@0: } sl@0: } {cmd1 cmd3} sl@0: test namespace-26.7 {NamespaceExportCmd, -clear resets export list} { sl@0: namespace eval test_ns_1 { sl@0: namespace export -clear cmd4 sl@0: } sl@0: namespace eval test_ns_2 { sl@0: namespace import ::test_ns_1::* sl@0: } sl@0: list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello] sl@0: } [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}] sl@0: sl@0: test namespace-27.1 {NamespaceForgetCmd, no args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace forget sl@0: } {} sl@0: test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} { sl@0: list [catch {namespace forget ::test_ns_1::xxx} msg] $msg sl@0: } {1 {unknown namespace in namespace forget pattern "::test_ns_1::xxx"}} sl@0: test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} { sl@0: namespace eval test_ns_1 { sl@0: namespace export cmd* sl@0: proc cmd1 {args} {return "cmd1: $args"} sl@0: proc cmd2 {args} {return "cmd2: $args"} sl@0: } sl@0: namespace eval test_ns_2 { sl@0: namespace import ::test_ns_1::* sl@0: namespace forget ::test_ns_1::cmd1 sl@0: } sl@0: info commands ::test_ns_2::* sl@0: } {::test_ns_2::cmd2} sl@0: sl@0: test namespace-28.1 {NamespaceImportCmd, no args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace import sl@0: } {} sl@0: test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} { sl@0: namespace import -force sl@0: } {} sl@0: test namespace-28.3 {NamespaceImportCmd, arg is imported} { sl@0: namespace eval test_ns_1 { sl@0: namespace export cmd2 sl@0: proc cmd1 {args} {return "cmd1: $args"} sl@0: proc cmd2 {args} {return "cmd2: $args"} sl@0: } sl@0: namespace eval test_ns_2 { sl@0: namespace import ::test_ns_1::* sl@0: namespace forget ::test_ns_1::cmd1 sl@0: } sl@0: info commands test_ns_2::* sl@0: } {::test_ns_2::cmd2} sl@0: sl@0: test namespace-29.1 {NamespaceInscopeCmd, bad args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace inscope} msg] $msg sl@0: } {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}} sl@0: test namespace-29.2 {NamespaceInscopeCmd, bad args} { sl@0: list [catch {namespace inscope ::} msg] $msg sl@0: } {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}} sl@0: test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} { sl@0: list [catch {namespace inscope test_ns_1 {set v}} msg] $msg sl@0: } {1 {unknown namespace "test_ns_1" in inscope namespace command}} sl@0: test namespace-29.4 {NamespaceInscopeCmd, simple case} { sl@0: namespace eval test_ns_1 { sl@0: variable v 747 sl@0: proc cmd {args} { sl@0: variable v sl@0: return "[namespace current]::cmd: v=$v, args=$args" sl@0: } sl@0: } sl@0: namespace inscope test_ns_1 cmd sl@0: } {::test_ns_1::cmd: v=747, args=} sl@0: test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} { sl@0: list [namespace inscope test_ns_1 cmd x y z] \ sl@0: [namespace eval test_ns_1 [concat cmd [list x y z]]] sl@0: } {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}} sl@0: test namespace-29.6 {NamespaceInscopeCmd, 1400572} knownBug { sl@0: namespace inscope test_ns_1 {info level 0} sl@0: } {namespace inscope test_ns_1 {info level 0}} sl@0: sl@0: sl@0: test namespace-30.1 {NamespaceOriginCmd, bad args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace origin} msg] $msg sl@0: } {1 {wrong # args: should be "namespace origin name"}} sl@0: test namespace-30.2 {NamespaceOriginCmd, bad args} { sl@0: list [catch {namespace origin x y} msg] $msg sl@0: } {1 {wrong # args: should be "namespace origin name"}} sl@0: test namespace-30.3 {NamespaceOriginCmd, command not found} { sl@0: list [catch {namespace origin fred} msg] $msg sl@0: } {1 {invalid command name "fred"}} sl@0: test namespace-30.4 {NamespaceOriginCmd, command isn't imported} { sl@0: namespace origin set sl@0: } {::set} sl@0: test namespace-30.5 {NamespaceOriginCmd, imported command} { sl@0: namespace eval test_ns_1 { sl@0: namespace export cmd* sl@0: proc cmd1 {args} {return "cmd1: $args"} sl@0: proc cmd2 {args} {return "cmd2: $args"} sl@0: } sl@0: namespace eval test_ns_2 { sl@0: namespace export * sl@0: namespace import ::test_ns_1::* sl@0: proc p {} {} sl@0: } sl@0: namespace eval test_ns_3 { sl@0: namespace import ::test_ns_2::* sl@0: list [namespace origin foreach] \ sl@0: [namespace origin p] \ sl@0: [namespace origin cmd1] \ sl@0: [namespace origin ::test_ns_2::cmd2] sl@0: } sl@0: } {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2} sl@0: sl@0: test namespace-31.1 {NamespaceParentCmd, bad args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace parent a b} msg] $msg sl@0: } {1 {wrong # args: should be "namespace parent ?name?"}} sl@0: test namespace-31.2 {NamespaceParentCmd, no args} { sl@0: namespace parent sl@0: } {} sl@0: test namespace-31.3 {NamespaceParentCmd, namespace specified} { sl@0: namespace eval test_ns_1 { sl@0: namespace eval test_ns_2 { sl@0: namespace eval test_ns_3 {} sl@0: } sl@0: } sl@0: list [namespace parent ::] \ sl@0: [namespace parent test_ns_1::test_ns_2] \ sl@0: [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}] sl@0: } {{} ::test_ns_1 ::test_ns_1} sl@0: test namespace-31.4 {NamespaceParentCmd, bad namespace specified} { sl@0: list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg sl@0: } {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}} sl@0: sl@0: test namespace-32.1 {NamespaceQualifiersCmd, bad args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace qualifiers} msg] $msg sl@0: } {1 {wrong # args: should be "namespace qualifiers string"}} sl@0: test namespace-32.2 {NamespaceQualifiersCmd, bad args} { sl@0: list [catch {namespace qualifiers x y} msg] $msg sl@0: } {1 {wrong # args: should be "namespace qualifiers string"}} sl@0: test namespace-32.3 {NamespaceQualifiersCmd, simple name} { sl@0: namespace qualifiers foo sl@0: } {} sl@0: test namespace-32.4 {NamespaceQualifiersCmd, leading ::} { sl@0: namespace qualifiers ::x::y::z sl@0: } {::x::y} sl@0: test namespace-32.5 {NamespaceQualifiersCmd, no leading ::} { sl@0: namespace qualifiers a::b sl@0: } {a} sl@0: test namespace-32.6 {NamespaceQualifiersCmd, :: argument} { sl@0: namespace qualifiers :: sl@0: } {} sl@0: test namespace-32.7 {NamespaceQualifiersCmd, odd number of :s} { sl@0: namespace qualifiers ::::: sl@0: } {} sl@0: test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} { sl@0: namespace qualifiers foo::: sl@0: } {foo} sl@0: sl@0: test namespace-33.1 {NamespaceTailCmd, bad args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace tail} msg] $msg sl@0: } {1 {wrong # args: should be "namespace tail string"}} sl@0: test namespace-33.2 {NamespaceTailCmd, bad args} { sl@0: list [catch {namespace tail x y} msg] $msg sl@0: } {1 {wrong # args: should be "namespace tail string"}} sl@0: test namespace-33.3 {NamespaceTailCmd, simple name} { sl@0: namespace tail foo sl@0: } {foo} sl@0: test namespace-33.4 {NamespaceTailCmd, leading ::} { sl@0: namespace tail ::x::y::z sl@0: } {z} sl@0: test namespace-33.5 {NamespaceTailCmd, no leading ::} { sl@0: namespace tail a::b sl@0: } {b} sl@0: test namespace-33.6 {NamespaceTailCmd, :: argument} { sl@0: namespace tail :: sl@0: } {} sl@0: test namespace-33.7 {NamespaceTailCmd, odd number of :s} { sl@0: namespace tail ::::: sl@0: } {} sl@0: test namespace-33.8 {NamespaceTailCmd, odd number of :s} { sl@0: namespace tail foo::: sl@0: } {} sl@0: sl@0: test namespace-34.1 {NamespaceWhichCmd, bad args} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: list [catch {namespace which} msg] $msg sl@0: } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} sl@0: test namespace-34.2 {NamespaceWhichCmd, bad args} { sl@0: list [catch {namespace which -fred} msg] $msg sl@0: } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} sl@0: test namespace-34.3 {NamespaceWhichCmd, bad args} { sl@0: list [catch {namespace which -command} msg] $msg sl@0: } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} sl@0: test namespace-34.4 {NamespaceWhichCmd, bad args} { sl@0: list [catch {namespace which a b} msg] $msg sl@0: } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}} sl@0: test namespace-34.5 {NamespaceWhichCmd, command lookup} { sl@0: namespace eval test_ns_1 { sl@0: namespace export cmd* sl@0: variable v1 111 sl@0: proc cmd1 {args} {return "cmd1: $args"} sl@0: proc cmd2 {args} {return "cmd2: $args"} sl@0: } sl@0: namespace eval test_ns_2 { sl@0: namespace export * sl@0: namespace import ::test_ns_1::* sl@0: variable v2 222 sl@0: proc p {} {} sl@0: } sl@0: namespace eval test_ns_3 { sl@0: namespace import ::test_ns_2::* sl@0: variable v3 333 sl@0: list [namespace which -command foreach] \ sl@0: [namespace which -command p] \ sl@0: [namespace which -command cmd1] \ sl@0: [namespace which -command ::test_ns_2::cmd2] \ sl@0: [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg sl@0: } sl@0: } {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}} sl@0: test namespace-34.6 {NamespaceWhichCmd, -command is default} { sl@0: namespace eval test_ns_3 { sl@0: list [namespace which foreach] \ sl@0: [namespace which p] \ sl@0: [namespace which cmd1] \ sl@0: [namespace which ::test_ns_2::cmd2] sl@0: } sl@0: } {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2} sl@0: test namespace-34.7 {NamespaceWhichCmd, variable lookup} { sl@0: namespace eval test_ns_3 { sl@0: list [namespace which -variable env] \ sl@0: [namespace which -variable v3] \ sl@0: [namespace which -variable ::test_ns_2::v2] \ sl@0: [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg sl@0: } sl@0: } {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}} sl@0: sl@0: test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_1 { sl@0: proc p {} { sl@0: namespace delete [namespace current] sl@0: return [namespace current] sl@0: } sl@0: } sl@0: test_ns_1::p sl@0: } {::test_ns_1} sl@0: test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} { sl@0: namespace eval test_ns_1 { sl@0: proc q {} { sl@0: return [namespace current] sl@0: } sl@0: } sl@0: list [test_ns_1::q] \ sl@0: [namespace delete test_ns_1] \ sl@0: [catch {test_ns_1::q} msg] $msg sl@0: } {::test_ns_1 {} 1 {invalid command name "test_ns_1::q"}} sl@0: sl@0: catch {unset x} sl@0: catch {unset y} sl@0: test namespace-36.1 {DupNsNameInternalRep} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_1 {} sl@0: set x "::test_ns_1" sl@0: list [namespace parent $x] [set y $x] [namespace parent $y] sl@0: } {:: ::test_ns_1 ::} sl@0: catch {unset x} sl@0: catch {unset y} sl@0: sl@0: test namespace-37.1 {SetNsNameFromAny, ns name found} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval test_ns_1::test_ns_2 {} sl@0: namespace eval test_ns_1 { sl@0: namespace children ::test_ns_1 sl@0: } sl@0: } {::test_ns_1::test_ns_2} sl@0: test namespace-37.2 {SetNsNameFromAny, ns name not found} { sl@0: namespace eval test_ns_1 { sl@0: list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg sl@0: } sl@0: } {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}} sl@0: sl@0: test namespace-38.1 {UpdateStringOfNsName} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name sl@0: list [namespace eval {} {namespace current}] \ sl@0: [namespace eval {} {namespace current}] sl@0: } {:: ::} sl@0: sl@0: test namespace-39.1 {NamespaceExistsCmd} { sl@0: catch {eval namespace delete [namespace children :: test_ns_*]} sl@0: namespace eval ::test_ns_z::test_me { variable foo } sl@0: list [namespace exists ::] \ sl@0: [namespace exists ::bogus_namespace] \ sl@0: [namespace exists ::test_ns_z] \ sl@0: [namespace exists test_ns_z] \ sl@0: [namespace exists ::test_ns_z::foo] \ sl@0: [namespace exists ::test_ns_z::test_me] \ sl@0: [namespace eval ::test_ns_z { namespace exists ::test_me }] \ sl@0: [namespace eval ::test_ns_z { namespace exists test_me }] \ sl@0: [namespace exists :::::test_ns_z] sl@0: } {1 0 1 1 0 1 0 1 1} sl@0: test namespace-39.2 {NamespaceExistsCmd error} { sl@0: list [catch {namespace exists} msg] $msg sl@0: } {1 {wrong # args: should be "namespace exists name"}} sl@0: test namespace-39.3 {NamespaceExistsCmd error} { sl@0: list [catch {namespace exists a b} msg] $msg sl@0: } {1 {wrong # args: should be "namespace exists name"}} sl@0: sl@0: test namespace-40.1 {Ignoring namespace proc "unknown"} { sl@0: rename unknown _unknown sl@0: proc unknown args {return global} sl@0: namespace eval ns {proc unknown args {return local}} sl@0: set l [list [namespace eval ns aaa bbb] [namespace eval ns aaa]] sl@0: rename unknown {} sl@0: rename _unknown unknown sl@0: namespace delete ns sl@0: set l sl@0: } {global global} sl@0: sl@0: test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} { sl@0: set res {} sl@0: namespace eval ns { sl@0: set res {} sl@0: proc test {} { sl@0: set ::g 0 sl@0: } sl@0: lappend ::res [test] sl@0: proc set {a b} { sl@0: ::set a [incr b] sl@0: } sl@0: lappend ::res [test] sl@0: } sl@0: namespace delete ns sl@0: set res sl@0: } {0 1} sl@0: sl@0: test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} { sl@0: set res {} sl@0: namespace eval ns {} sl@0: proc ns::a {i} { sl@0: variable b sl@0: proc set args {return "New proc is called"} sl@0: return [set b $i] sl@0: } sl@0: ns::a 1 sl@0: set res [ns::a 2] sl@0: namespace delete ns sl@0: set res sl@0: } {New proc is called} sl@0: sl@0: test namespace-41.3 {Shadowing byte-compiled commands, Bug: 231259} {knownBug} { sl@0: set res {} sl@0: namespace eval ns { sl@0: variable b 0 sl@0: } sl@0: sl@0: proc ns::a {i} { sl@0: variable b sl@0: proc set args {return "New proc is called"} sl@0: return [set b $i] sl@0: } sl@0: sl@0: set res [list [ns::a 1] $ns::b] sl@0: namespace delete ns sl@0: set res sl@0: } {{New proc is called} 0} sl@0: sl@0: # cleanup sl@0: catch {rename cmd1 {}} sl@0: catch {unset l} sl@0: catch {unset msg} sl@0: catch {unset trigger} sl@0: eval namespace delete [namespace children :: test_ns_*] sl@0: ::tcltest::cleanupTests sl@0: return sl@0: sl@0: sl@0: sl@0: sl@0: sl@0: sl@0: sl@0: sl@0: sl@0: sl@0: sl@0: