diff options
Diffstat (limited to 'tests/namespace.test')
| -rw-r--r-- | tests/namespace.test | 134 |
1 files changed, 76 insertions, 58 deletions
diff --git a/tests/namespace.test b/tests/namespace.test index c1aef53..1d46bf0 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -1,25 +1,24 @@ # 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. +# procedures in tclNamesp.c and tclEnsemble.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. +# 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.78 2010/01/10 16:51:25 dkf Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +package require tcltest 2 +namespace import -force ::tcltest::* testConstraint memory [llength [info commands memory]] +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # # REMARK: the tests for 'namespace upvar' are not done here. They are to be # found in the file 'upvar.test'. @@ -27,6 +26,12 @@ testConstraint memory [llength [info commands memory]] # Clear out any namespaces called test_ns_* catch {namespace delete {*}[namespace children :: test_ns_*]} + +proc fq {ns} { + if {[string match ::* $ns]} {return $ns} + set current [uplevel 1 {namespace current}] + return [string trimright $current :]::[string trimleft $ns :] +} test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} { namespace children :: test_ns_* @@ -47,7 +52,6 @@ test namespace-2.2 {Tcl_GetCurrentNamespace} { } } lappend l [namespace current] - set l } {:: ::test_ns_1 ::test_ns_1::foo ::} test namespace-3.1 {Tcl_GetGlobalNamespace} { @@ -594,9 +598,8 @@ test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up onl namespace eval bar {} } namespace eval test_ns_1 { - set l [list [catch {namespace delete test_ns_2::bar} msg] $msg] + 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 { @@ -815,7 +818,7 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} { set a 0 namespace eval test_ns_1 set a 1 namespace delete test_ns_1 - set a + return $a } 1 catch {unset a} catch {unset x} @@ -837,7 +840,6 @@ test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadow 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 { @@ -858,7 +860,6 @@ test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shado } } 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 {}} @@ -890,7 +891,6 @@ test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} { 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} { @@ -899,7 +899,7 @@ test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} { } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}} test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body { namespace wombat {} -} -returnCodes error -match glob -result {bad option "wombat": must be *} +} -returnCodes error -match glob -result {unknown or ambiguous subcommand "wombat": must be *} test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} { namespace ch :: test_ns_* } {} @@ -937,9 +937,8 @@ test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} { } [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}] test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} { namespace eval test_ns_1 {} - namespace children [namespace current] \ - [string trimright [namespace current] :]::test_ns_1 -} [string trimright [namespace current] :]::test_ns_1 + namespace children [namespace current] [fq test_ns_1] +} [fq test_ns_1] test namespace-22.1 {NamespaceCodeCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} @@ -950,11 +949,11 @@ 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} + 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} +} {::namespace inscope :: {namespace inscope ::test_ns_1 cmd}} test namespace-22.4 {NamespaceCodeCmd, in :: namespace} { namespace code unknown } {::namespace inscope :: unknown} @@ -974,6 +973,12 @@ test namespace-22.6 {NamespaceCodeCmd, in other namespace} { namespace code {set v} }] } {42} +test namespace-22.7 {NamespaceCodeCmd, Bug 3202171} { + namespace eval demo { + proc namespace args {puts $args} + ::namespace code {namespace inscope foo} + } +} [list ::namespace inscope [fq demo] {namespace inscope foo}] test namespace-23.1 {NamespaceCurrentCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} @@ -1011,7 +1016,7 @@ test namespace-25.1 {NamespaceEvalCmd, bad args} { } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}} test namespace-25.2 {NamespaceEvalCmd, bad args} -body { namespace test_ns_1 -} -returnCodes error -match glob -result {bad option "test_ns_1": must be *} +} -returnCodes error -match glob -result {unknown or ambiguous subcommand "test_ns_1": must be *} catch {unset v} test namespace-25.3 {NamespaceEvalCmd, new namespace} { set v 123 @@ -1420,16 +1425,17 @@ 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"} { +test namespace-40.1 {Ignoring namespace proc "unknown"} -setup { rename unknown _unknown +} -body { 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]] + list [namespace eval ns aaa bbb] [namespace eval ns aaa] +} -cleanup { rename unknown {} rename _unknown unknown namespace delete ns - set l -} {global global} +} -result {global global} test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} { set res {} @@ -1447,7 +1453,6 @@ test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} { namespace delete ns set res } {0 1} - test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} { set res {} namespace eval ns {} @@ -1461,19 +1466,16 @@ test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} { 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 @@ -1512,18 +1514,18 @@ test namespace-42.3 {ensembles: basic} { 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} { +test namespace-42.4 {ensembles: basic} -body { 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] + list [catch {ns x} msg] $msg +} -cleanup { namespace delete ns - set result -} {1 {unknown subcommand "x": namespace ::ns does not export any commands}} -test namespace-42.5 {ensembles: basic} { +} -result {1 {unknown subcommand "x": namespace ::ns does not export any commands}} +test namespace-42.5 {ensembles: basic} -body { namespace eval ns { namespace export x* proc x1 {} {format 1} @@ -1531,11 +1533,11 @@ test namespace-42.5 {ensembles: basic} { proc x3 {} {format 3} namespace ensemble create } - set result [list [catch {ns x} msg] $msg] + list [catch {ns x} msg] $msg +} -cleanup { namespace delete ns - set result -} {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}} -test namespace-42.6 {ensembles: nested} { +} -result {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}} +test namespace-42.6 {ensembles: nested} -body { namespace eval ns { namespace export x* namespace eval x0 { @@ -1548,11 +1550,11 @@ test namespace-42.6 {ensembles: nested} { proc x3 {} {format 3} namespace ensemble create } - set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]] + list [ns x0 z] [ns x1] [ns x2] [ns x3] +} -cleanup { namespace delete ns - set result -} {0 1 2 3} -test namespace-42.7 {ensembles: nested} { +} -result {0 1 2 3} +test namespace-42.7 {ensembles: nested} -body { namespace eval ns { namespace export x* namespace eval x0 { @@ -1565,10 +1567,10 @@ test namespace-42.7 {ensembles: nested} { proc x3 {} {format 3} namespace ensemble create } - set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]] + list [ns x0 z] [ns x1] [ns x2] [ns x3] +} -cleanup { namespace delete ns - set result -} {{1 ::ns::x0::z} 1 2 3} +} -result {{1 ::ns::x0::z} 1 2 3} test namespace-42.8 {ensembles: [Bug 1670091]} -setup { proc demo args {} variable target [list [namespace which demo] x] @@ -1595,7 +1597,7 @@ test namespace-43.1 {ensembles: dict-driven} { 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} { +test namespace-43.2 {ensembles: dict-driven} -body { namespace eval ns { namespace export x* proc x1 {args} {list 1 $args} @@ -1604,10 +1606,10 @@ test namespace-43.2 {ensembles: dict-driven} { 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]] + list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo] +} -cleanup { namespace delete ns - set result -} {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}} +} -result {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}} set SETUP { namespace eval ns { namespace export a b @@ -2481,7 +2483,7 @@ test namespace-51.16 {Bug 1566526} { test namespace-51.17 {resolution epoch handling: Bug 2898722} -setup { set result {} catch {namespace delete ::a} -} -constraints knownBug -body { +} -body { namespace eval ::a { proc c {} {lappend ::result A} c @@ -2518,6 +2520,22 @@ test namespace-51.17 {resolution epoch handling: Bug 2898722} -setup { catch {rename ::c {}} unset result } -result {A 1 . A A . B B . B B . B B . B B . G G} +test namespace-51.18 {Bug 3185407} -setup { + namespace eval ::test_ns_1 {} +} -body { + namespace eval ::test_ns_1 { + variable result {} + namespace eval ns {proc foo {} {}} + namespace eval ns2 {proc foo {} {}} + namespace path {ns ns2} + variable x foo + lappend result [namespace which $x] + proc foo {} {} + lappend result [namespace which $x] + } +} -cleanup { + namespace delete ::test_ns_1 +} -result {::test_ns_1::ns::foo ::test_ns_1::foo} # TIP 181 - namespace unknown tests test namespace-52.1 {unknown: default handler ::unknown} { @@ -2914,7 +2932,7 @@ test namespace-54.1 {leak on namespace deletion} -constraints {memory} \ rename getbytes {} unset i ns start end } -result 0 - + # cleanup catch {rename cmd1 {}} catch {unset l} |