summaryrefslogtreecommitdiffstats
path: root/tests/var.test
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-05-19 20:15:29 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-05-19 20:15:29 (GMT)
commite52d9cbf151b4d4106c36834e820db9442ec9a3b (patch)
treeb07002700fcbcc6b4ed86c424196b744184971a1 /tests/var.test
parentcc56afda247802cb646330c25f3f03db20b1a43d (diff)
downloadtcl-e52d9cbf151b4d4106c36834e820db9442ec9a3b.zip
tcl-e52d9cbf151b4d4106c36834e820db9442ec9a3b.tar.gz
tcl-e52d9cbf151b4d4106c36834e820db9442ec9a3b.tar.bz2
Massive test cleanup; all tests are run, and constraints are used where necessary.
Diffstat (limited to 'tests/var.test')
-rw-r--r--tests/var.test115
1 files changed, 55 insertions, 60 deletions
diff --git a/tests/var.test b/tests/var.test
index c675d63..93e698b 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -14,7 +14,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: var.test,v 1.23 2004/04/28 13:11:35 msofer Exp $
+# RCS: @(#) $Id: var.test,v 1.24 2004/05/19 20:15:32 dkf Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -22,6 +22,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
+testConstraint testupvar [llength [info commands testupvar]]
+testConstraint testgetvarfullname [llength [info commands testgetvarfullname]]
+testConstraint testsetnoerr [info commands testsetnoerr]
+
catch {rename p ""}
catch {namespace delete test_ns_var}
catch {unset xx}
@@ -202,30 +206,28 @@ test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} {
p
}
} {1998}
-if {[info commands testupvar] != {}} {
- test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} {
- catch {unset a}
- set a 123321
- proc p {} {
- # create global xx linked to global a
- testupvar 1 a {} xx global
+test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} testupvar {
+ catch {unset a}
+ set a 123321
+ proc p {} {
+ # create global xx linked to global a
+ testupvar 1 a {} xx global
+ }
+ list [p] $xx [set xx 789] $a
+} {{} 123321 789 789}
+test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} testupvar {
+ catch {unset a}
+ set a 456
+ namespace eval test_ns_var {
+ catch {unset ::test_ns_var::vv}
+ proc p {} {
+ # create namespace var vv linked to global a
+ testupvar 1 a {} vv namespace
}
- list [p] $xx [set xx 789] $a
- } {{} 123321 789 789}
- test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} {
- catch {unset a}
- set a 456
- namespace eval test_ns_var {
- catch {unset ::test_ns_var::vv}
- proc p {} {
- # create namespace var vv linked to global a
- testupvar 1 a {} vv namespace
- }
- p
- }
- list $test_ns_var::vv [set test_ns_var::vv 123] $a
- } {456 123 123}
-}
+ p
+ }
+ list $test_ns_var::vv [set test_ns_var::vv 123] $a
+} {456 123 123}
test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} {
catch {unset aaaaa}
catch {unset xxxxx}
@@ -278,24 +280,22 @@ test var-3.11 {MakeUpvar, my var looks like array elem} -body {
upvar #0 aaaaa foo(bar)
} -returnCodes 1 -result {bad variable name "foo(bar)": upvar won't create a scalar variable that looks like an array element}
-if {[info commands testgetvarfullname] != {}} {
- test var-4.1 {Tcl_GetVariableName, global variable} {
- catch {unset a}
- set a 123
- testgetvarfullname a global
- } ::a
- test var-4.2 {Tcl_GetVariableName, namespace variable} {
- namespace eval test_ns_var {
- variable george
- testgetvarfullname george namespace
- }
- } ::test_ns_var::george
- test var-4.3 {Tcl_GetVariableName, variable can't be array element} {
- catch {unset a}
- set a(1) foo
- list [catch {testgetvarfullname a(1) global} msg] $msg
- } {1 {unknown variable "a(1)"}}
-}
+test var-4.1 {Tcl_GetVariableName, global variable} testgetvarfullname {
+ catch {unset a}
+ set a 123
+ testgetvarfullname a global
+} ::a
+test var-4.2 {Tcl_GetVariableName, namespace variable} testgetvarfullname {
+ namespace eval test_ns_var {
+ variable george
+ testgetvarfullname george namespace
+ }
+} ::test_ns_var::george
+test var-4.3 {Tcl_GetVariableName, variable can't be array element} testgetvarfullname {
+ catch {unset a}
+ set a(1) foo
+ list [catch {testgetvarfullname a(1) global} msg] $msg
+} {1 {unknown variable "a(1)"}}
test var-5.1 {Tcl_GetVariableFullName, global variable} {
catch {unset a}
@@ -527,11 +527,7 @@ test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var
list [unset test_ns_var::v] $test_ns_var::info
} {{} {test_ns_var::v {} u}}
-if {[info commands testsetnoerr] == {}} {
- puts "This application hasn't been compiled with the \"testsetnoerr\""
- puts "command, so I can't test TclSetVar etc."
-} else {
-test var-9.1 {behaviour of TclGet/SetVar simple get/set} {
+test var-9.1 {behaviour of TclGet/SetVar simple get/set} testsetnoerr {
catch {unset u}; catch {unset v}
list \
[set u a; testsetnoerr u] \
@@ -539,7 +535,7 @@ test var-9.1 {behaviour of TclGet/SetVar simple get/set} {
[testseterr u] \
[unset v; testseterr v b]
} [list {before get a} {before set b} {before get a} {before set b}]
-test var-9.2 {behaviour of TclGet/SetVar namespace get/set} {
+test var-9.2 {behaviour of TclGet/SetVar namespace get/set} testsetnoerr {
catch {namespace delete ns}
namespace eval ns {variable u a; variable v}
list \
@@ -548,46 +544,46 @@ test var-9.2 {behaviour of TclGet/SetVar namespace get/set} {
[testseterr ns::u] \
[unset ns::v; testseterr ns::v b]
} [list {before get a} {before set b} {before get a} {before set b}]
-test var-9.3 {behaviour of TclGetVar no variable} {
+test var-9.3 {behaviour of TclGetVar no variable} testsetnoerr {
catch {unset u}
list \
[catch {testsetnoerr u} res] $res \
[catch {testseterr u} res] $res
} {1 {before get} 1 {can't read "u": no such variable}}
-test var-9.4 {behaviour of TclGetVar no namespace variable} {
+test var-9.4 {behaviour of TclGetVar no namespace variable} testsetnoerr {
catch {namespace delete ns}
namespace eval ns {}
list \
[catch {testsetnoerr ns::w} res] $res \
[catch {testseterr ns::w} res] $res
} {1 {before get} 1 {can't read "ns::w": no such variable}}
-test var-9.5 {behaviour of TclGetVar no namespace} {
+test var-9.5 {behaviour of TclGetVar no namespace} testsetnoerr {
catch {namespace delete ns}
list \
[catch {testsetnoerr ns::u} res] $res \
[catch {testseterr ns::v} res] $res
} {1 {before get} 1 {can't read "ns::v": no such variable}}
-test var-9.6 {behaviour of TclSetVar no namespace} {
+test var-9.6 {behaviour of TclSetVar no namespace} testsetnoerr {
catch {namespace delete ns}
list \
[catch {testsetnoerr ns::v 1} res] $res \
[catch {testseterr ns::v 1} res] $res
} {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
-test var-9.7 {behaviour of TclGetVar array variable} {
+test var-9.7 {behaviour of TclGetVar array variable} testsetnoerr {
catch {unset arr}
set arr(1) 1;
list \
[catch {testsetnoerr arr} res] $res \
[catch {testseterr arr} res] $res
} {1 {before get} 1 {can't read "arr": variable is array}}
-test var-9.8 {behaviour of TclSetVar array variable} {
+test var-9.8 {behaviour of TclSetVar array variable} testsetnoerr {
catch {unset arr}
set arr(1) 1
list \
[catch {testsetnoerr arr 2} res] $res \
[catch {testseterr arr 2} res] $res
} {1 {before set} 1 {can't set "arr": variable is array}}
-test var-9.9 {behaviour of TclGetVar read trace success} {
+test var-9.9 {behaviour of TclGetVar read trace success} testsetnoerr {
proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
catch {unset u}; catch {unset v}
set u 10
@@ -597,7 +593,7 @@ test var-9.9 {behaviour of TclGetVar read trace success} {
[testsetnoerr u] \
[testseterr v]
} {{before get 1} {before get 2}}
-test var-9.10 {behaviour of TclGetVar read trace error} {
+test var-9.10 {behaviour of TclGetVar read trace error} testsetnoerr {
proc writeonly args {error "write-only"}
set v 456
trace var v r writeonly
@@ -605,7 +601,7 @@ test var-9.10 {behaviour of TclGetVar read trace error} {
[catch {testsetnoerr v} msg] $msg \
[catch {testseterr v} msg] $msg
} {1 {before get} 1 {can't read "v": write-only}}
-test var-9.11 {behaviour of TclSetVar write trace success} {
+test var-9.11 {behaviour of TclSetVar write trace success} testsetnoerr {
proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
catch {unset u}; catch {unset v}
set v 1
@@ -615,7 +611,7 @@ test var-9.11 {behaviour of TclSetVar write trace success} {
[testsetnoerr u 2] \
[testseterr v 3]
} {{before set 4} {before set 6}}
-test var-9.12 {behaviour of TclSetVar write trace error} {
+test var-9.12 {behaviour of TclSetVar write trace error} testsetnoerr {
proc readonly args {error "read-only"}
set v 456
trace var v w readonly
@@ -623,12 +619,11 @@ test var-9.12 {behaviour of TclSetVar write trace error} {
[catch {testsetnoerr v 2} msg] $msg $v \
[catch {testseterr v 3} msg] $msg $v
} {1 {before set} 2 1 {can't set "v": read-only} 3}
-}
+
test var-10.1 {can't nest arrays with array set} {
catch {unset arr}
list [catch {array set arr(x) {a 1 b 2}} res] $res
} {1 {can't set "arr(x)": variable isn't array}}
-
test var-10.2 {can't nest arrays with array set} {
catch {unset arr}
list [catch {array set arr(x) {}} res] $res