diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/namespace.test | 19 | ||||
| -rw-r--r-- | tests/upvar.test | 48 |
2 files changed, 58 insertions, 9 deletions
diff --git a/tests/namespace.test b/tests/namespace.test index 83cad11..ad7ff10 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -11,13 +11,18 @@ # 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.51 2006/01/18 19:48:11 dgp Exp $ +# RCS: @(#) $Id: namespace.test,v 1.52 2006/02/01 17:48:12 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } +# +# REMARK: the tests for 'namespace upvar' are not done here. They are to be +# found in the file 'upvar.test'. +# + # Clear out any namespaces called test_ns_* catch {namespace delete {expand}[namespace children :: test_ns_*]} @@ -871,9 +876,9 @@ 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, path, qualifiers, tail, or which}} +test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body { + namespace wombat {} +} -returnCodes error -match glob -result {bad option "wombat": must be *} test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} { namespace ch :: test_ns_* } {} @@ -978,9 +983,9 @@ 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, path, qualifiers, tail, or which}} +test namespace-25.2 {NamespaceEvalCmd, bad args} -body { + namespace test_ns_1 +} -returnCodes error -match glob -result {bad option "test_ns_1": must be *} catch {unset v} test namespace-25.3 {NamespaceEvalCmd, new namespace} { set v 123 diff --git a/tests/upvar.test b/tests/upvar.test index 2d100a1..0db9404 100644 --- a/tests/upvar.test +++ b/tests/upvar.test @@ -1,4 +1,4 @@ -# Commands covered: upvar +# Commands covered: 'upvar', 'namespace upvar' # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: upvar.test,v 1.10 2004/05/19 10:46:27 dkf Exp $ +# RCS: @(#) $Id: upvar.test,v 1.11 2006/02/01 17:48:13 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -405,6 +405,50 @@ test upvar-9.7 {Tcl_UpVar procedure} testupvar { } {1234} catch {unset a} + +# +# Tests for 'namespace upvar'. As the implementation is essentially the same as +# for 'upvar', we only test that the variables are linked correctly. Ie, we +# assume that the behaviour of variables once the link is established has +# already been tested above. +# + +# Clear out any namespaces called test_ns_* +catch {namespace delete {expand}[namespace children :: test_ns_*]} + +namespace eval test_ns_0 { + variable x test_ns_0 +} + +namespace eval test_ns_1 { + variable x test_ns_1 +} + +namespace eval test_ns_2 {} + +set x test_global + +test upvar-NS-1.1 {nsupvar links to correct variable} \ + -body { + namespace eval test_ns_2 { + namespace upvar ::test_ns_0 x w + set w + } + } \ + -result {test_ns_0} + +test upvar-NS-1.2 {nsupvar links to correct variable} \ + -body { + namespace eval test_ns_2 { + proc a {} { + namespace upvar ::test_ns_0 x w + set w + } + return [a][rename a {}] + } + } \ + -result {test_ns_0} + # cleanup ::tcltest::cleanupTests return |