summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2006-02-01 17:48:04 (GMT)
committerdgp <dgp@users.sourceforge.net>2006-02-01 17:48:04 (GMT)
commit2e9bf45bc4d2510a07a538c48f8103957ede3aaf (patch)
treeded30cb2443dbed838e4a79ea4cf381328c34592 /tests
parent0fbd247a14d17e3925000c394aaa26523bd2fa12 (diff)
downloadtcl-2e9bf45bc4d2510a07a538c48f8103957ede3aaf.zip
tcl-2e9bf45bc4d2510a07a538c48f8103957ede3aaf.tar.gz
tcl-2e9bf45bc4d2510a07a538c48f8103957ede3aaf.tar.bz2
TIP#250 IMPLEMENTATION
* doc/namespace.n: New command [namespace upvar]. [Patch 1275435] * generic/tclInt.h: * generic/tclNamesp.c: * generic/tclVar.c: * tests/namespace.test: * tests/upvar.test:
Diffstat (limited to 'tests')
-rw-r--r--tests/namespace.test19
-rw-r--r--tests/upvar.test48
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