summaryrefslogtreecommitdiffstats
path: root/tests/upvar.test
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-05-19 10:46:27 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-05-19 10:46:27 (GMT)
commit448a309f97760b05f06466baeb3a83ab39a67445 (patch)
tree3bb1553a2f3eb1f7accc1ddd4e27234bb3217314 /tests/upvar.test
parent2294dc38b796a509f768e0db433a9e7430396d44 (diff)
downloadtcl-448a309f97760b05f06466baeb3a83ab39a67445.zip
tcl-448a309f97760b05f06466baeb3a83ab39a67445.tar.gz
tcl-448a309f97760b05f06466baeb3a83ab39a67445.tar.bz2
Use contraints, not conditional tests.
Diffstat (limited to 'tests/upvar.test')
-rw-r--r--tests/upvar.test136
1 files changed, 62 insertions, 74 deletions
diff --git a/tests/upvar.test b/tests/upvar.test
index ed9ce1d..2d100a1 100644
--- a/tests/upvar.test
+++ b/tests/upvar.test
@@ -11,13 +11,15 @@
# 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.9 2004/04/28 13:11:35 msofer Exp $
+# RCS: @(#) $Id: upvar.test,v 1.10 2004/05/19 10:46:27 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+testConstraint testupvar [llength [info commands testupvar]]
+
test upvar-1.1 {reading variables with upvar} {
proc p1 {a b} {set c 22; set d 33; p2}
proc p2 {} {upvar a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a}
@@ -342,81 +344,67 @@ test upvar-8.11 {upvar will not create a variable that looks like an array} -bod
upvar 0 upvarArray(elem) upvarArrayElemAlias(elem)
} -returnCodes 1 -match glob -result *
-if {[info commands testupvar] != {}} {
- test upvar-9.1 {Tcl_UpVar2 procedure} {
- list [catch {testupvar xyz a {} x global} msg] $msg
- } {1 {bad level "xyz"}}
- test upvar-9.2 {Tcl_UpVar2 procedure} {
- catch {unset a}
- catch {unset x}
- set a 44
- list [catch {testupvar #0 a 1 x global} msg] $msg
- } {1 {can't access "a(1)": variable isn't array}}
- test upvar-9.3 {Tcl_UpVar2 procedure} {
- proc foo {} {
- testupvar 1 a {} x local
- set x
- }
- catch {unset a}
- catch {unset x}
- set a 44
- foo
- } {44}
- test upvar-9.4 {Tcl_UpVar2 procedure} {
- proc foo {} {
- testupvar 1 a {} _up_ global
- list [catch {set x} msg] $msg
- }
- catch {unset a}
- catch {unset _up_}
- set a 44
- concat [foo] $_up_
- } {1 {can't read "x": no such variable} 44}
- test upvar-9.5 {Tcl_UpVar2 procedure} {
- proc foo {} {
- testupvar 1 a b x local
- set x
- }
- catch {unset a}
- catch {unset x}
- set a(b) 1234
- foo
- } {1234}
- test upvar-9.6 {Tcl_UpVar procedure} {
- proc foo {} {
- testupvar 1 a x local
- set x
- }
- catch {unset a}
- catch {unset x}
- set a xyzzy
- foo
- } {xyzzy}
- test upvar-9.7 {Tcl_UpVar procedure} {
- proc foo {} {
- testupvar #0 a(b) x local
- set x
- }
- catch {unset a}
- catch {unset x}
- set a(b) 1234
- foo
- } {1234}
-}
+test upvar-9.1 {Tcl_UpVar2 procedure} testupvar {
+ list [catch {testupvar xyz a {} x global} msg] $msg
+} {1 {bad level "xyz"}}
+test upvar-9.2 {Tcl_UpVar2 procedure} testupvar {
+ catch {unset a}
+ catch {unset x}
+ set a 44
+ list [catch "testupvar #0 a 1 x global" msg] $msg
+} {1 {can't access "a(1)": variable isn't array}}
+test upvar-9.3 {Tcl_UpVar2 procedure} testupvar {
+ proc foo {} {
+ testupvar 1 a {} x local
+ set x
+ }
+ catch {unset a}
+ catch {unset x}
+ set a 44
+ foo
+} {44}
+test upvar-9.4 {Tcl_UpVar2 procedure} testupvar {
+ proc foo {} {
+ testupvar 1 a {} _up_ global
+ list [catch {set x} msg] $msg
+ }
+ catch {unset a}
+ catch {unset _up_}
+ set a 44
+ concat [foo] $_up_
+} {1 {can't read "x": no such variable} 44}
+test upvar-9.5 {Tcl_UpVar2 procedure} testupvar {
+ proc foo {} {
+ testupvar 1 a b x local
+ set x
+ }
+ catch {unset a}
+ catch {unset x}
+ set a(b) 1234
+ foo
+} {1234}
+test upvar-9.6 {Tcl_UpVar procedure} testupvar {
+ proc foo {} {
+ testupvar 1 a x local
+ set x
+ }
+ catch {unset a}
+ catch {unset x}
+ set a xyzzy
+ foo
+} {xyzzy}
+test upvar-9.7 {Tcl_UpVar procedure} testupvar {
+ proc foo {} {
+ testupvar #0 a(b) x local
+ set x
+ }
+ catch {unset a}
+ catch {unset x}
+ set a(b) 1234
+ foo
+} {1234}
catch {unset a}
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-