diff options
Diffstat (limited to 'tests/uplevel.test')
| -rw-r--r-- | tests/uplevel.test | 53 |
1 files changed, 31 insertions, 22 deletions
diff --git a/tests/uplevel.test b/tests/uplevel.test index f676290..0413a47 100644 --- a/tests/uplevel.test +++ b/tests/uplevel.test @@ -1,17 +1,17 @@ # Commands covered: uplevel # -# 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 -# generates output for errors. No output means no errors were found. +# 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 generates output +# for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: uplevel.test,v 1.9 2008/06/08 03:21:33 msofer Exp $ +# RCS: @(#) $Id: uplevel.test,v 1.10 2010/12/07 16:32:06 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -26,7 +26,7 @@ proc newset {name value} { uplevel set $name $value uplevel 1 {uplevel 1 {set xyz 22}} } - + test uplevel-1.1 {simple operation} { set xyz 0 a 22 33 @@ -85,20 +85,24 @@ test uplevel-3.4 {uplevel to same level} { a1 } 55 -test uplevel-4.1 {error: non-existent level} { - list [catch c1 msg] $msg -} {1 {bad level "#2"}} -test uplevel-4.2 {error: non-existent level} { - proc c2 {} {uplevel 3 {set a b}} - list [catch c2 msg] $msg -} {1 {bad level "3"}} -test uplevel-4.3 {error: not enough args} { - list [catch uplevel msg] $msg -} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}} -test uplevel-4.4 {error: not enough args} { - proc upBug {} {uplevel 1} - list [catch upBug msg] $msg -} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}} +test uplevel-4.1 {error: non-existent level} -returnCodes error -body { + apply {{} { + uplevel #2 {set y 222} + }} +} -result {bad level "#2"} +test uplevel-4.2 {error: non-existent level} -returnCodes error -body { + apply {{} { + uplevel 3 {set a b} + }} +} -result {bad level "3"} +test uplevel-4.3 {error: not enough args} -returnCodes error -body { + uplevel +} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"} +test uplevel-4.4 {error: not enough args} -returnCodes error -body { + apply {{} { + uplevel 1 + }} +} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"} proc a2 {} { uplevel a3 @@ -193,7 +197,12 @@ test uplevel-7.3 {var access, LVT in upper level} -setup { rename foo {} rename moo {} } -result {3 3 3} - + # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: |