* tests/fCmd.test, tests/safe.test, tests/uplevel.test,

	* tests/upvar.test, tests/var.test: Convert more tests to tcltest2 and
	factor them to be easier to understand.

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: