Update to tcltest2

10 files changed, 5260 insertions, 2759 deletions

diff --git a/ChangeLog b/ChangeLog
index 63a6691..64eb0ee 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2008-08-28  Ania Pawelczyk  <aniap@users.sourceforge.net>
+
+	* tests/option.test: Update to tcltest2
+	* tests/place.test:
+	* tests/scale.test:
+	* tests/select.test:
+	* tests/textBTree.test:
+	* tests/textImage.test:
+	* tests/textMark.test:
+	* tests/textTag.test:
+	* tests/unixMenu.test:
+
 2008-08-25  Todd M. Helfter  <tmh@users.sourceforge.net>
 
 	* library/menu.tcl: fix typo from [Bug 1023955]
diff --git a/tests/option.test b/tests/option.test
index 2cdd675..2cf574e 100644
--- a/tests/option.test
+++ b/tests/option.test
@@ -6,16 +6,16 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: option.test,v 1.6 2004/05/23 17:34:49 dkf Exp $
+# RCS: @(#) $Id: option.test,v 1.7 2008/08/28 08:52:05 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
 testConstraint appNameIsTktest [expr {[winfo name .] eq "tktest"}]
 
-catch {destroy .op1}
-catch {destroy .op2}
+deleteWindows
 set appName [winfo name .]
 
 # First, test basic retrievals, being sure to trigger all the various
@@ -29,6 +29,7 @@ frame .op1.op4 -class Class3
 frame .op2.op5 -class Class2
 frame .op1.op3.op6 -class Class4
 
+# Configurations for tests 1.* - 12.*
 option clear
 option add *Color1 red
 option add *x blue
@@ -40,97 +41,254 @@ option add $appName.Class1.Class3.y brown
 option add $appName*op6*Color2 black
 option add $appName*Class1.op1.Color2 grey
 
-test option-1.1 {basic option retrieval} {option get . x Color1} blue
-test option-1.2 {basic option retrieval} {option get . y Color1} red
-test option-1.3 {basic option retrieval} {option get . z Color1} red
-test option-1.4 {basic option retrieval} {option get . x Color2} blue
-test option-1.5 {basic option retrieval} {option get . y Color2} {}
-test option-1.6 {basic option retrieval} {option get . z Color2} {}
-
-test option-2.1 {basic option retrieval} {option get .op1 x Color1} green
-test option-2.2 {basic option retrieval} {option get .op1 y Color1} red
-test option-2.3 {basic option retrieval} {option get .op1 z Color1} red
-test option-2.4 {basic option retrieval} {option get .op1 x Color2} green
-test option-2.5 {basic option retrieval} {option get .op1 y Color2} {}
-test option-2.6 {basic option retrieval} {option get .op1 z Color2} {}
-
-test option-3.1 {basic option retrieval} {option get .op1.op3 x Color1} yellow
-test option-3.2 {basic option retrieval} {option get .op1.op3 y Color1} red
-test option-3.3 {basic option retrieval} {option get .op1.op3 z Color1} red
-test option-3.4 {basic option retrieval} {option get .op1.op3 x Color2} yellow
-test option-3.5 {basic option retrieval} {option get .op1.op3 y Color2} {}
-test option-3.6 {basic option retrieval} {option get .op1.op3 z Color2} {}
-
-test option-4.1 {basic option retrieval} {option get .op1.op3.op6 x Color1} blue
-test option-4.2 {basic option retrieval} {option get .op1.op3.op6 y Color1} red
-test option-4.3 {basic option retrieval} {option get .op1.op3.op6 z Color1} red
-test option-4.4 {basic option retrieval} {option get .op1.op3.op6 x Color2} black
-test option-4.5 {basic option retrieval} {option get .op1.op3.op6 y Color2} black
-test option-4.6 {basic option retrieval} {option get .op1.op3.op6 z Color2} black
-
-test option-5.1 {basic option retrieval} {option get .op1.op4 x Color1} blue
-test option-5.2 {basic option retrieval} {option get .op1.op4 y Color1} brown
-test option-5.3 {basic option retrieval} {option get .op1.op4 z Color1} red
-test option-5.4 {basic option retrieval} {option get .op1.op4 x Color2} blue
-test option-5.5 {basic option retrieval} {option get .op1.op4 y Color2} brown
-test option-5.6 {basic option retrieval} {option get .op1.op4 z Color2} {}
-
-test option-6.1 {basic option retrieval} {option get .op2 x Color1} orange
-test option-6.2 {basic option retrieval} {option get .op2 y Color1} orange
-test option-6.3 {basic option retrieval} {option get .op2 z Color1} orange
-test option-6.4 {basic option retrieval} {option get .op2 x Color2} blue
-test option-6.5 {basic option retrieval} {option get .op2 y Color2} {}
-test option-6.6 {basic option retrieval} {option get .op2 z Color2} {}
-
-test option-7.1 {basic option retrieval} {option get .op2.op5 x Color1} orange
-test option-7.2 {basic option retrieval} {option get .op2.op5 y Color1} orange
-test option-7.3 {basic option retrieval} {option get .op2.op5 z Color1} orange
-test option-7.4 {basic option retrieval} {option get .op2.op5 x Color2} purple
-test option-7.5 {basic option retrieval} {option get .op2.op5 y Color2} purple
-test option-7.6 {basic option retrieval} {option get .op2.op5 z Color2} purple
+test option-1.1 {basic option retrieval} -body {
+    option get . x Color1
+} -result blue
+test option-1.2 {basic option retrieval} -body {
+    option get . y Color1
+} -result red
+test option-1.3 {basic option retrieval} -body {
+    option get . z Color1
+} -result red
+test option-1.4 {basic option retrieval} -body {
+    option get . x Color2
+} -result blue
+test option-1.5 {basic option retrieval} -body {
+    option get . y Color2
+} -result {}
+test option-1.6 {basic option retrieval} -body {
+    option get . z Color2
+} -result {}
+
+
+test option-2.1 {basic option retrieval} -body {
+    option get .op1 x Color1
+} -result green
+test option-2.2 {basic option retrieval} -body {
+    option get .op1 y Color1
+} -result red
+test option-2.3 {basic option retrieval} -body {
+    option get .op1 z Color1
+} -result red
+test option-2.4 {basic option retrieval} -body {
+    option get .op1 x Color2
+} -result green
+test option-2.5 {basic option retrieval} -body {
+    option get .op1 y Color2
+} -result {}
+test option-2.6 {basic option retrieval} -body {
+    option get .op1 z Color2
+} -result {}
+
+
+test option-3.1 {basic option retrieval} -body {
+    option get .op1.op3 x Color1
+} -result yellow
+test option-3.2 {basic option retrieval} -body {
+    option get .op1.op3 y Color1
+} -result red
+test option-3.3 {basic option retrieval} -body {
+    option get .op1.op3 z Color1
+} -result red
+test option-3.4 {basic option retrieval} -body {
+    option get .op1.op3 x Color2
+} -result yellow
+test option-3.5 {basic option retrieval} -body {
+    option get .op1.op3 y Color2
+} -result {}
+test option-3.6 {basic option retrieval} -body {
+    option get .op1.op3 z Color2
+} -result {}
+
+
+test option-4.1 {basic option retrieval} -body {
+    option get .op1.op3.op6 x Color1
+} -result blue
+test option-4.2 {basic option retrieval} -body {
+    option get .op1.op3.op6 y Color1
+} -result red
+test option-4.3 {basic option retrieval} -body {
+    option get .op1.op3.op6 z Color1
+} -result red
+test option-4.4 {basic option retrieval} -body {
+    option get .op1.op3.op6 x Color2
+} -result black
+test option-4.5 {basic option retrieval} -body {
+    option get .op1.op3.op6 y Color2
+} -result black
+test option-4.6 {basic option retrieval} -body {
+    option get .op1.op3.op6 z Color2
+} -result black
+
+
+test option-5.1 {basic option retrieval} -body {
+    option get .op1.op4 x Color1
+} -result blue
+test option-5.2 {basic option retrieval} -body {
+    option get .op1.op4 y Color1
+} -result brown
+test option-5.3 {basic option retrieval} -body {
+    option get .op1.op4 z Color1
+} -result red
+test option-5.4 {basic option retrieval} -body {
+    option get .op1.op4 x Color2
+} -result blue
+test option-5.5 {basic option retrieval} -body {
+    option get .op1.op4 y Color2
+} -result brown
+test option-5.6 {basic option retrieval} -body {
+    option get .op1.op4 z Color2
+} -result {}
+
+
+test option-6.1 {basic option retrieval} -body {
+    option get .op2 x Color1
+} -result orange
+test option-6.2 {basic option retrieval} -body {
+    option get .op2 y Color1
+} -result orange
+test option-6.3 {basic option retrieval} -body {
+    option get .op2 z Color1
+} -result orange
+test option-6.4 {basic option retrieval} -body {
+    option get .op2 x Color2
+} -result blue
+test option-6.5 {basic option retrieval} -body {
+    option get .op2 y Color2
+} -result {}
+test option-6.6 {basic option retrieval} -body {
+    option get .op2 z Color2
+} -result {}
+
+
+test option-7.1 {basic option retrieval} -body {
+    option get .op2.op5 x Color1
+} -result orange
+test option-7.2 {basic option retrieval} -body {
+    option get .op2.op5 y Color1
+} -result orange
+test option-7.3 {basic option retrieval} -body {
+    option get .op2.op5 z Color1
+} -result orange
+test option-7.4 {basic option retrieval} -body {
+    option get .op2.op5 x Color2
+} -result purple
+test option-7.5 {basic option retrieval} -body {
+    option get .op2.op5 y Color2
+} -result purple
+test option-7.6 {basic option retrieval} -body {
+    option get .op2.op5 z Color2
+} -result purple
+
 
 # Now try similar tests to above, except jump around non-hierarchically
 # between windows to make sure that the option stacks are pushed and
 # popped correctly.
 
 option get . foo Foo
-test option-8.1 {stack pushing/popping} {option get .op2.op5 x Color1} orange
-test option-8.2 {stack pushing/popping} {option get .op2.op5 y Color1} orange
-test option-8.3 {stack pushing/popping} {option get .op2.op5 z Color1} orange
-test option-8.4 {stack pushing/popping} {option get .op2.op5 x Color2} purple
-test option-8.5 {stack pushing/popping} {option get .op2.op5 y Color2} purple
-test option-8.6 {stack pushing/popping} {option get .op2.op5 z Color2} purple
-
-test option-9.1 {stack pushing/popping} {option get . x Color1} blue
-test option-9.2 {stack pushing/popping} {option get . y Color1} red
-test option-9.3 {stack pushing/popping} {option get . z Color1} red
-test option-9.4 {stack pushing/popping} {option get . x Color2} blue
-test option-9.5 {stack pushing/popping} {option get . y Color2} {}
-test option-9.6 {stack pushing/popping} {option get . z Color2} {}
-
-test option-10.1 {stack pushing/popping} {option get .op1.op3.op6 x Color1} blue
-test option-10.2 {stack pushing/popping} {option get .op1.op3.op6 y Color1} red
-test option-10.3 {stack pushing/popping} {option get .op1.op3.op6 z Color1} red
-test option-10.4 {stack pushing/popping} {option get .op1.op3.op6 x Color2} black
-test option-10.5 {stack pushing/popping} {option get .op1.op3.op6 y Color2} black
-test option-10.6 {stack pushing/popping} {option get .op1.op3.op6 z Color2} black
-
-test option-11.1 {stack pushing/popping} {option get .op1.op3 x Color1} yellow
-test option-11.2 {stack pushing/popping} {option get .op1.op3 y Color1} red
-test option-11.3 {stack pushing/popping} {option get .op1.op3 z Color1} red
-test option-11.4 {stack pushing/popping} {option get .op1.op3 x Color2} yellow
-test option-11.5 {stack pushing/popping} {option get .op1.op3 y Color2} {}
-test option-11.6 {stack pushing/popping} {option get .op1.op3 z Color2} {}
-
-test option-12.1 {stack pushing/popping} {option get .op1 x Color1} green
-test option-12.2 {stack pushing/popping} {option get .op1 y Color1} red
-test option-12.3 {stack pushing/popping} {option get .op1 z Color1} red
-test option-12.4 {stack pushing/popping} {option get .op1 x Color2} green
-test option-12.5 {stack pushing/popping} {option get .op1 y Color2} {}
-test option-12.6 {stack pushing/popping} {option get .op1 z Color2} {}
+test option-8.1 {stack pushing/popping} -body {
+    option get .op2.op5 x Color1
+} -result orange
+test option-8.2 {stack pushing/popping} -body {
+    option get .op2.op5 y Color1
+} -result orange
+test option-8.3 {stack pushing/popping} -body {
+    option get .op2.op5 z Color1
+} -result orange
+test option-8.4 {stack pushing/popping} -body {
+    option get .op2.op5 x Color2
+} -result purple
+test option-8.5 {stack pushing/popping} -body {
+    option get .op2.op5 y Color2
+} -result purple
+test option-8.6 {stack pushing/popping} -body {
+    option get .op2.op5 z Color2
+} -result purple
+
+
+test option-9.1 {stack pushing/popping} -body {
+    option get . x Color1
+} -result blue
+test option-9.2 {stack pushing/popping} -body {
+    option get . y Color1
+} -result red
+test option-9.3 {stack pushing/popping} -body {
+    option get . z Color1
+} -result red
+test option-9.4 {stack pushing/popping} -body {
+    option get . x Color2
+} -result blue
+test option-9.5 {stack pushing/popping} -body {
+    option get . y Color2
+} -result {}
+test option-9.6 {stack pushing/popping} -body {
+    option get . z Color2
+} -result {}
+
+
+test option-10.1 {stack pushing/popping} -body {
+    option get .op1.op3.op6 x Color1
+} -result blue
+test option-10.2 {stack pushing/popping} -body {
+    option get .op1.op3.op6 y Color1
+} -result red
+test option-10.3 {stack pushing/popping} -body {
+    option get .op1.op3.op6 z Color1
+} -result red
+test option-10.4 {stack pushing/popping} -body {
+    option get .op1.op3.op6 x Color2
+} -result black
+test option-10.5 {stack pushing/popping} -body {
+    option get .op1.op3.op6 y Color2
+} -result black
+test option-10.6 {stack pushing/popping} -body {
+    option get .op1.op3.op6 z Color2
+} -result black
+
+
+test option-11.1 {stack pushing/popping} -body {
+    option get .op1.op3 x Color1
+} -result yellow
+test option-11.2 {stack pushing/popping} -body {
+    option get .op1.op3 y Color1
+} -result red
+test option-11.3 {stack pushing/popping} -body {
+    option get .op1.op3 z Color1
+} -result red
+test option-11.4 {stack pushing/popping} -body {
+    option get .op1.op3 x Color2
+} -result yellow
+test option-11.5 {stack pushing/popping} -body {
+    option get .op1.op3 y Color2
+} -result {}
+test option-11.6 {stack pushing/popping} -body {
+    option get .op1.op3 z Color2
+} -result {}
+
+
+test option-12.1 {stack pushing/popping} -body {
+    option get .op1 x Color1
+} -result green
+test option-12.2 {stack pushing/popping} -body {
+    option get .op1 y Color1
+} -result red
+test option-12.3 {stack pushing/popping} -body {
+    option get .op1 z Color1
+} -result red
+test option-12.4 {stack pushing/popping} -body {
+    option get .op1 x Color2
+} -result green
+test option-12.5 {stack pushing/popping} -body {
+    option get .op1 y Color2
+} -result {}
+test option-12.6 {stack pushing/popping} -body {
+    option get .op1 z Color2
+} -result {}
 
 # Test the major priority levels (widgetDefault, etc.)
 
+# Configurations for tests 13.* 
+option clear
 option add $appName.op1.a 100 100
 option add $appName.op1.A interactive interactive
 option add $appName.op1.b userDefault userDefault
@@ -138,92 +296,127 @@ option add $appName.op1.B startupFile startupFile
 option add $appName.op1.c widgetDefault widgetDefault
 option add $appName.op1.C 0 0
 
-test option-13.1 {priority levels} {option get .op1 a A} 100
-test option-13.2 {priority levels} {option get .op1 b A} interactive
-test option-13.3 {priority levels} {option get .op1 b B} userDefault
-test option-13.4 {priority levels} {option get .op1 c B} startupFile
-test option-13.5 {priority levels} {option get .op1 c C} widgetDefault
+test option-13.1 {priority levels} -body {
+    option get .op1 a A
+} -result 100
+test option-13.2 {priority levels} -body {
+    option get .op1 b A
+} -result interactive
+test option-13.3 {priority levels} -body {
+    option get .op1 b B
+} -result userDefault
+test option-13.4 {priority levels} -body {
+    option get .op1 c B
+} -result startupFile
+test option-13.5 {priority levels} -body {
+    option get .op1 c C
+} -result widgetDefault
 option add $appName.op1.B file2 widget
-test option-13.6 {priority levels} {option get .op1 c B} startupFile
+test option-13.6 {priority levels} -body {
+    option get .op1 c B
+} -result startupFile
 option add $appName.op1.B file2 startupFile
-test option-13.7 {priority levels} {option get .op1 c B} file2
+test option-13.7 {priority levels} -body {
+    option get .op1 c B
+} -result file2
+
 
 # Test various error conditions
 
-test option-14.1 {error conditions} {
-    list [catch {option} msg] $msg
-} {1 {wrong # args: should be "option cmd arg ?arg ...?"}}
-test option-14.2 {error conditions} {
-    list [catch {option x} msg] $msg
-} {1 {bad option "x": must be add, clear, get, or readfile}}
-test option-14.3 {error conditions} {
-    list [catch {option foo 3} msg] $msg
-} {1 {bad option "foo": must be add, clear, get, or readfile}}
-test option-14.4 {error conditions} {
-    list [catch {option add 3} msg] $msg
-} {1 {wrong # args: should be "option add pattern value ?priority?"}}
-test option-14.5 {error conditions} {
-    list [catch {option add . a b c} msg] $msg
-} {1 {wrong # args: should be "option add pattern value ?priority?"}}
-test option-14.6 {error conditions} {
-    list [catch {option add . a -1} msg] $msg
-} {1 {bad priority level "-1": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
-test option-14.7 {error conditions} {
-    list [catch {option add . a 101} msg] $msg
-} {1 {bad priority level "101": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
-test option-14.8 {error conditions} {
-    list [catch {option add . a gorp} msg] $msg
-} {1 {bad priority level "gorp": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
-test option-14.9 {error conditions} {
-    list [catch {option get 3} msg] $msg
-} {1 {wrong # args: should be "option get window name class"}}
-test option-14.10 {error conditions} {
-    list [catch {option get 3 4} msg] $msg
-} {1 {wrong # args: should be "option get window name class"}}
-test option-14.11 {error conditions} {
-    list [catch {option get 3 4 5 6} msg] $msg
-} {1 {wrong # args: should be "option get window name class"}}
-test option-14.12 {error conditions} {
-    list [catch {option get .gorp.gorp a A} msg] $msg
-} {1 {bad window path name ".gorp.gorp"}}
+test option-14.1 {error conditions} -body {
+    option
+} -returnCodes error -result {wrong # args: should be "option cmd arg ?arg ...?"}
+test option-14.2 {error conditions} -body {
+    option x
+} -returnCodes error -result {bad option "x": must be add, clear, get, or readfile}
+test option-14.3 {error conditions} -body {
+    option foo 3
+} -returnCodes error -result {bad option "foo": must be add, clear, get, or readfile}
+test option-14.4 {error conditions} -body {
+    option add 3
+} -returnCodes error -result {wrong # args: should be "option add pattern value ?priority?"}
+test option-14.5 {error conditions} -body {
+    option add . a b c
+} -returnCodes error -result {wrong # args: should be "option add pattern value ?priority?"}
+test option-14.6 {error conditions} -body {
+    option add . a -1
+} -returnCodes error -result {bad priority level "-1": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}
+test option-14.7 {error conditions} -body {
+    option add . a 101
+} -returnCodes error -result {bad priority level "101": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}
+test option-14.8 {error conditions} -body {
+    option add . a gorp
+} -returnCodes error -result {bad priority level "gorp": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}
+test option-14.9 {error conditions} -body {
+    option get 3
+} -returnCodes error -result {wrong # args: should be "option get window name class"}
+test option-14.10 {error conditions} -body {
+    option get 3 4
+} -returnCodes error -result {wrong # args: should be "option get window name class"}
+test option-14.11 {error conditions} -body {
+    option get 3 4 5 6
+} -returnCodes error -result {wrong # args: should be "option get window name class"}
+test option-14.12 {error conditions} -body {
+    option get .gorp.gorp a A
+} -returnCodes error -result {bad window path name ".gorp.gorp"}
+
 
 set option1 [file join [testsDirectory] option.file1]
-set option2 [file join [testsDirectory] option.file2]
-
-test option-15.1 {database files} {
-    list [catch {option read non-existent} msg] $msg
-} {1 {couldn't open "non-existent": no such file or directory}}
-option read $option1
-test option-15.2 {database files} {option get . x1 color} blue
-test option-15.3 {database files} appNameIsTktest {option get . x2 color} green
-test option-15.4 {database files} {option get . x3 color} purple
-test option-15.5 {database files} {option get . {x 4} color} brown
-test option-15.6 {database files} {option get . x6 color} {}
-test option-15.7 {database files} {
-    list [catch {option read $option1 widget foo} msg] $msg
-} {1 {wrong # args: should be "option readfile fileName ?priority?"}}
-option add *x3 burgundy
-catch {option read $option1 userDefault}
-test option-15.8 {database files} {option get . x3 color} burgundy
-test option-15.9 {database files} {
-    list [catch {option read $option2} msg] $msg
-} {1 {missing colon on line 2}}
-
-test option-16.1 {ReadOptionFile} {
+test option-15.1 {database files} -body {
+    option read non-existent
+} -returnCodes error -result {couldn't open "non-existent": no such file or directory}
+test option-15.2 {database files} -body {
+    option read $option1
+    option get . x1 color
+} -result blue
+test option-15.3 {database files} -constraints appNameIsTktest -body {
+    option read $option1
+    option get . x2 color
+} -result green
+test option-15.4 {database files} -body {
+    option read $option1
+    option get . x3 color
+} -result purple
+test option-15.5 {database files} -body {
+    option read $option1
+    option get . {x 4} color
+} -result brown
+test option-15.6 {database files} -body {
+    option read $option1
+	option get . x6 color
+} -result {}
+test option-15.7 {database files} -body {
+    option read $option1 widget foo
+} -returnCodes error -result {wrong # args: should be "option readfile fileName ?priority?"}
+
+test option-15.8 {database files} -body {
+    option add *x3 burgundy
+    catch {option read $option1 userDefault}
+    option get . x3 color
+} -result burgundy
+test option-15.9 {database files} -body {
+    set option2 [file join [testsDirectory] option.file2]
+    option read $option2
+} -returnCodes error -result {missing colon on line 2}
+
+
+test option-16.1 {ReadOptionFile} -body {
     set option3 [makeFile {} option.file3]
     set file [open $option3 w]
     fconfigure $file -translation crlf
     puts $file "*x7: true\n*x8: false"
     close $file
     option read $option3 userDefault
-    set result [list [option get . x7 color] [option get . x8 color]]
+    list [option get . x7 color] [option get . x8 color]
+} -cleanup {
     removeFile $option3
-    set result
-} {true false}
+} -result {true false}
 
-catch {destroy .op1}
-catch {destroy .op2}
+deleteWindows
 
 # cleanup
 cleanupTests
 return
+
+
+
diff --git a/tests/place.test b/tests/place.test
index c2a4042..7602766 100644
--- a/tests/place.test
+++ b/tests/place.test
@@ -5,9 +5,10 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: place.test,v 1.11 2004/09/16 18:01:20 pspjuth Exp $
+# RCS: @(#) $Id: place.test,v 1.12 2008/08/28 08:52:05 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
@@ -17,6 +18,7 @@ testConstraint memory [llength [info commands memory]]
 # XXX - This test file is woefully incomplete.  At present, only a
 # few of the features are tested.
 
+# Widgets used in tests 1.* - 8.*
 toplevel .t -width 300 -height 200 -bd 0
 wm geom .t +0+0
 frame .t.f -width 154 -height 84 -bd 2 -relief raised
@@ -24,145 +26,181 @@ place .t.f -x 48 -y 38
 frame .t.f2 -width 30 -height 60 -bd 2 -relief raised
 update
 
-test place-1.1 {Tk_PlaceCmd procedure, "info" option} {
+test place-1.1 {Tk_PlaceCmd procedure, "info" option} -setup {
+    place forget .t.f2
+} -body {
     place .t.f2 -x 0
     place info .t.f2
-} {-in .t -x 0 -relx 0 -y 0 -rely 0 -width {} -relwidth {} -height {} -relheight {} -anchor nw -bordermode inside}
-test place-1.2 {Tk_PlaceCmd procedure, "info" option} {
+} -result {-in .t -x 0 -relx 0 -y 0 -rely 0 -width {} -relwidth {} -height {} -relheight {} -anchor nw -bordermode inside}
+test place-1.2 {Tk_PlaceCmd procedure, "info" option} -setup {
+    place forget .t.f2
+} -body {
     place .t.f2 -x 1 -y 2 -width 3 -height 4 -relx 0.1 -rely 0.2 \
-	    -relwidth 0.3 -relheight 0.4 -anchor se -in .t.f  \
-	    -bordermode outside
+        -relwidth 0.3 -relheight 0.4 -anchor se -in .t.f  \
+        -bordermode outside
     place info .t.f2
-} {-in .t.f -x 1 -relx 0.1 -y 2 -rely 0.2 -width 3 -relwidth 0.3 -height 4 -relheight 0.4 -anchor se -bordermode outside}
-test place-1.3 {Tk_PlaceCmd procedure, "info" option} {
+} -result {-in .t.f -x 1 -relx 0.1 -y 2 -rely 0.2 -width 3 -relwidth 0.3 -height 4 -relheight 0.4 -anchor se -bordermode outside}
+test place-1.3 {Tk_PlaceCmd procedure, "info" option} -setup {
+    place forget .t.f2
+    destroy .t.a.b
+} -body {
     # Make sure the result is built as a proper list by using a space in parent
     frame ".t.a b"
     place .t.f2 -x 1 -y 2 -width {} -height 4 -relx 0.2 -rely 0.2 \
-	    -relwidth 0.3 -relheight {} -anchor w -in ".t.a b"  \
-	    -bordermode ignore
-    set res [place info .t.f2]
-    destroy ".t.a b"
-    set res
-} {-in {.t.a b} -x 1 -relx 0.2 -y 2 -rely 0.2 -width {} -relwidth 0.3 -height 4 -relheight {} -anchor w -bordermode ignore}
-
-test place-2.1 {ConfigureSlave procedure, -height option} {
-    list [catch {place .t.f2 -height abcd} msg] $msg
-} {1 {bad screen distance "abcd"}}
-test place-2.2 {ConfigureSlave procedure, -height option} {
+        -relwidth 0.3 -relheight {} -anchor w -in ".t.a b"  \
+        -bordermode ignore
+    place info .t.f2
+} -cleanup {
+    destroy ".t.a.b"
+} -result {-in {.t.a b} -x 1 -relx 0.2 -y 2 -rely 0.2 -width {} -relwidth 0.3 -height 4 -relheight {} -anchor w -bordermode ignore}
+
+
+test place-2.1 {ConfigureSlave procedure, -height option} -body {
+    place .t.f2 -height abcd
+} -returnCodes error -result {bad screen distance "abcd"}
+test place-2.2 {ConfigureSlave procedure, -height option} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -height 40
     update
     winfo height .t.f2
-} {40}
-test place-2.3 {ConfigureSlave procedure, -height option} {
+} -result {40}
+test place-2.3 {ConfigureSlave procedure, -height option} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -height 120
     update
     place .t.f2 -height {}
     update
     winfo height .t.f2
-} {60}
+} -result {60}
 
-test place-3.1 {ConfigureSlave procedure, -relheight option} {
-    list [catch {place .t.f2 -relheight abcd} msg] $msg
-} {1 {expected floating-point number but got "abcd"}}
-test place-3.2 {ConfigureSlave procedure, -relheight option} {
+
+test place-3.1 {ConfigureSlave procedure, -relheight option} -body {
+    place .t.f2 -relheight abcd
+} -returnCodes error -result {expected floating-point number but got "abcd"}
+test place-3.2 {ConfigureSlave procedure, -relheight option} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -relheight .5
     update
     winfo height .t.f2
-} {40}
-test place-3.3 {ConfigureSlave procedure, -relheight option} {
+} -result {40}
+test place-3.3 {ConfigureSlave procedure, -relheight option} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -relheight .8
     update
     place .t.f2 -relheight {}
     update
     winfo height .t.f2
-} {60}
+} -result {60}
+
 
-test place-4.1 {ConfigureSlave procedure, bad -in options} {
+test place-4.1 {ConfigureSlave procedure, bad -in options} -setup {
+    place forget .t.f2
+} -body {
+    place .t.f2 -in .t.f2
+} -returnCodes error -result {can't place .t.f2 relative to itself}
+test place-4.2 {ConfigureSlave procedure, bad -in option} -setup {
     place forget .t.f2
-    list [catch {place .t.f2 -in .t.f2} msg] $msg
-} [list 1 "can't place .t.f2 relative to itself"]
-test place-4.2 {ConfigureSlave procedure, bad -in option} {
+} -body {
+    set result [list [winfo manager .t.f2]]
+    catch {place .t.f2 -in .t.f2}
+    lappend result [winfo manager .t.f2]
+} -result {{} {}}
+test place-4.3 {ConfigureSlave procedure, bad -in option} -setup {
     place forget .t.f2
-    list [winfo manager .t.f2] \
-        [catch {place .t.f2 -in .t.f2} err] $err \
-        [winfo manager .t.f2]
-} {{} 1 {can't place .t.f2 relative to itself} {}}
-test place-4.3 {ConfigureSlave procedure, bad -in option} {
+} -body {
+    winfo manager .t.f2
+    place .t.f2 -in .t.f2
+} -returnCodes error -result {can't place .t.f2 relative to itself}
+test place-4.4 {ConfigureSlave procedure, bad -in option} -setup {
     place forget .t.f2
-    list [catch {place .t.f2 -in .} msg] $msg
-} [list 1 "can't place .t.f2 relative to ."]
+} -body {
+    place .t.f2 -in .
+} -returnCodes error -result {can't place .t.f2 relative to .}
 
-test place-5.1 {ConfigureSlave procedure, -relwidth option} {
-    list [catch {place .t.f2 -relwidth abcd} msg] $msg
-} {1 {expected floating-point number but got "abcd"}}
-test place-5.2 {ConfigureSlave procedure, -relwidth option} {
+
+test place-5.1 {ConfigureSlave procedure, -relwidth option} -body {
+    place .t.f2 -relwidth abcd
+} -returnCodes error -result {expected floating-point number but got "abcd"}
+test place-5.2 {ConfigureSlave procedure, -relwidth option} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -relwidth .5
     update
     winfo width .t.f2
-} {75}
-test place-5.3 {ConfigureSlave procedure, -relwidth option} {
+} -result {75}
+test place-5.3 {ConfigureSlave procedure, -relwidth option} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -relwidth .8
     update
     place .t.f2 -relwidth {}
     update
     winfo width .t.f2
-} {30}
+} -result {30}
 
-test place-6.1 {ConfigureSlave procedure, -width option} {
-    list [catch {place .t.f2 -width abcd} msg] $msg
-} {1 {bad screen distance "abcd"}}
-test place-6.2 {ConfigureSlave procedure, -width option} {
+test place-6.1 {ConfigureSlave procedure, -width option} -body {
+    place .t.f2 -width abcd
+} -returnCodes error -result {bad screen distance "abcd"}
+test place-6.2 {ConfigureSlave procedure, -width option} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -width 100
     update
     winfo width .t.f2
-} {100}
-test place-6.3 {ConfigureSlave procedure, -width option} {
+} -result {100}
+test place-6.3 {ConfigureSlave procedure, -width option} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -width 120
     update
     place .t.f2 -width {}
     update
     winfo width .t.f2
-} {30}
+} -result {30}
+
 
-test place-7.1 {ReconfigurePlacement procedure, computing position} {
+test place-7.1 {ReconfigurePlacement procedure, computing position} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -x -2 -relx .5 -y 3 -rely .4
     update
     winfo geometry .t.f2
-} {30x60+123+75}
-test place-7.2 {ReconfigurePlacement procedure, position rounding} {
+} -result {30x60+123+75}
+test place-7.2 {ReconfigurePlacement procedure, position rounding} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -x -1.4 -y -2.3
     update
     winfo geometry .t.f2
-} {30x60+49+38}
-test place-7.3 {ReconfigurePlacement procedure, position rounding} {
+} -result {30x60+49+38}
+test place-7.3 {ReconfigurePlacement procedure, position rounding} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -x 1.4 -y 2.3
     update
     winfo geometry .t.f2
-} {30x60+51+42}
-test place-7.4 {ReconfigurePlacement procedure, position rounding} {
+} -result {30x60+51+42}
+test place-7.4 {ReconfigurePlacement procedure, position rounding} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -x -1.6 -y -2.7
     update
     winfo geometry .t.f2
-} {30x60+48+37}
-test place-7.5 {ReconfigurePlacement procedure, position rounding} {
+} -result {30x60+48+37}
+test place-7.5 {ReconfigurePlacement procedure, position rounding} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -x 1.6 -y 2.7
     update
     winfo geometry .t.f2
-} {30x60+52+43}
-test place-7.6 {ReconfigurePlacement procedure, position rounding} {
+} -result {30x60+52+43}
+test place-7.6 {ReconfigurePlacement procedure, position rounding} -setup {
+    destroy .t.f3
+} -body {
     frame .t.f3 -width 100 -height 100 -bg #f00000 -bd 0
     place .t.f3 -x 0 -y 0
     raise .t.f2
@@ -170,38 +208,44 @@ test place-7.6 {ReconfigurePlacement procedure, position rounding} {
     place .t.f2 -in .t.f3 -relx .303 -rely .406 -relwidth .304 -relheight .206
     update
     winfo geometry .t.f2
-} {31x20+30+41}
-catch {destroy .t.f3}
-test place-7.7 {ReconfigurePlacement procedure, computing size} {
+} -cleanup {
+    destroy .t.f3
+} -result {31x20+30+41}
+test place-7.7 {ReconfigurePlacement procedure, computing size} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -width 120 -height 89
     update
     list [winfo width .t.f2] [winfo height .t.f2]
-} {120 89}
-test place-7.8 {ReconfigurePlacement procedure, computing size} {
+} -result {120 89}
+test place-7.8 {ReconfigurePlacement procedure, computing size} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -relwidth .4 -relheight .5
     update
     list [winfo width .t.f2] [winfo height .t.f2]
-} {60 40}
-test place-7.9 {ReconfigurePlacement procedure, computing size} {
+} -result {60 40}
+test place-7.9 {ReconfigurePlacement procedure, computing size} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -width 10 -relwidth .4 -height -4 -relheight .5
     update
     list [winfo width .t.f2] [winfo height .t.f2]
-} {70 36}
-test place-7.10 {ReconfigurePlacement procedure, computing size} {
+} -result {70 36}
+test place-7.10 {ReconfigurePlacement procedure, computing size} -setup {
     place forget .t.f2
+} -body {
     place .t.f2 -in .t.f -width 10 -relwidth .4 -height -4 -relheight .5
     place .t.f2 -width {} -relwidth {} -height {} -relheight {}
     update
     list [winfo width .t.f2] [winfo height .t.f2]
-} {30 60}
+} -result {30 60}
 
 
-test place-8.1 {MasterStructureProc, mapping and unmapping slaves} {
+test place-8.1 {MasterStructureProc, mapping and unmapping slaves} -setup {
     place forget .t.f2
     place forget .t.f
+} -body {
     place .t.f2 -relx 1.0 -rely 1.0 -anchor sw
     update
     set result [winfo ismapped .t.f2]
@@ -214,10 +258,11 @@ test place-8.1 {MasterStructureProc, mapping and unmapping slaves} {
     wm deiconify .t
     update
     lappend result [winfo ismapped .t.f2]
-} {1 0 40 30 0 1}
-test place-8.2 {MasterStructureProc, mapping and unmapping slaves} {
+} -result {1 0 40 30 0 1}
+test place-8.2 {MasterStructureProc, mapping and unmapping slaves} -setup {
     place forget .t.f2
     place forget .t.f
+} -body {
     place .t.f -x 0 -y 0 -width 200 -height 100
     place .t.f2 -in .t.f -relx 1.0 -rely 1.0 -anchor sw -width 50 -height 20
     update
@@ -231,130 +276,153 @@ test place-8.2 {MasterStructureProc, mapping and unmapping slaves} {
     wm deiconify .t
     update
     lappend result [winfo ismapped .t.f2]
-} {1 0 42 32 0 1}
-
-test place-9.1 {PlaceObjCmd} {
-    list [catch {place} msg] $msg
-} [list 1 "wrong # args: should be \"place option|pathName args\""]
-test place-9.2 {PlaceObjCmd} {
-    list [catch {place foo} msg] $msg
-} [list 1 "wrong # args: should be \"place option|pathName args\""]
-test place-9.3 {PlaceObjCmd} {
-    catch {destroy .foo}
-    list [catch {place .foo bar} msg] $msg
-} [list 1 "bad window path name \".foo\""]
-test place-9.4 {PlaceObjCmd} {
-    catch {destroy .foo}
-    list [catch {place bar .foo} msg] $msg
-} [list 1 "bad window path name \".foo\""]
-test place-9.5 {PlaceObjCmd} {
-    catch {destroy .foo}
+} -result {1 0 42 32 0 1}
+destroy .t
+
+
+test place-9.1 {PlaceObjCmd} -body {
+    place
+} -returnCodes error -result {wrong # args: should be "place option|pathName args"}
+test place-9.2 {PlaceObjCmd} -body {
+    place foo
+} -returnCodes error -result {wrong # args: should be "place option|pathName args"}
+test place-9.3 {PlaceObjCmd} -setup {
+    destroy .foo
+} -body {
+    place .foo bar
+} -returnCodes error -result {bad window path name ".foo"}
+test place-9.4 {PlaceObjCmd} -setup {
+    destroy .foo
+} -body {
+    place bar .foo
+} -cleanup {
+    destroy .foo
+} -returnCodes error -result {bad window path name ".foo"}
+test place-9.5 {PlaceObjCmd} -setup {
+    destroy .foo
+} -body {
     frame .foo
-    set res [list [catch {place badopt .foo} msg] $msg]
+    place badopt .foo
+} -cleanup {
     destroy .foo
-    set res
-} [list 1 "bad option \"badopt\": must be configure, forget, info, or slaves"]
-test place-9.6 {PlaceObjCmd, configure errors} {
-    catch {destroy .foo}
+} -returnCodes error -result {bad option "badopt": must be configure, forget, info, or slaves}
+test place-9.6 {PlaceObjCmd, configure errors} -setup {
+    destroy .foo
+} -body {
     frame .foo
-    set res [list [catch {place configure .foo} msg] $msg]
+    place configure .foo
+} -cleanup {
+    destroy .foo
+} -returnCodes ok -result {}
+test place-9.7 {PlaceObjCmd, configure errors} -setup {
     destroy .foo
-    set res
-} [list 0 ""]
-test place-9.7 {PlaceObjCmd, configure errors} {
-    catch {destroy .foo}
+} -body {
     frame .foo
-    set res [list [catch {place configure .foo bar} msg] $msg]
+    place configure .foo bar
+} -cleanup {
+    destroy .foo
+} -returnCodes ok -result {}
+test place-9.8 {PlaceObjCmd, configure} -setup {
     destroy .foo
-    set res
-} [list 0 ""]
-test place-9.8 {PlaceObjCmd, configure} {
-    catch {destroy .foo}
+} -body {
     frame .foo
     place .foo -x 0 -y 0
-    set res [place configure .foo]
+    place configure .foo
+} -cleanup {
     destroy .foo
-    set res
-} [list {-anchor {} {} nw nw} {-bordermode {} {} inside inside} {-height {} {} {} {}} {-in {} {} {} .} {-relheight {} {} {} {}} {-relwidth {} {} {} {}} {-relx {} {} 0 0.0} {-rely {} {} 0 0.0} {-width {} {} {} {}} {-x {} {} 0 0} {-y {} {} 0 0}]
-test place-9.9 {PlaceObjCmd, configure} {
-    catch {destroy .foo}
+} -result [list {-anchor {} {} nw nw} {-bordermode {} {} inside inside} {-height {} {} {} {}} {-in {} {} {} .} {-relheight {} {} {} {}} {-relwidth {} {} {} {}} {-relx {} {} 0 0.0} {-rely {} {} 0 0.0} {-width {} {} {} {}} {-x {} {} 0 0} {-y {} {} 0 0}]
+test place-9.9 {PlaceObjCmd, configure} -setup {
+    destroy .foo
+} -body {
     frame .foo
     place .foo -x 0 -y 0
-    set res [place configure .foo -x]
+    place configure .foo -x
+} -cleanup {
+    destroy .foo
+} -result {-x {} {} 0 0}
+test place-9.10 {PlaceObjCmd, forget errors} -setup {
     destroy .foo
-    set res
-} [list -x {} {} 0 0]
-test place-9.10 {PlaceObjCmd, forget errors} {
-    catch {destroy .foo}
+} -body {
     frame .foo
-    set res [list [catch {place forget .foo bar} msg] $msg]
+    place forget .foo bar
+} -cleanup {
     destroy .foo
-    set res
-} [list 1 "wrong # args: should be \"place forget pathName\""]
-test place-9.11 {PlaceObjCmd, info errors} {
-    catch {destroy .foo}
+} -returnCodes error -result {wrong # args: should be "place forget pathName"}
+test place-9.11 {PlaceObjCmd, info errors} -setup {
+    destroy .foo
+} -body {
     frame .foo
-    set res [list [catch {place info .foo bar} msg] $msg]
+    place info .foo bar
+} -cleanup {
+    destroy .foo
+} -returnCodes error -result {wrong # args: should be "place info pathName"}
+test place-9.12 {PlaceObjCmd, slaves errors} -setup {
     destroy .foo
-    set res
-} [list 1 "wrong # args: should be \"place info pathName\""]
-test place-9.12 {PlaceObjCmd, slaves errors} {
-    catch {destroy .foo}
+} -body {
     frame .foo
-    set res [list [catch {place slaves .foo bar} msg] $msg]
+    place slaves .foo bar
+} -cleanup {
     destroy .foo
-    set res
-} [list 1 "wrong # args: should be \"place slaves pathName\""]
-    
-test place-10.1 {ConfigureSlave} {
-    catch {destroy .foo}
+} -returnCodes error -result {wrong # args: should be "place slaves pathName"}
+
+
+test place-10.1 {ConfigureSlave} -setup {
+    destroy .foo
+} -body {
     frame .foo
-    set res [list [catch {place .foo -badopt} msg] $msg]
+    place .foo -badopt
+} -cleanup {
     destroy .foo
-    set res
-} [list 1 "unknown option \"-badopt\""]
-test place-10.2 {ConfigureSlave} {
-    catch {destroy .foo}
+} -returnCodes error -result {unknown option "-badopt"}
+test place-10.2 {ConfigureSlave} -setup {
+    destroy .foo
+} -body {
     frame .foo
-    set res [list [catch {place .foo -anchor} msg] $msg]
+    place .foo -anchor
+} -cleanup {
+    destroy .foo
+} -returnCodes error -result {value for "-anchor" missing}
+test place-10.3 {ConfigureSlave} -setup {
     destroy .foo
-    set res
-} [list 1 "value for \"-anchor\" missing"]
-test place-10.3 {ConfigureSlave} {
-    catch {destroy .foo}
+} -body {
     frame .foo
-    set res [list [catch {place .foo -bordermode j} msg] $msg]
+    place .foo -bordermode j
+} -cleanup {
+    destroy .foo
+} -returnCodes error -result {bad bordermode "j": must be inside, outside, or ignore}
+test place-10.4 {ConfigureSlave} -setup {
     destroy .foo
-    set res
-} [list 1 "bad bordermode \"j\": must be inside, outside, or ignore"]
-test place-10.4 {ConfigureSlave} {
-    catch {destroy .foo}
+} -body {
     frame .foo
-    set res [list [catch {place configure .foo -x 0 -y} msg] $msg]
+    place configure .foo -x 0 -y
+} -cleanup {
+    destroy .foo
+} -returnCodes error -result {value for "-y" missing}
+    
+
+test place-11.1 {PlaceObjCmd, slaves command} -setup {
     destroy .foo
-    set res
-} [list 1 "value for \"-y\" missing"]
-	
-test place-11.1 {PlaceObjCmd, slaves command} {
-    catch {destroy .foo}
+} -body {
     frame .foo
-    set res [place slaves .foo]
+    place slaves .foo
+} -cleanup {
     destroy .foo
-    set res
-} {}
-test place-11.2 {PlaceObjCmd, slaves command} {
-    catch {destroy .foo .bar}
+} -result {}
+test place-11.2 {PlaceObjCmd, slaves command} -setup {
+    destroy .foo .bar
+} -body {
     frame .foo
     frame .bar
     place .bar -in .foo
-    set res [place slaves .foo]
-    destroy .foo
-    destroy .bar
-    set res
-} [list .bar]
+    place slaves .foo
+} -cleanup {
+    destroy .foo .bar
+} -result [list .bar]
+
 
-test place-12.1 {PlaceObjCmd, forget command} {
-    catch {destroy .foo}
+test place-12.1 {PlaceObjCmd, forget command} -setup {
+    destroy .foo
+} -body {
     frame .foo
     place .foo -width 50 -height 50
     update
@@ -362,11 +430,14 @@ test place-12.1 {PlaceObjCmd, forget command} {
     place forget .foo
     update
     lappend res [winfo ismapped .foo]
+} -cleanup {
     destroy .foo
-    set res
-} [list 1 0]
+} -result {1 0}
+
 
-test place-13.1 {test respect for internalborder} {
+test place-13.1 {test respect for internalborder} -setup {
+    destroy .pack
+} -body {
     toplevel .pack
     wm geometry .pack 200x200
     frame .pack.l -width 15 -height 10
@@ -379,11 +450,13 @@ test place-13.1 {test respect for internalborder} {
     .pack.lf configure -labelanchor e -padx 3 -pady 5
     update
     lappend res [winfo geometry .pack.lf.f]
+} -cleanup {
     destroy .pack
-    set res
-} {196x188+2+10 177x186+5+7}
+} -result {196x188+2+10 177x186+5+7}
 
-test place-14.1 {memory leak testing} -setup {
+
+test place-14.1 {memory leak testing} -constraints memory -setup {
+    destroy .f
     proc getbytes {} {
         set lines [split [memory info] "\n"]
         lindex [lindex $lines 3] 3
@@ -402,7 +475,7 @@ test place-14.1 {memory leak testing} -setup {
         }
         return $res
     }
-} -constraints memory -body {
+} -body {
     # Test all manners of forgetting a slave
     frame .f
     frame .f.f
@@ -418,14 +491,16 @@ test place-14.1 {memory leak testing} -setup {
         frame .f
         frame .f.f
     }
-} -result {0 0 0} -cleanup {
+} -cleanup {
     destroy .f
     rename getbytes {}
     rename stress {}
-}
+} -result {0 0 0}
 
-catch {destroy .t}
 
 # cleanup
 cleanupTests
 return
+
+
+
diff --git a/tests/scale.test b/tests/scale.test
index 5a2a26d..6763848 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -6,9 +6,10 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: scale.test,v 1.16 2008/07/23 23:24:24 nijtmans Exp $
+# RCS: @(#) $Id: scale.test,v 1.17 2008/08/28 08:52:05 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
@@ -19,220 +20,497 @@ option add *Scale.borderWidth 2
 option add *Scale.highlightThickness 2
 option add *Scale.font {Helvetica -12 bold}
 
+# Widget used in 1.* tests
 scale .s -from 100 -to 300
 pack .s
 update
-set i 1
-foreach test {
-    {-activebackground #ff0000 #ff0000 non-existent
-	    {unknown color name "non-existent"}}
-    {-background #ff0000 #ff0000 non-existent
-	    {unknown color name "non-existent"}}
-    {-bd 4 4 badValue {bad screen distance "badValue"}}
-    {-bigincrement 12.5 12.5 badValue
-	    {expected floating-point number but got "badValue"}}
-    {-bg #ff0000 #ff0000 non-existent
-	    {unknown color name "non-existent"}}
-    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
-    {-command "set x" {set x} {} {}}
-    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
-    {-digits 5 5 badValue {expected integer but got "badValue"}}
-    {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}}
-    {-font fixed fixed {} {font "" doesn't exist}}
-    {-foreground green green badValue {unknown color name "badValue"}}
-    {-from -15.0 -15.0 badValue
-	    {expected floating-point number but got "badValue"}}
-    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
-    {-highlightcolor #123456 #123456 non-existent
-	    {unknown color name "non-existent"}}
-    {-highlightthickness 2 2 badValue {bad screen distance "badValue"}}
-    {-label "Some text" {Some text} {} {}}
-    {-length 130 130 badValue {bad screen distance "badValue"}}
-    {-orient horizontal horizontal badValue
-	    {bad orient "badValue": must be horizontal or vertical}}
-    {-orient horizontal horizontal {} {}}
-    {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
-    {-repeatdelay 14 14 bogus {expected integer but got "bogus"}}
-    {-repeatinterval 14 14 bogus {expected integer but got "bogus"}}
-    {-resolution 2.0 2.0 badValue
-	    {expected floating-point number but got "badValue"}}
-    {-showvalue 0 0 badValue {expected boolean value but got "badValue"}}
-    {-sliderlength 86 86 badValue {bad screen distance "badValue"}}
-    {-sliderrelief raised raised badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
-    {-state d disabled badValue
-	    {bad state "badValue": must be active, disabled, or normal}}
-    {-state n normal {} {}}
-    {-takefocus "any string" "any string" {} {}}
-    {-tickinterval 4.3 4.0 badValue
-	    {expected floating-point number but got "badValue"}}
-    {-to 14.9 15.0 badValue
-	    {expected floating-point number but got "badValue"}}
-    {-troughcolor #ff0000 #ff0000 non-existent
-	    {unknown color name "non-existent"}}
-    {-variable x x {} {}}
-    {-width 32 32 badValue {bad screen distance "badValue"}}
-} {
-    set name [lindex $test 0]
-    test scale-1.$i {configuration options} {
-	.s configure $name [lindex $test 1]
-	lindex [.s configure $name] 4
-    } [lindex $test 2]
-    incr i
-    if {[lindex $test 3] ne ""} {
-	test scale-1.$i {configuration options} {
-	    list [catch {.s configure $name [lindex $test 3]} msg] $msg
-	} [list 1 [lindex $test 4]]
-    }
-    .s configure $name [lindex [.s configure $name] 3]
-    incr i
-}
+
+test scale-1.1 {configuration options} -body {
+    .s configure -activebackground #ff0000
+    .s cget -activebackground
+} -cleanup {
+    .s configure -activebackground [lindex [.s configure -activebackground] 3]
+} -result {#ff0000}
+test scale-1.2 {configuration options} -body {
+        .s configure -activebackground non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test scale-1.3 {configuration options} -body {
+    .s configure -background #ff0000
+    .s cget -background
+} -cleanup {
+    .s configure -background [lindex [.s configure -background] 3]
+} -result {#ff0000}
+test scale-1.4 {configuration options} -body {
+        .s configure -background non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test scale-1.5 {configuration options} -body {
+    .s configure -bd 4
+    .s cget -bd
+} -cleanup {
+    .s configure -bd [lindex [.s configure -bd] 3]
+} -result {4}
+test scale-1.6 {configuration options} -body {
+        .s configure -bd badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test scale-1.7 {configuration options} -body {
+    .s configure -bigincrement 12.5
+    .s cget -bigincrement
+} -cleanup {
+    .s configure -bigincrement [lindex [.s configure -bigincrement] 3]
+} -result {12.5}
+test scale-1.8 {configuration options} -body {
+        .s configure -bigincrement badValue
+} -returnCodes error -result {expected floating-point number but got "badValue"}
+test scale-1.9 {configuration options} -body {
+    .s configure -bg #ff0000
+    .s cget -bg
+} -cleanup {
+    .s configure -bg [lindex [.s configure -bg] 3]
+} -result {#ff0000}
+test scale-1.10 {configuration options} -body {
+        .s configure -bg non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test scale-1.11 {configuration options} -body {
+    .s configure -borderwidth 1.3
+    .s cget -borderwidth
+} -cleanup {
+    .s configure -borderwidth [lindex [.s configure -borderwidth] 3]
+} -result {1}
+test scale-1.12 {configuration options} -body {
+        .s configure -borderwidth badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test scale-1.13 {configuration options} -body {
+    .s configure -command {set x}
+    .s cget -command
+} -cleanup {
+    .s configure -command [lindex [.s configure -command] 3]
+} -result {set x}
+test scale-1.15 {configuration options} -body {
+    .s configure -cursor arrow
+    .s cget -cursor
+} -cleanup {
+    .s configure -cursor [lindex [.s configure -cursor] 3]
+} -result {arrow}
+test scale-1.16 {configuration options} -body {
+        .s configure -cursor badValue
+} -returnCodes error -result {bad cursor spec "badValue"}
+test scale-1.17 {configuration options} -body {
+    .s configure -digits 5
+    .s cget -digits
+} -cleanup {
+    .s configure -digits [lindex [.s configure -digits] 3]
+} -result {5}
+test scale-1.18 {configuration options} -body {
+        .s configure -digits badValue
+} -returnCodes error -result {expected integer but got "badValue"}
+test scale-1.19 {configuration options} -body {
+    .s configure -fg #00ff00
+    .s cget -fg
+} -cleanup {
+    .s configure -fg [lindex [.s configure -fg] 3]
+} -result {#00ff00}
+test scale-1.20 {configuration options} -body {
+        .s configure -fg badValue
+} -returnCodes error -result {unknown color name "badValue"}
+test scale-1.21 {configuration options} -body {
+    .s configure -font fixed
+    .s cget -font
+} -cleanup {
+    .s configure -font [lindex [.s configure -font] 3]
+} -result {fixed}
+test scale-1.23 {configuration options} -body {
+    .s configure -foreground green
+    .s cget -foreground
+} -cleanup {
+    .s configure -foreground [lindex [.s configure -foreground] 3]
+} -result {green}
+test scale-1.24 {configuration options} -body {
+        .s configure -foreground badValue
+} -returnCodes error -result {unknown color name "badValue"}
+test scale-1.25 {configuration options} -body {
+    .s configure -from -15.0
+    .s cget -from
+} -cleanup {
+    .s configure -from [lindex [.s configure -from] 3]
+} -result {-15.0}
+test scale-1.26 {configuration options} -body {
+        .s configure -from badValue
+} -returnCodes error -result {expected floating-point number but got "badValue"}
+test scale-1.27 {configuration options} -body {
+    .s configure -highlightbackground #112233
+    .s cget -highlightbackground
+} -cleanup {
+    .s configure -highlightbackground [lindex [.s configure -highlightbackground] 3]
+} -result {#112233}
+test scale-1.28 {configuration options} -body {
+        .s configure -highlightbackground ugly
+} -returnCodes error -result {unknown color name "ugly"}
+test scale-1.29 {configuration options} -body {
+    .s configure -highlightcolor #123456
+    .s cget -highlightcolor
+} -cleanup {
+    .s configure -highlightcolor [lindex [.s configure -highlightcolor] 3]
+} -result {#123456}
+test scale-1.30 {configuration options} -body {
+        .s configure -highlightcolor non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test scale-1.31 {configuration options} -body {
+    .s configure -highlightthickness 2
+    .s cget -highlightthickness
+} -cleanup {
+    .s configure -highlightthickness [lindex [.s configure -highlightthickness] 3]
+} -result {2}
+test scale-1.32 {configuration options} -body {
+        .s configure -highlightthickness badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test scale-1.33 {configuration options} -body {
+    .s configure -label {Some text}
+    .s cget -label
+} -cleanup {
+    .s configure -label [lindex [.s configure -label] 3]
+} -result {Some text}
+test scale-1.35 {configuration options} -body {
+    .s configure -length 130
+    .s cget -length
+} -cleanup {
+    .s configure -length [lindex [.s configure -length] 3]
+} -result {130}
+test scale-1.36 {configuration options} -body {
+        .s configure -length badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test scale-1.37 {configuration options} -body {
+    .s configure -orient horizontal
+    .s cget -orient
+} -cleanup {
+    .s configure -orient [lindex [.s configure -orient] 3]
+} -result {horizontal}
+test scale-1.38 {configuration options} -body {
+        .s configure -orient badValue
+} -returnCodes error -result {bad orient "badValue": must be horizontal or vertical}
+test scale-1.39 {configuration options} -body {
+    .s configure -orient horizontal
+    .s cget -orient
+} -cleanup {
+    .s configure -orient [lindex [.s configure -orient] 3]
+} -result {horizontal}
+test scale-1.41 {configuration options} -body {
+    .s configure -relief ridge
+    .s cget -relief
+} -cleanup {
+    .s configure -relief [lindex [.s configure -relief] 3]
+} -result {ridge}
+test scale-1.42 {configuration options} -body {
+        .s configure -relief badValue
+} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
+test scale-1.43 {configuration options} -body {
+    .s configure -repeatdelay 14
+    .s cget -repeatdelay
+} -cleanup {
+    .s configure -repeatdelay [lindex [.s configure -repeatdelay] 3]
+} -result {14}
+test scale-1.44 {configuration options} -body {
+        .s configure -repeatdelay bogus
+} -returnCodes error -result {expected integer but got "bogus"}
+test scale-1.45 {configuration options} -body {
+    .s configure -repeatinterval 14
+    .s cget -repeatinterval
+} -cleanup {
+    .s configure -repeatinterval [lindex [.s configure -repeatinterval] 3]
+} -result {14}
+test scale-1.46 {configuration options} -body {
+        .s configure -repeatinterval bogus
+} -returnCodes error -result {expected integer but got "bogus"}
+test scale-1.47 {configuration options} -body {
+    .s configure -resolution 2.0
+    .s cget -resolution
+} -cleanup {
+    .s configure -resolution [lindex [.s configure -resolution] 3]
+} -result {2.0}
+test scale-1.48 {configuration options} -body {
+        .s configure -resolution badValue
+} -returnCodes error -result {expected floating-point number but got "badValue"}
+test scale-1.49 {configuration options} -body {
+    .s configure -showvalue 0
+    .s cget -showvalue
+} -cleanup {
+    .s configure -showvalue [lindex [.s configure -showvalue] 3]
+} -result {0}
+test scale-1.50 {configuration options} -body {
+        .s configure -showvalue badValue
+} -returnCodes error -result {expected boolean value but got "badValue"}
+test scale-1.51 {configuration options} -body {
+    .s configure -sliderlength 86
+    .s cget -sliderlength
+} -cleanup {
+    .s configure -sliderlength [lindex [.s configure -sliderlength] 3]
+} -result {86}
+test scale-1.52 {configuration options} -body {
+        .s configure -sliderlength badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test scale-1.53 {configuration options} -body {
+    .s configure -sliderrelief raised
+    .s cget -sliderrelief
+} -cleanup {
+    .s configure -sliderrelief [lindex [.s configure -sliderrelief] 3]
+} -result {raised}
+test scale-1.54 {configuration options} -body {
+        .s configure -sliderrelief badValue
+} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
+test scale-1.55 {configuration options} -body {
+    .s configure -state d
+    .s cget -state
+} -cleanup {
+    .s configure -state [lindex [.s configure -state] 3]
+} -result {disabled}
+test scale-1.56 {configuration options} -body {
+        .s configure -state badValue
+} -returnCodes error -result {bad state "badValue": must be active, disabled, or normal}
+test scale-1.57 {configuration options} -body {
+    .s configure -state n
+    .s cget -state
+} -cleanup {
+    .s configure -state [lindex [.s configure -state] 3]
+} -result {normal}
+test scale-1.59 {configuration options} -body {
+    .s configure -takefocus {any string}
+    .s cget -takefocus
+} -cleanup {
+    .s configure -takefocus [lindex [.s configure -takefocus] 3]
+} -result {any string}
+test scale-1.61 {configuration options} -body {
+    .s configure -tickinterval 4.3
+    .s cget -tickinterval
+} -cleanup {
+    .s configure -tickinterval [lindex [.s configure -tickinterval] 3]
+} -result {4.0}
+test scale-1.62 {configuration options} -body {
+        .s configure -tickinterval badValue
+} -returnCodes error -result {expected floating-point number but got "badValue"}
+test scale-1.63 {configuration options} -body {
+    .s configure -to 14.9
+    .s cget -to
+} -cleanup {
+    .s configure -to [lindex [.s configure -to] 3]
+} -result {15.0}
+test scale-1.64 {configuration options} -body {
+        .s configure -to badValue
+} -returnCodes error -result {expected floating-point number but got "badValue"}
+test scale-1.65 {configuration options} -body {
+    .s configure -troughcolor #ff0000
+    .s cget -troughcolor
+} -cleanup {
+    .s configure -troughcolor [lindex [.s configure -troughcolor] 3]
+} -result {#ff0000}
+test scale-1.66 {configuration options} -body {
+        .s configure -troughcolor non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test scale-1.67 {configuration options} -body {
+    .s configure -variable x
+    .s cget -variable
+} -cleanup {
+    .s configure -variable [lindex [.s configure -variable] 3]
+} -result {x}
+test scale-1.69 {configuration options} -body {
+    .s configure -width 32
+    .s cget -width
+} -cleanup {
+    .s configure -width [lindex [.s configure -width] 3]
+} -result {32}
+test scale-1.70 {configuration options} -body {
+        .s configure -width badValue
+} -returnCodes error -result {bad screen distance "badValue"}
 destroy .s
 
-test scale-2.1 {Tk_ScaleCmd procedure} {
-    list [catch {scale} msg] $msg
-} {1 {wrong # args: should be "scale pathName ?-option value ...?"}}
-test scale-2.2 {Tk_ScaleCmd procedure} {
-    list [catch {scale foo} msg] $msg [winfo child .]
-} {1 {bad window path name "foo"} {}}
-test scale-2.3 {Tk_ScaleCmd procedure} {
-    list [catch {scale .s -gorp dumb} msg] $msg [winfo child .]
-} {1 {unknown option "-gorp"} {}}
 
+test scale-2.1 {Tk_ScaleCmd procedure} -body {
+    scale
+} -returnCodes error -result {wrong # args: should be "scale pathName ?-option value ...?"}
+test scale-2.2 {Tk_ScaleCmd procedure} -body {
+    scale foo 
+} -returnCodes error -result {bad window path name "foo"}
+test scale-2.3 {Tk_ScaleCmd procedure} -body {
+    catch {scale foo}
+    winfo child .
+} -result {}
+test scale-2.4 {Tk_ScaleCmd procedure} -body {
+    scale .s -gorp dumb
+} -returnCodes error -result {unknown option "-gorp"}
+test scale-2.5 {Tk_ScaleCmd procedure} -body {
+    catch {scale .s -gorp dumb}
+    winfo child .
+} -result {}
+
+
+# Widget used in 3.* tests
+destroy .s
 scale .s -from 100 -to 200
 pack .s
 update idletasks
-test scale-3.1 {ScaleWidgetCmd procedure} {
-    list [catch {.s} msg] $msg
-} {1 {wrong # args: should be ".s option ?arg ...?"}}
-test scale-3.2 {ScaleWidgetCmd procedure, cget option} {
-    list [catch {.s cget} msg] $msg
-} {1 {wrong # args: should be ".s cget option"}}
-test scale-3.3 {ScaleWidgetCmd procedure, cget option} {
-    list [catch {.s cget a b} msg] $msg
-} {1 {wrong # args: should be ".s cget option"}}
-test scale-3.4 {ScaleWidgetCmd procedure, cget option} {
-    list [catch {.s cget -gorp} msg] $msg
-} {1 {unknown option "-gorp"}}
-test scale-3.5 {ScaleWidgetCmd procedure, cget option} {
+test scale-3.1 {ScaleWidgetCmd procedure} -body {
+    .s
+} -returnCodes error -result {wrong # args: should be ".s option ?arg ...?"}
+test scale-3.2 {ScaleWidgetCmd procedure, cget option} -body {
+    .s cget
+} -returnCodes error -result {wrong # args: should be ".s cget option"}
+test scale-3.3 {ScaleWidgetCmd procedure, cget option} -body {
+    .s cget a b
+} -returnCodes error -result {wrong # args: should be ".s cget option"}
+test scale-3.4 {ScaleWidgetCmd procedure, cget option} -body {
+    .s cget -gorp
+} -returnCodes error -result {unknown option "-gorp"}
+test scale-3.5 {ScaleWidgetCmd procedure, cget option} -body {
+    .s configure -highlightthickness 2
     .s cget -highlightthickness
-} {2}
-test scale-3.6 {ScaleWidgetCmd procedure, configure option} {
+} -result {2}
+test scale-3.6 {ScaleWidgetCmd procedure, configure option} -body {
     list [llength [.s configure]] [lindex [.s configure] 6]
-} {33 {-command command Command {} {}}}
-test scale-3.7 {ScaleWidgetCmd procedure, configure option} {
-    list [catch {.s configure -foo} msg] $msg
-} {1 {unknown option "-foo"}}
-test scale-3.8 {ScaleWidgetCmd procedure, configure option} {
-    list [catch {.s configure -borderwidth 2 -bg} msg] $msg
-} {1 {value for "-bg" missing}}
-test scale-3.9 {ScaleWidgetCmd procedure, coords option} {
-    list [catch {.s coords a b} msg] $msg
-} {1 {wrong # args: should be ".s coords ?value?"}}
-test scale-3.10 {ScaleWidgetCmd procedure, coords option} {
-    list [catch {.s coords bad} msg] $msg
-} {1 {expected floating-point number but got "bad"}}
-test scale-3.11 {ScaleWidgetCmd procedure} {fonts} {
+} -result {33 {-command command Command {} {}}}
+test scale-3.7 {ScaleWidgetCmd procedure, configure option} -body {
+    .s configure -foo
+} -returnCodes error -result {unknown option "-foo"}
+test scale-3.8 {ScaleWidgetCmd procedure, configure option} -body {
+    .s configure -borderwidth 2 -bg
+} -returnCodes error -result {value for "-bg" missing}
+test scale-3.9 {ScaleWidgetCmd procedure, coords option} -body {
+    .s coords a b
+} -returnCodes error -result {wrong # args: should be ".s coords ?value?"}
+test scale-3.10 {ScaleWidgetCmd procedure, coords option} -body {
+    .s coords bad
+} -returnCodes error -result {expected floating-point number but got "bad"}
+test scale-3.11 {ScaleWidgetCmd procedure} -constraints {
+	fonts
+} -body {
+    .s configure -from 100 -to 200
+    update idletasks
     .s set 120
     .s coords
-} {38 34}
-test scale-3.12 {ScaleWidgetCmd procedure, coords option} {fonts} {
-    .s configure -orient horizontal
-    update
+} -result {38 34}
+test scale-3.12 {ScaleWidgetCmd procedure, coords option} -constraints {
+	fonts
+} -body {
+    .s configure -from 100 -to 200 -orient horizontal
+    update idletasks
     .s set 120
     .s coords
-} {34 31}
-.s configure -orient vertical
-update
-test scale-3.13 {ScaleWidgetCmd procedure, get option} {
-    list [catch {.s get a} msg] $msg
-} {1 {wrong # args: should be ".s get ?x y?"}}
-test scale-3.14 {ScaleWidgetCmd procedure, get option} {
-    list [catch {.s get a b c} msg] $msg
-} {1 {wrong # args: should be ".s get ?x y?"}}
-test scale-3.15 {ScaleWidgetCmd procedure, get option} {
-    list [catch {.s get a 11} msg] $msg
-} {1 {expected integer but got "a"}}
-test scale-3.16 {ScaleWidgetCmd procedure, get option} {
-    list [catch {.s get 12 b} msg] $msg
-} {1 {expected integer but got "b"}}
-test scale-3.17 {ScaleWidgetCmd procedure, get option} {
+} -result {34 31}
+test scale-3.13 {ScaleWidgetCmd procedure, get option} -body {
+    .s configure -orient vertical
+    update
+    .s get a
+} -returnCodes error -result {wrong # args: should be ".s get ?x y?"}
+test scale-3.14 {ScaleWidgetCmd procedure, get option} -body {
+    .s configure -orient vertical
+    update
+    .s get a b c
+} -returnCodes error -result {wrong # args: should be ".s get ?x y?"}
+test scale-3.15 {ScaleWidgetCmd procedure, get option} -body {
+    .s configure -orient vertical
+    update
+    .s get a 11
+} -returnCodes error -result {expected integer but got "a"}
+test scale-3.16 {ScaleWidgetCmd procedure, get option} -body {
+    .s configure -orient vertical
+    update
+    .s get 12 b
+} -returnCodes error -result {expected integer but got "b"}
+test scale-3.17 {ScaleWidgetCmd procedure, get option} -body {
+    .s configure -orient vertical
+    update
     .s set 133
     .s get
-} 133
-test scale-3.18 {ScaleWidgetCmd procedure, get option} {
-    .s configure -resolution 0.5
+} -result 133
+test scale-3.18 {ScaleWidgetCmd procedure, get option} -body {
+    .s configure -orient vertical -resolution 0.5
+    update
     .s set 150
     .s get 37 34
-} 119.5
+} -result {119.5}
 .s configure -resolution 1
-test scale-3.19 {ScaleWidgetCmd procedure, identify option} {
-    list [catch {.s identify} msg] $msg
-} {1 {wrong # args: should be ".s identify x y"}}
-test scale-3.20 {ScaleWidgetCmd procedure, identify option} {
-    list [catch {.s identify 1 2 3} msg] $msg
-} {1 {wrong # args: should be ".s identify x y"}}
-test scale-3.21 {ScaleWidgetCmd procedure, identify option} {
-    list [catch {.s identify boo 16} msg] $msg
-} {1 {expected integer but got "boo"}}
-test scale-3.22 {ScaleWidgetCmd procedure, identify option} {
-    list [catch {.s identify 17 bad} msg] $msg
-} {1 {expected integer but got "bad"}}
-test scale-3.23 {ScaleWidgetCmd procedure, identify option} {fonts} {
+test scale-3.19 {ScaleWidgetCmd procedure, identify option} -body {
+    .s identify
+} -returnCodes error -result {wrong # args: should be ".s identify x y"}
+test scale-3.20 {ScaleWidgetCmd procedure, identify option} -body {
+    .s identify 1 2 3
+} -returnCodes error -result {wrong # args: should be ".s identify x y"}
+test scale-3.21 {ScaleWidgetCmd procedure, identify option} -body {
+    .s identify boo 16
+} -returnCodes error -result {expected integer but got "boo"}
+test scale-3.22 {ScaleWidgetCmd procedure, identify option} -body {
+    .s identify 17 bad
+} -returnCodes error -result {expected integer but got "bad"}
+test scale-3.23 {ScaleWidgetCmd procedure, identify option} -constraints {
+	fonts
+} -body {
+    .s configure -from 100 -to 200 -orient vertical -resolution 1
+    update
     .s set 120
     list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80]
-} {trough1 slider trough2 {}}
-test scale-3.24 {ScaleWidgetCmd procedure, set option} {
-    list [catch {.s set} msg] $msg
-} {1 {wrong # args: should be ".s set value"}}
-test scale-3.25 {ScaleWidgetCmd procedure, set option} {
-    list [catch {.s set a b} msg] $msg
-} {1 {wrong # args: should be ".s set value"}}
-test scale-3.26 {ScaleWidgetCmd procedure, set option} {
-    list [catch {.s set bad} msg] $msg
-} {1 {expected floating-point number but got "bad"}}
-test scale-3.27 {ScaleWidgetCmd procedure, set option} {
+} -result {trough1 slider trough2 {}}
+test scale-3.24 {ScaleWidgetCmd procedure, set option} -body {
+    .s set
+} -returnCodes error -result {wrong # args: should be ".s set value"}
+test scale-3.25 {ScaleWidgetCmd procedure, set option} -body {
+    .s set a b
+} -returnCodes error -result {wrong # args: should be ".s set value"}
+test scale-3.26 {ScaleWidgetCmd procedure, set option} -body {
+    .s set bad
+} -returnCodes error -result {expected floating-point number but got "bad"}
+test scale-3.27 {ScaleWidgetCmd procedure, set option} -body {
+    .s configure -from 100 -to 200 -orient vertical -resolution 0.5
+    update
     .s set 142
-} {}
-test scale-3.28 {ScaleWidgetCmd procedure, set option} {
+} -result {}
+test scale-3.28 {ScaleWidgetCmd procedure, set option} -body {
+    .s configure -from 100 -to 200 -orient vertical -resolution 1
+    update
     .s set 118
     .s configure -state disabled
     .s set 181
     .s configure -state normal
     .s get
-} {118}
-test scale-3.29 {ScaleWidgetCmd procedure} {
-    list [catch {.s dumb} msg] $msg
-} {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}}
-test scale-3.30 {ScaleWidgetCmd procedure} {
-    list [catch {.s c} msg] $msg
-} {1 {ambiguous option "c": must be cget, configure, coords, get, identify, or set}}
-test scale-3.31 {ScaleWidgetCmd procedure} {
-    list [catch {.s co} msg] $msg
-} {1 {ambiguous option "co": must be cget, configure, coords, get, identify, or set}}
-test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} {
+} -result {118}
+test scale-3.29 {ScaleWidgetCmd procedure} -body {
+    .s dumb
+} -returnCodes error -result {bad option "dumb": must be cget, configure, coords, get, identify, or set}
+test scale-3.30 {ScaleWidgetCmd procedure} -body {
+    .s c
+} -returnCodes error -result {ambiguous option "c": must be cget, configure, coords, get, identify, or set}
+test scale-3.31 {ScaleWidgetCmd procedure} -body {
+    .s co
+} -returnCodes error -result {ambiguous option "co": must be cget, configure, coords, get, identify, or set}
+destroy .s
+
+test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} -setup {
+    destroy .s
+} -body {
     proc kill args {
-	destroy .s
+	    destroy .s
     }
-    catch {destroy .s}
     scale .s -variable x -from 0 -to 100 -orient horizontal
     pack .s
     update
     .s configure -command kill
     .s set 55
-} {}
+} -cleanup {
+    destroy .s
+} -result {}
+
 
-test scale-4.1 {DestroyScale procedure} {
-    catch {destroy .s}
+test scale-4.1 {DestroyScale procedure} -setup {
+    deleteWindows
+} -body {
     set x 50
     scale .s -variable x -from 0 -to 100 -orient horizontal
     pack .s
     update
     destroy .s
     list [catch {set x foo} msg] $msg $x
-} {0 foo foo}
+} -result {0 foo foo}
+
 
-test scale-5.1 {ConfigureScale procedure} {
-    catch {destroy .s}
+test scale-5.1 {ConfigureScale procedure} -setup {
+    deleteWindows
+} -body {
     set x 66
     set y 77
     scale .s -variable x -from 0 -to 100
@@ -240,14 +518,20 @@ test scale-5.1 {ConfigureScale procedure} {
     update
     .s configure -variable y
     list [catch {set x foo} msg] $msg $x [.s get]
-} {0 foo foo 77}
-test scale-5.2 {ConfigureScale procedure} {
-    catch {destroy .s}
+} -cleanup {
+    deleteWindows
+} -result {0 foo foo 77}
+test scale-5.2 {ConfigureScale procedure} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 100
-    list [catch {.s configure -foo bar} msg] $msg
-} {1 {unknown option "-foo"}}
-test scale-5.3 {ConfigureScale procedure} {
-    catch {destroy .s}
+    .s configure -foo bar
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {unknown option "-foo"}
+test scale-5.3 {ConfigureScale procedure} -setup {
+    deleteWindows
+} -body {
     catch {unset x}
     scale .s -from 0 -to 100 -variable x
     set result $x
@@ -257,349 +541,475 @@ test scale-5.3 {ConfigureScale procedure} {
     .s set 3
     lappend result $x
     unset x
-    lappend result [catch {set x} msg] $msg
-} {0 0 92 3 0 3}
-test scale-5.4 {ConfigureScale procedure} {
-    catch {destroy .s}
+    lappend result [set x]
+} -cleanup {
+    deleteWindows
+} -result {0 0 92 3 3}
+test scale-5.4 {ConfigureScale procedure} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 100
-    list [catch {.s configure -orient dumb} msg] $msg
-} {1 {bad orient "dumb": must be horizontal or vertical}}
-test scale-5.5 {ConfigureScale procedure} {
-    catch {destroy .s}
+    .s configure -orient dumb
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {bad orient "dumb": must be horizontal or vertical}
+test scale-5.5 {ConfigureScale procedure} -setup {
+    deleteWindows
+} -body {
     scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76
     list [format %.1f [.s cget -from]] [format %.1f [.s cget -to]] \
-	    [format %.1f [.s cget -tickinterval]]
-} {1.1 1.9 0.8}
-test scale-5.6 {ConfigureScale procedure} {
-    catch {destroy .s}
+        [format %.1f [.s cget -tickinterval]]
+} -cleanup {
+    deleteWindows
+} -result {1.1 1.9 0.8}
+test scale-5.6 {ConfigureScale procedure} -setup {
+    deleteWindows
+} -body {
     scale .s -from 1 -to 10 -tickinterval -2
     pack .s
     set result [lindex [.s configure -tickinterval] 4]
     .s configure -from 10 -to 1 -tickinterval 2
     lappend result [lindex [.s configure -tickinterval] 4]
-} {2.0 -2.0}
-test scale-5.7 {ConfigureScale procedure} {
-    catch {destroy .s}
-    list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg
-} {1 {bad state "bogus": must be active, disabled, or normal}}
+} -cleanup {
+    deleteWindows
+} -result {2.0 -2.0}
+test scale-5.7 {ConfigureScale procedure} -setup {
+    deleteWindows
+} -body {
+    scale .s -from 0 -to 100 -state bogus
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {bad state "bogus": must be active, disabled, or normal}
+
 
-catch {destroy .s}
+# Widget used in 6.* tests
+destroy .s
 scale .s -orient horizontal -length 200
 pack .s
-test scale-6.1 {ComputeFormat procedure} {
+test scale-6.1 {ComputeFormat procedure} -body {
     .s configure -from 10 -to 100 -resolution 10
     .s set 49.3
     .s get
-} {50}
-test scale-6.2 {ComputeFormat procedure} {
+} -result {50}
+test scale-6.2 {ComputeFormat procedure} -body {
     .s configure -from 100 -to 1000 -resolution 100
     .s set 493
     .s get
-} {500}
-test scale-6.3 {ComputeFormat procedure} {
+} -result {500}
+test scale-6.3 {ComputeFormat procedure} -body {
     .s configure -from 1000 -to 10000 -resolution 1000
     .s set 4930
     .s get
-} {5000}
-test scale-6.4 {ComputeFormat procedure} {
+} -result {5000}
+test scale-6.4 {ComputeFormat procedure} -body {
     .s configure -from 10000 -to 100000 -resolution 10000
     .s set 49000
     .s get
-} {50000}
-test scale-6.5 {ComputeFormat procedure} {
+} -result {50000}
+test scale-6.5 {ComputeFormat procedure} -body {
     .s configure -from 100000 -to 1000000 -resolution 100000
     .s set 493000
     .s get
-} {500000}
-test scale-6.6 {ComputeFormat procedure} {nonPortable} {
+} -result {500000}
+test scale-6.6 {ComputeFormat procedure} -constraints {
+	nonPortable
+} -body {
     # This test is non-portable because some platforms format the
     # result as 5e+06.
-
     .s configure -from 1000000 -to 10000000 -resolution 1000000
     .s set 4930000
     .s get
-} {5000000}
-test scale-6.7 {ComputeFormat procedure} {
+} -result {5000000}
+test scale-6.7 {ComputeFormat procedure} -body {
     .s configure -from 1000000000 -to 10000000000 -resolution 1000000000
     .s set 4930000000
     expr {[.s get] == 5.0e+09}
-} 1
-test scale-6.8 {ComputeFormat procedure} {
+} -result 1
+test scale-6.8 {ComputeFormat procedure} -body {
     .s configure -from .1 -to 1 -resolution .1
     .s set .6
     .s get
-} {0.6}
-test scale-6.9 {ComputeFormat procedure} {
+} -result {0.6}
+test scale-6.9 {ComputeFormat procedure} -body {
     .s configure -from .01 -to .1 -resolution .01
     .s set .06
     .s get
-} {0.06}
-test scale-6.10 {ComputeFormat procedure} {
+} -result {0.06}
+test scale-6.10 {ComputeFormat procedure} -body {
     .s configure -from .001 -to .01 -resolution .001
     .s set .006
     .s get
-} {0.006}
-test scale-6.11 {ComputeFormat procedure} {
+} -result {0.006}
+test scale-6.11 {ComputeFormat procedure} -body {
     .s configure -from .0001 -to .001 -resolution .0001
     .s set .0006
     .s get
-} {0.0006}
-test scale-6.12 {ComputeFormat procedure} {
+} -result {0.0006}
+test scale-6.12 {ComputeFormat procedure} -body {
     .s configure -from .00001 -to .0001 -resolution .00001
     .s set .00006
     .s get
-} {0.00006}
-test scale-6.13 {ComputeFormat procedure} {
+} -result {0.00006}
+test scale-6.13 {ComputeFormat procedure} -body {
     .s configure -from .000001 -to .00001 -resolution .000001
     .s set .000006
     expr {[.s get] == 6.0e-06}
-} {1}
-test scale-6.14 {ComputeFormat procedure} {
+} -result {1}
+test scale-6.14 {ComputeFormat procedure} -body {
     .s configure -to .00001 -from .0001 -resolution .00001
     .s set .00006
     .s get
-} {0.00006}
-test scale-6.15 {ComputeFormat procedure} {
+} -result {0.00006}
+test scale-6.15 {ComputeFormat procedure} -body {
     .s configure -to .000001 -from .00001 -resolution .000001
     .s set .000006
     expr {[.s get] == 6.0e-06}
-} {1}
-test scale-6.16 {ComputeFormat procedure} {
+} -result {1}
+test scale-6.16 {ComputeFormat procedure} -body {
     .s configure -from .00001 -to .0001 -resolution .00001 -digits 1
     .s set .00006
     expr {[.s get] == 6e-05}
-} {1}
-test scale-6.17 {ComputeFormat procedure} {
+} -result {1}
+test scale-6.17 {ComputeFormat procedure} -body {
     .s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3
     .s set 49300000
     .s get
-} {50000000}
-test scale-6.18 {ComputeFormat procedure} {
+} -result {50000000}
+test scale-6.18 {ComputeFormat procedure} -body {
     .s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0
     .s set .111111111
     .s get
-} {0.11}
-test scale-6.19 {ComputeFormat procedure} {
+} -result {0.11}
+test scale-6.19 {ComputeFormat procedure} -body {
     .s configure -length 200 -from 1000 -to 1002 -resolution 0 -digits 0
     .s set 1001.23456789
     .s get
-} {1001.23}
-test scale-6.20 {ComputeFormat procedure} {
+} -result {1001.23}
+test scale-6.20 {ComputeFormat procedure} -body {
     .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 0
     .s set 1001.23456789
     .s get
-} {1001.235}
+} -result {1001.235}
+destroy .s
 
-test scale-7.1 {ComputeScaleGeometry procedure} {nonPortable fonts} {
-    catch {destroy .s}
+
+test scale-7.1 {ComputeScaleGeometry procedure} -constraints {
+    nonPortable fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i
     pack .s
     update
     list [winfo reqwidth .s] [winfo reqheight .s]
-} {88 458}
-test scale-7.2 {ComputeScaleGeometry procedure} {fonts} {
-    catch {destroy .s}
+} -cleanup {
+    deleteWindows
+} -result {88 458}
+test scale-7.2 {ComputeScaleGeometry procedure} -constraints {
+    fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200
     pack .s
     update
     list [winfo reqwidth .s] [winfo reqheight .s]
-} {168 108}
-test scale-7.3 {ComputeScaleGeometry procedure} {fonts} {
-    catch {destroy .s}
+} -cleanup {
+    deleteWindows
+} -result {168 108}
+test scale-7.3 {ComputeScaleGeometry procedure} -constraints {
+    fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 \
-	    -sliderlength 10
+        -sliderlength 10
     pack .s
     update
     list [winfo reqwidth .s] [winfo reqheight .s]
-} {22 108}
-test scale-7.4 {ComputeScaleGeometry procedure} {fonts} {
-    catch {destroy .s}
+} -cleanup {
+    deleteWindows
+} -result {22 108}
+test scale-7.4 {ComputeScaleGeometry procedure} -constraints {
+    fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \
-	    -relief sunken
+        -relief sunken
     pack .s
     update
     list [winfo reqwidth .s] [winfo reqheight .s]
-} {39 114}
-test scale-7.5 {ComputeScaleGeometry procedure} {nonPortable fonts} {
-    catch {destroy .s}
+} -cleanup {
+    deleteWindows
+} -result {39 114}
+test scale-7.5 {ComputeScaleGeometry procedure} -constraints {
+    nonPortable fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i
     pack .s
     update
     list [winfo reqwidth .s] [winfo reqheight .s]
-} {458 61}
-test scale-7.6 {ComputeScaleGeometry procedure} {fonts} {
-    catch {destroy .s}
+} -cleanup {
+    deleteWindows
+} -result {458 61}
+test scale-7.6 {ComputeScaleGeometry procedure} -constraints {
+    fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 1000 -label "Long string" -orient horizontal \
-	    -tick 500
+        -tick 500
     pack .s
     update
     list [winfo reqwidth .s] [winfo reqheight .s]
-} {108 79}
-test scale-7.7 {ComputeScaleGeometry procedure} {fonts} {
-    catch {destroy .s}
+} -cleanup {
+    deleteWindows
+} -result {108 79}
+test scale-7.7 {ComputeScaleGeometry procedure} -constraints {
+    fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 1000 -orient horizontal -showvalue 0
     pack .s
     update
     list [winfo reqwidth .s] [winfo reqheight .s]
-} {108 27}
-test scale-7.8 {ComputeScaleGeometry procedure} {
-    catch {destroy .s}
+} -cleanup {
+    deleteWindows
+} -result {108 27}
+test scale-7.8 {ComputeScaleGeometry procedure} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 \
-	    -relief raised -highlightthickness 2
+        -relief raised -highlightthickness 2
     pack .s
     update
     list [winfo reqwidth .s] [winfo reqheight .s]
-} {114 39}
+} -cleanup {
+    deleteWindows
+} -result {114 39}
+
 
-test scale-8.1 {ScaleElement procedure} {fonts} {
-    catch {destroy .s}
+test scale-8.1 {ScaleElement procedure} -constraints {
+    fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
     pack .s
     .s set 30
     update
     list [.s identify 53 52] [.s identify 54 52] [.s identify 70 52] \
-	    [.s identify 71 52]
-} {{} trough1 trough1 {}}
-test scale-8.2 {ScaleElement procedure} {fonts} {
-    catch {destroy .s}
+        [.s identify 71 52]
+} -cleanup {
+    deleteWindows
+} -result {{} trough1 trough1 {}}
+test scale-8.2 {ScaleElement procedure} -constraints {
+    fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
     pack .s
     .s set 30
     update
     list [.s identify 60 2] [.s identify 60 3] [.s identify 60 302] \
-	    [.s identify 60 303]
-} {{} trough1 trough2 {}}
-test scale-8.3 {ScaleElement procedure} {fonts} {
-    catch {destroy .s}
+        [.s identify 60 303]
+} -cleanup {
+    deleteWindows
+} -result {{} trough1 trough2 {}}
+test scale-8.3 {ScaleElement procedure} -constraints {
+    fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
     pack .s
     .s set 30
     update
     list [.s identify 60 83] [.s identify 60 84] [.s identify 60 113] \
-	    [.s identify 60 114] \
-} {trough1 slider slider trough2}
-test scale-8.4 {ScaleElement procedure} {
-    catch {destroy .s}
+        [.s identify 60 114] \
+} -cleanup {
+    deleteWindows
+} -result {trough1 slider slider trough2}
+test scale-8.4 {ScaleElement procedure} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 100 -orient vertical -bd 4 -width 10 \
-	    -highlightthickness 1 -length 300 -showvalue 0
+        -highlightthickness 1 -length 300 -showvalue 0
     pack .s
     .s set 30
     update
     list [.s identify 4 40] [.s identify 5 40] [.s identify 22 40] \
-	    [.s identify 23 40] \
-} {{} trough1 trough1 {}}
-test scale-8.5 {ScaleElement procedure} {fonts} {
-    catch {destroy .s}
+        [.s identify 23 40] \
+} -cleanup {
+    deleteWindows
+} -result {{} trough1 trough1 {}}
+test scale-8.5 {ScaleElement procedure} -constraints {
+    fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 100 -orient horizontal -bd 1 \
-	    -highlightthickness 2 -tick 20 -sliderlength 20 \
-	    -length 200 -label Test
+        -highlightthickness 2 -tick 20 -sliderlength 20 \
+        -length 200 -label Test
     pack .s
     .s set 30
     update
     list [.s identify 150 36] [.s identify 150 37] [.s identify 150 53] \
-	    [.s identify 150 54]
-} {{} trough2 trough2 {}}
-test scale-8.6 {ScaleElement procedure} {fonts} {
-    catch {destroy .s}
+        [.s identify 150 54]
+} -cleanup {
+    deleteWindows
+} -result {{} trough2 trough2 {}}
+test scale-8.6 {ScaleElement procedure} -constraints {
+    fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 100 -orient horizontal -bd 2 \
-	    -highlightthickness 1 -tick 20 -length 200
+        -highlightthickness 1 -tick 20 -length 200
     pack .s
     .s set 30
     update
     list [.s identify 150 20] [.s identify 150 21] [.s identify 150 39] \
-	    [.s identify 150 40]
-} {{} trough2 trough2 {}}
-test scale-8.7 {ScaleElement procedure} {
-    catch {destroy .s}
+        [.s identify 150 40]
+} -cleanup {
+    deleteWindows
+} -result {{} trough2 trough2 {}}
+test scale-8.7 {ScaleElement procedure} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 100 -orient horizontal -bd 4 -highlightthickness 2 \
-	    -length 200 -width 10 -showvalue 0
+        -length 200 -width 10 -showvalue 0
     pack .s
     .s set 30
     update
     list [.s identify 30 5] [.s identify 30 6] [.s identify 30 23] \
-	    [.s identify 30 24]
-} {{} trough1 trough1 {}}
-test scale-8.8 {ScaleElement procedure} {
-    catch {destroy .s}
+        [.s identify 30 24]
+} -cleanup {
+    deleteWindows
+} -result {{} trough1 trough1 {}}
+test scale-8.8 {ScaleElement procedure} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
-	    -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
+        -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
     pack .s
     .s set 30
     update
     list [.s identify 2 28] [.s identify 3 28] [.s identify 202 28] \
-	    [.s identify 203 28]
-} {{} trough1 trough2 {}}
-test scale-8.9 {ScaleElement procedure} {
-    catch {destroy .s}
+        [.s identify 203 28]
+} -cleanup {
+    deleteWindows
+} -result {{} trough1 trough2 {}}
+test scale-8.9 {ScaleElement procedure} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
-	    -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
+        -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
     pack .s
     .s set 80
     update
     list [.s identify 145 28] [.s identify 146 28] [.s identify 165 28] \
-	    [.s identify 166 28]
-} {trough1 slider slider trough2}
+        [.s identify 166 28]
+} -cleanup {
+    deleteWindows
+} -result {trough1 slider slider trough2}
 
-catch {destroy .s}
-scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
-pack .s
-update
-test scale-9.1 {PixelToValue procedure} {
+
+#widget used in 9.* tests
+destroy .s
+pack [scale .s]
+test scale-9.1 {PixelToValue procedure} -body {
+    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
+    update
     .s get 46 0
-} 0
-test scale-9.2 {PixelToValue procedure} {
+} -result 0
+test scale-9.2 {PixelToValue procedure} -body {
+    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
+    update
     .s get -10 9
-} 0
-test scale-9.3 {PixelToValue procedure} {
+} -result 0
+test scale-9.3 {PixelToValue procedure} -body {
+    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
+    update
     .s get -10 12
-} 1
-test scale-9.4 {PixelToValue procedure} {
+} -result 1
+test scale-9.4 {PixelToValue procedure} -body {
+    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
+    update
     .s get -10 46
-} 35
-test scale-9.5 {PixelToValue procedure} {
+} -result 35
+test scale-9.5 {PixelToValue procedure} -body {
+    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
+    update
     .s get -10 110
-} 99
-test scale-9.6 {PixelToValue procedure} {
+} -result 99
+test scale-9.6 {PixelToValue procedure} -body {
+    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
+    update
     .s get -10 111
-} 100
-test scale-9.7 {PixelToValue procedure} {
+} -result 100
+test scale-9.7 {PixelToValue procedure} -body {
+    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
+    update
     .s get -10 112
-} 100
-test scale-9.8 {PixelToValue procedure} {
+} -result 100
+test scale-9.8 {PixelToValue procedure} -body {
+    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
+    update
     .s get -10 154
-} 100
-.s configure -orient horizontal
-update
-test scale-9.9 {PixelToValue procedure} {
+} -result 100
+test scale-9.9 {PixelToValue procedure} -body {
+    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal
+    update
     .s get 76 152
-} 65
+} -result 65
+destroy .s
+
 
-test scale-10.1 {ValueToPixel procedure} {fonts} {
-    catch {destroy .s}
+test scale-10.1 {ValueToPixel procedure} -constraints {
+    fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 0 -to 100 -sliderlength 20 -length 124 -bd 2 \
-	    -orient horizontal -label Test -tick 20
+        -orient horizontal -label Test -tick 20
     pack .s
     update
     list [.s coords -10] [.s coords 40] [.s coords 1000]
-} {{16 47} {56 47} {116 47}}
-test scale-10.2 {ValueToPixel procedure} {fonts} {
-    catch {destroy .s}
+} -cleanup {
+    deleteWindows
+} -result {{16 47} {56 47} {116 47}}
+test scale-10.2 {ValueToPixel procedure} -constraints {
+    fonts
+} -setup {
+    deleteWindows
+} -body {
     scale .s -from 100 -to 0 -sliderlength 20 -length 122 -bd 1 \
-	    -orient vertical -label Test -tick 20
+        -orient vertical -label Test -tick 20
     pack .s
     update
     list [.s coords -10] [.s coords 40] [.s coords 1000]
-} {{62 114} {62 74} {62 14}}
+} -cleanup {
+    deleteWindows
+} -result {{62 114} {62 74} {62 14}}
+
 
-test scale-11.1 {ScaleEventProc procedure} {
+test scale-11.1 {ScaleEventProc procedure} -setup {
+    deleteWindows
+} -body {
     proc killScale value {
-	global x
-	if {$value > 30} {
-	    destroy .s1
-	    lappend x [winfo exists .s1] [info commands .s1]
-	}
+        global x
+        if {$value > 30} {
+            destroy .s1
+            lappend x [winfo exists .s1] [info commands .s1]
+        }
     }
-    catch {destroy .s1}
     set x initial
     scale .s1 -from 0 -to 100 -command killScale
     .s1 set 20
@@ -608,60 +1018,74 @@ test scale-11.1 {ScaleEventProc procedure} {
     lappend x [winfo exists .s1]
     .s1 set 40
     update idletasks
+    return $x
+} -cleanup {
     rename killScale {}
-    set x
-} {initial 1 0 {}}
-test scale-11.2 {ScaleEventProc procedure} {
     deleteWindows
+} -result {initial 1 0 {}}
+test scale-11.2 {ScaleEventProc procedure} -setup {
+    deleteWindows
+    set x {}
+} -body {
     scale .s1 -bg #543210
     rename .s1 .s2
-    set x {}
     lappend x [winfo children .]
     lappend x [.s2 cget -bg]
     destroy .s1
     lappend x [info command .s*] [winfo children .]
-} {.s1 #543210 {} {}}
+} -cleanup {
+    deleteWindows
+} -result {.s1 #543210 {} {}}
 
-test scale-12.1 {ScaleCmdDeletedProc procedure} {
+test scale-12.1 {ScaleCmdDeletedProc procedure} -setup {
     deleteWindows
+} -body {
     scale .s1
     rename .s1 {}
     list [info command .s*] [winfo children .]
-} {{} {}}
+} -cleanup {
+    deleteWindows
+} -result {{} {}}
 
-catch {destroy .s}
-scale .s -from 0 -to 100 -command {set x} -variable y
-pack .s
+
+# Widget used in 13.* tests
+destroy .s
+pack [scale .s]
 update
-proc varTrace args {
-    global traceInfo
-    set traceInfo $args
-}
-test scale-13.1 {SetScaleValue procedure} {
+test scale-13.1 {SetScaleValue procedure} -body {
+    .s configure -from 0 -to 100 -command {set x} -variable y
+    update
     set x xyzzy
     .s set 44
     set result [list $x $y]
     update
     lappend result $x $y
-} {xyzzy 44 44 44}
-test scale-13.2 {SetScaleValue procedure} {
+} -result {xyzzy 44 44 44}
+test scale-13.2 {SetScaleValue procedure} -body {
     .s set -3
     .s get
-} 0
-test scale-13.3 {SetScaleValue procedure} {
+} -result 0
+test scale-13.3 {SetScaleValue procedure} -body {
     .s set 105
     .s get
-} 100
+} -result 100
 .s configure -from 100 -to 0
-test scale-13.4 {SetScaleValue procedure} {
+test scale-13.4 {SetScaleValue procedure} -body {
     .s set -3
     .s get
-} 0
-test scale-13.5 {SetScaleValue procedure} {
+} -result 0
+test scale-13.5 {SetScaleValue procedure} -body {
     .s set 105
     .s get
-} 100
-test scale-13.6 {SetScaleValue procedure} {
+} -result 100
+test scale-13.6 {SetScaleValue procedure} -body {
+    proc varTrace args {
+        global traceInfo
+        set traceInfo $args
+    }
+    .s configure -from 0 -to 100 -command {set x} -variable y
+    update
+
     .s set 50
     update
     trace variable y w varTrace
@@ -670,127 +1094,201 @@ test scale-13.6 {SetScaleValue procedure} {
     .s set 50
     update
     list $x $traceInfo
-} {untouched empty}
+} -result {untouched empty}
 
-catch {destroy .s}
-scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -orient horizontal
-pack .s
-update
-.s configure -resolution 4.0
+
+# Widget used in 14.* tests
+destroy .s
+pack [scale .s]
 update
-test scale-14.1 {RoundToResolution procedure} {
+test scale-14.1 {RoundToResolution procedure} -body {
+    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal -resolution 4.0
+    update
     .s get 84 152
-} 72
-test scale-14.2 {RoundToResolution procedure} {
+} -result 72
+test scale-14.2 {RoundToResolution procedure} -body {
+    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal -resolution 4.0
+    update
     .s get 86 152
-} 76
-.s configure -from 100 -to 0
-update
-test scale-14.3 {RoundToResolution procedure} {
+} -result 76
+
+test scale-14.3 {RoundToResolution procedure} -body {
+    .s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal -resolution 4.0
+    update
     .s get 84 152
-} 28
-test scale-14.4 {RoundToResolution procedure} {
+} -result 28
+test scale-14.4 {RoundToResolution procedure} -body {
+    .s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal -resolution 4.0
+    update
     .s get 86 152
-} 24
-.s configure -from -100 -to 0
-update
-test scale-14.5 {RoundToResolution procedure} {
+} -result 24
+
+test scale-14.5 {RoundToResolution procedure} -body {
+    .s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal -resolution 4.0
+    update
     .s get 84 152
-} -28
-test scale-14.6 {RoundToResolution procedure} {
+} -result {-28}
+test scale-14.6 {RoundToResolution procedure} -body {
+    .s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal -resolution 4.0
+    update
     .s get 86 152
-} -24
-.s configure -from 0 -to -100
-update
-test scale-14.7 {RoundToResolution procedure} {
+} -result {-24}
+
+test scale-14.7 {RoundToResolution procedure} -body {
+    .s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal -resolution 4.0
+    update
     .s get 84 152
-} -72
-test scale-14.8 {RoundToResolution procedure} {
+} -result {-72}
+test scale-14.8 {RoundToResolution procedure} -body {
+    .s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal -resolution 4.0
+    update
     .s get 86 152
-} -76
-.s configure -from 0 -to 2.25 -resolution 0
-update
-test scale-14.9 {RoundToResolution procedure} {
+} -result {-76}
+
+test scale-14.9 {RoundToResolution procedure} -body {
+    .s configure -from 0 -to 2.25  -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal -resolution 0
+    update
     .s get 84 152
-} 1.64
-test scale-14.10 {RoundToResolution procedure} {
+} -result {1.64}
+test scale-14.10 {RoundToResolution procedure} -body {
+    .s configure -from 0 -to 2.25  -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal -resolution 0
+    update
     .s get 86 152
-} 1.69
-.s configure -from 0 -to 225 -resolution 0  -digits 5
-update
-test scale-14.11 {RoundToResolution procedure} {
+} -result {1.69}
+
+test scale-14.11 {RoundToResolution procedure} -body {
+    .s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal -resolution 0 -digits 5
+    update
     .s get 84 152
-} 164.25
-test scale-14.12 {RoundToResolution procedure} {
+} -result {164.25}
+test scale-14.12 {RoundToResolution procedure} -body {
+    .s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \
+        -orient horizontal -resolution 0 -digits 5
+    update
     .s get 86 152
-} 168.75
+} -result {168.75}
+destroy .s
 
-test scale-15.1 {ScaleVarProc procedure} {
-    catch {destroy .s}
+
+test scale-15.1 {ScaleVarProc procedure} -setup {
+    deleteWindows
+} -body {
     set y -130
     scale .s -from 0 -to -200 -variable y -orient horizontal -length 150
     pack .s
-    set y
-} -130
-test scale-15.2 {ScaleVarProc procedure} {
-    catch {destroy .s}
+    return $y
+} -result {-130}
+test scale-15.2 {ScaleVarProc procedure} -setup {
+    deleteWindows
+} -body {
     set y -130
     scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
     pack .s
     set y -87
     .s get
-} -87
-test scale-15.3 {ScaleVarProc procedure} {
-    catch {destroy .s}
+} -result {-87}
+test scale-15.3 {ScaleVarProc procedure} -setup {
+    deleteWindows
+} -body {
     set y -130
     scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
     pack .s
-    list [catch {set y 40q} msg] $msg [.s get]
-} {1 {can't set "y": can't assign non-numeric value to scale variable} -130}
-test scale-15.4 {ScaleVarProc procedure} {
-    catch {destroy .s}
+    set y 40q
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't set "y": can't assign non-numeric value to scale variable}
+test scale-15.4 {ScaleVarProc procedure} -setup {
+    deleteWindows
+} -body {
+    set y -130
+    scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
+    pack .s
+    catch {set y 40q}
+    .s get
+} -cleanup {
+    deleteWindows
+} -result {-130}
+test scale-15.5 {ScaleVarProc procedure} -setup {
+    deleteWindows
+} -body {
+    set y 1
+    scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
+    pack .s
+    set y x
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't set "y": can't assign non-numeric value to scale variable}
+test scale-15.6 {ScaleVarProc procedure} -setup {
+    deleteWindows
+} -body {
     set y 1
     scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
     pack .s
-    list [catch {set y x} msg] $msg [.s get]
-} {1 {can't set "y": can't assign non-numeric value to scale variable} 1}
-test scale-15.5 {ScaleVarProc procedure, variable deleted} {
-    catch {destroy .s}
+    catch {set y x}
+    .s get
+} -cleanup {
+    deleteWindows
+} -result 1
+test scale-15.7 {ScaleVarProc procedure, variable deleted} -setup {
+    deleteWindows
+} -body {
     set y 6
     scale .s -from 10 -to 0 -variable y -orient horizontal -length 150 \
-	    -command "set x"
+        -command "set x"
     pack .s
     update
     set x untouched
     unset y
     update
     list [catch {set y} msg] $msg [.s get] $x
-} {0 6 6 untouched}
-test scale-15.6 {ScaleVarProc procedure, don't call -command} {
-    catch {destroy .s}
+} -cleanup {
+    deleteWindows
+} -result {0 6 6 untouched}
+test scale-15.8 {ScaleVarProc procedure, don't call -command} -setup {
+    deleteWindows
+} -body {
     set y 6
     scale .s -from 0 -to 100 -variable y -orient horizontal -length 150 \
-	    -command "set x"
+        -command "set x"
     pack .s
     update
     set x untouched
     set y 60
     update
     list $x [.s get]
-} {untouched 60}
+} -cleanup {
+    deleteWindows
+} -result {untouched 60}
 
-set l [interp hidden]
-deleteWindows
 
-test scale-16.1 {scale widget vs hidden commands} {
-    catch {destroy .s}
+test scale-16.1 {scale widget vs hidden commands} -body {
+    set l [interp hidden]
+    deleteWindows
     scale .s
     interp hide {} .s
     destroy .s
-    list [winfo children .] [interp hidden]
-} [list {} $l]
+    set res1 [list [winfo children .] [interp hidden]]
+    set res2 [list {} $l]
+    expr {$res1 eq $res2}
+} -cleanup {
+    deleteWindows
+} -result 1
+
 
-test scale-17.1 {bug fix 1786} {
+test scale-17.1 {bug fix 1786} -setup {
+    deleteWindows
+} -body {
     # Perhaps x is set to {}, depending on what other tests have run.
     # If x is unset, or set to something not convertable to a double,
     # then the scale try to initialize its value with the contents
@@ -805,68 +1303,64 @@ test scale-17.1 {bug fix 1786} {
     # Bug 4833 changed the result to realize that x should pick up
     # a value from the scale.  In an FPE occurs, it is due to the
     # lack of errno being set to 0 by some libc's. (see bug 4942)
-    set x
-} {100}
+    return $x
+} -cleanup {
+    deleteWindows
+} -result {100}
+
 
-test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} {
-    catch {destroy .s}
+test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} -setup {
+    deleteWindows
+} -body {
     scale .s -cursor trek
     destroy .s
-} {}
-
-test scale-18.2 {Scale button 1 events [Bug 787065]} \
-    -setup {
-        catch {destroy .s}
-        set y 5
-        scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
-        pack .s
-        tkwait visibility .s
-        set ::error {}
-        proc bgerror {args} {set ::error $args}
-    } \
-    -body {
-        list [catch {
-            event generate .s <1> -x 0 -y 0
-            event generate .s <ButtonRelease-1> -x 0 -y 0
-            update
-            set ::error
-        } msg] $msg
-    } \
-    -cleanup {
-        unset ::error
-        rename bgerror {}
-        catch {destroy .s}
-    } \
-    -result {0 {}}
-
-test scale-18.3 {Scale button 2 events [Bug 787065]} \
-    -setup {
-        catch {destroy .s}
-        set y 5
-        scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
-        pack .s
-        tkwait visibility .s
-        set ::error {}
-        proc bgerror {args} {set ::error $args}
-    } \
-    -body {
-        list [catch {
-            event generate .s <2> -x 0 -y 0
-            event generate .s <ButtonRelease-2> -x 0 -y 0
-            update
-            set ::error
-        } msg] $msg
-    } \
-    -cleanup {
-        unset ::error
-        rename bgerror {}
-        catch {destroy .s}
-    } \
-    -result {0 {}}
-
-catch {destroy .s}
+} -result {}
+
+test scale-18.2 {Scale button 1 events [Bug 787065]} -setup {
+    destroy .s
+    set ::error {}
+    proc bgerror {args} {set ::error $args}
+} -body {
+    set y 5
+    scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
+    pack .s
+    tkwait visibility .s
+    list [catch {
+        event generate .s <1> -x 0 -y 0
+        event generate .s <ButtonRelease-1> -x 0 -y 0
+        update
+        set ::error
+    } msg] $msg
+} -cleanup {
+    unset ::error
+    rename bgerror {}
+    destroy .s
+} -result {0 {}}
+
+test scale-18.3 {Scale button 2 events [Bug 787065]} -setup {
+    destroy .s
+    set ::error {}
+    proc bgerror {args} {set ::error $args}
+} -body {
+    set y 5
+    scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
+    pack .s
+    tkwait visibility .s
+    list [catch {
+        event generate .s <2> -x 0 -y 0
+        event generate .s <ButtonRelease-2> -x 0 -y 0
+        update
+        set ::error
+    } msg] $msg
+} -cleanup {
+    unset ::error
+    rename bgerror {}
+    destroy .s
+} -result {0 {}}
+
+
 option clear
 
 # cleanup
 cleanupTests
-return
+return
\ No newline at end of file
diff --git a/tests/select.test b/tests/select.test
index 6c29e9f..9ae67ce 100644
--- a/tests/select.test
+++ b/tests/select.test
@@ -6,19 +6,19 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: select.test,v 1.17 2008/07/23 23:24:25 nijtmans Exp $
+# RCS: @(#) $Id: select.test,v 1.18 2008/08/28 08:52:05 aniap Exp $
 
 #
 # Note: Multiple display selection handling will only be tested if the
 # environment variable TK_ALT_DISPLAY is set to an alternate display.
 #
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
+namespace import ::tk::test:loadTkCommand
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
-namespace import -force ::tk::test:loadTkCommand
-
 global longValue selValue selInfo
 
 set selValue {}
@@ -95,10 +95,10 @@ after 1500
 proc setup {{path .f1} {display {}}} {
     catch {destroy $path}
     if {$display == {}} {
-	frame $path
+	    frame $path
     } else {
-	toplevel $path -screen $display
-	wm geom $path +0+0
+	    toplevel $path -screen $display
+	    wm geom $path +0+0
     }
     selection own $path
 }
@@ -112,36 +112,36 @@ foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} {
 
 # Now we start the main body of the test code
 
-test select-1.1 {Tk_CreateSelHandler procedure} {
+test select-1.1 {Tk_CreateSelHandler procedure} -body {
     setup
     lsort [selection get TARGETS]
-} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}
-test select-1.2 {Tk_CreateSelHandler procedure} {
+} -result {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}
+test select-1.2 {Tk_CreateSelHandler procedure} -body {
     setup
     selection handle .f1 {handler TEST} TEST
     lsort [selection get TARGETS]
-} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}
-test select-1.3 {Tk_CreateSelHandler procedure} {
+} -result {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}
+test select-1.3 {Tk_CreateSelHandler procedure} -body {
     global selValue selInfo
     setup
     selection handle .f1 {handler TEST} TEST
     set selValue "Test value"
     set selInfo ""
     list [selection get TEST] $selInfo
-} {{Test value} {TEST 0 4000}}
-test select-1.4.1 {Tk_CreateSelHandler procedure} unix {
+} -result {{Test value} {TEST 0 4000}}
+test select-1.4.1 {Tk_CreateSelHandler procedure} -constraints unix -body {
     setup
     selection handle .f1 {handler TEST} TEST
     selection handle .f1 {handler STRING}
     lsort [selection get TARGETS]
-} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}
-test select-1.4.2 {Tk_CreateSelHandler procedure} win {
+} -result {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}
+test select-1.4.2 {Tk_CreateSelHandler procedure} -constraints win -body {
     setup
     selection handle .f1 {handler TEST} TEST
     selection handle .f1 {handler STRING}
     lsort [selection get TARGETS]
-} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}
-test select-1.5 {Tk_CreateSelHandler procedure} {
+} -result {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}
+test select-1.5 {Tk_CreateSelHandler procedure} -body {
     global selValue selInfo
     setup
     selection handle .f1 {handler TEST} TEST
@@ -149,8 +149,8 @@ test select-1.5 {Tk_CreateSelHandler procedure} {
     set selValue ""
     set selInfo ""
     list [selection get] $selInfo
-} {{} {STRING 0 4000}}
-test select-1.6.1 {Tk_CreateSelHandler procedure} unix {
+} -result {{} {STRING 0 4000}}
+test select-1.6.1 {Tk_CreateSelHandler procedure} -constraints unix -body {
     global selValue selInfo
     setup
     selection handle .f1 {handler TEST} TEST
@@ -162,8 +162,8 @@ test select-1.6.1 {Tk_CreateSelHandler procedure} unix {
     selection handle .f1 {handler TEST2} TEST
     selection get -type TEST
     list [set selInfo] [lsort [selection get TARGETS]]
-} {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}}
-test select-1.6.2 {Tk_CreateSelHandler procedure} win {
+} -result {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}}
+test select-1.6.2 {Tk_CreateSelHandler procedure} -constraints win -body {
     global selValue selInfo
     setup
     selection handle .f1 {handler TEST} TEST
@@ -175,32 +175,32 @@ test select-1.6.2 {Tk_CreateSelHandler procedure} win {
     selection handle .f1 {handler TEST2} TEST
     selection get -type TEST
     list [set selInfo] [lsort [selection get TARGETS]]
-} {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
-test select-1.7.1 {Tk_CreateSelHandler procedure} unix {
+} -result {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-1.7.1 {Tk_CreateSelHandler procedure} -constraints unix -body {
     setup
     selection own -selection CLIPBOARD .f1
     selection handle -selection CLIPBOARD .f1 {handler TEST} TEST
     selection handle -selection PRIMARY .f1 {handler TEST2} STRING
     list [lsort [selection get -selection PRIMARY TARGETS]] \
 	[lsort [selection get -selection CLIPBOARD TARGETS]]
-} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
-test select-1.7.2 {Tk_CreateSelHandler procedure} win {
+} -result {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-1.7.2 {Tk_CreateSelHandler procedure} -constraints win -body {
     setup
     selection own -selection CLIPBOARD .f1
     selection handle -selection CLIPBOARD .f1 {handler TEST} TEST
     selection handle -selection PRIMARY .f1 {handler TEST2} STRING
     list [lsort [selection get -selection PRIMARY TARGETS]] \
 	[lsort [selection get -selection CLIPBOARD TARGETS]]
-} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
-test select-1.8 {Tk_CreateSelHandler procedure} {
+} -result {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-1.8 {Tk_CreateSelHandler procedure} -body {
     setup
     selection handle -format INTEGER -type TEST .f1 {handler TEST}
     lsort [selection get TARGETS]
-} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}
+} -result {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}
 
 ##############################################################################
 
-test select-2.1 {Tk_DeleteSelHandler procedure} unix {
+test select-2.1 {Tk_DeleteSelHandler procedure} -constraints unix -body {
     setup
     selection handle .f1 {handler STRING}
     selection handle -type TEST .f1 {handler TEST}
@@ -208,8 +208,8 @@ test select-2.1 {Tk_DeleteSelHandler procedure} unix {
     set result [list [lsort [selection get TARGETS]]]
     selection handle -type TEST .f1 {}
     lappend result [lsort [selection get TARGETS]]
-} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING}}
-test select-2.2 {Tk_DeleteSelHandler procedure} unix {
+} -result {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING}}
+test select-2.2 {Tk_DeleteSelHandler procedure} -constraints unix -body {
     setup
     selection handle .f1 {handler STRING}
     selection handle -type TEST .f1 {handler TEST}
@@ -217,8 +217,8 @@ test select-2.2 {Tk_DeleteSelHandler procedure} unix {
     set result [list [lsort [selection get TARGETS]]]
     selection handle -type USER .f1 {}
     lappend result [lsort [selection get TARGETS]]
-} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}}
-test select-2.3 {Tk_DeleteSelHandler procedure} unix {
+} -result {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}}
+test select-2.3 {Tk_DeleteSelHandler procedure} -constraints unix -body {
     setup
     selection own -selection CLIPBOARD .f1
     selection handle -selection PRIMARY .f1 {handler STRING}
@@ -226,8 +226,8 @@ test select-2.3 {Tk_DeleteSelHandler procedure} unix {
     selection handle -selection CLIPBOARD .f1 {}
     list [lsort [selection get TARGETS]] \
 	[lsort [selection get -selection CLIPBOARD TARGETS]]
-} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
-test select-2.4 {Tk_DeleteSelHandler procedure} win {
+} -result {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-2.4 {Tk_DeleteSelHandler procedure} -constraints win -body {
     setup
     selection handle .f1 {handler STRING}
     selection handle -type TEST .f1 {handler TEST}
@@ -235,8 +235,8 @@ test select-2.4 {Tk_DeleteSelHandler procedure} win {
     set result [list [lsort [selection get TARGETS]]]
     selection handle -type TEST .f1 {}
     lappend result [lsort [selection get TARGETS]]
-} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}}
-test select-2.5 {Tk_DeleteSelHandler procedure} win {
+} -result {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}}
+test select-2.5 {Tk_DeleteSelHandler procedure} -constraints win -body {
     setup
     selection handle .f1 {handler STRING}
     selection handle -type TEST .f1 {handler TEST}
@@ -244,8 +244,8 @@ test select-2.5 {Tk_DeleteSelHandler procedure} win {
     set result [list [lsort [selection get TARGETS]]]
     selection handle -type USER .f1 {}
     lappend result [lsort [selection get TARGETS]]
-} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
-test select-2.6 {Tk_DeleteSelHandler procedure} win {
+} -result {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-2.6 {Tk_DeleteSelHandler procedure} -constraints win -body {
     setup
     selection own -selection CLIPBOARD .f1
     selection handle -selection PRIMARY .f1 {handler STRING}
@@ -253,40 +253,40 @@ test select-2.6 {Tk_DeleteSelHandler procedure} win {
     selection handle -selection CLIPBOARD .f1 {}
     list [lsort [selection get TARGETS]] \
 	[lsort [selection get -selection CLIPBOARD TARGETS]]
-} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
-test select-2.7 {Tk_DeleteSelHandler procedure} {
+} -result {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-2.7 {Tk_DeleteSelHandler procedure} -body {
     setup
     selection handle .f1 {handler STRING}
     list [selection handle .f1 {}] [selection handle .f1 {}]
-} {{} {}}
+} -result {{} {}}
 
 ##############################################################################
 
-test select-3.1 {Tk_OwnSelection procedure} {
+test select-3.1 {Tk_OwnSelection procedure} -body {
     setup
     selection own
-} {.f1}
-test select-3.2 {Tk_OwnSelection procedure} {
+} -result {.f1}
+test select-3.2 {Tk_OwnSelection procedure} -body {
     setup .f1
     set result [selection own]
     setup .f2
     lappend result [selection own]
-} {.f1 .f2}
-test select-3.3 {Tk_OwnSelection procedure} {
+} -result {.f1 .f2}
+test select-3.3 {Tk_OwnSelection procedure} -body {
     setup .f1
     setup .f2
     selection own -selection CLIPBOARD .f1
     list [selection own] [selection own -selection CLIPBOARD]
-} {.f2 .f1}
-test select-3.4 {Tk_OwnSelection procedure} {
+} -result {.f2 .f1}
+test select-3.4 {Tk_OwnSelection procedure} -body {
     global lostSel
     setup
     set lostSel {owned}
     selection own -command { set lostSel {lost} } .f1
     selection clear .f1
     set lostSel
-} {lost}
-test select-3.5 {Tk_OwnSelection procedure} {
+} -result {lost}
+test select-3.5 {Tk_OwnSelection procedure} -body {
     global lostSel
     setup .f1
     setup .f2
@@ -294,8 +294,8 @@ test select-3.5 {Tk_OwnSelection procedure} {
     selection own -command { set lostSel {lost1} } .f1
     selection own -command { set lostSel {lost2} } .f2
     list $lostSel [selection own]
-} {lost1 .f2}
-test select-3.6 {Tk_OwnSelection procedure} {
+} -result {lost1 .f2}
+test select-3.6 {Tk_OwnSelection procedure} -body {
     global lostSel
     setup
     set lostSel {owned}
@@ -304,8 +304,8 @@ test select-3.6 {Tk_OwnSelection procedure} {
     set result $lostSel
     selection clear .f1
     lappend result $lostSel
-} {owned lost2}
-test select-3.7 {Tk_OwnSelection procedure} unix {
+} -result {owned lost2}
+test select-3.7 {Tk_OwnSelection procedure} -constraints unix -body {
     global lostSel
     setup
     setupbg
@@ -318,26 +318,30 @@ test select-3.7 {Tk_OwnSelection procedure} unix {
     update
     cleanupbg
     lappend result $lostSel
-} {{} . lost1}
+} -result {{} . lost1}
 # check reentrancy on selection replacement
-test select-3.8 {Tk_OwnSelection procedure} {
+test select-3.8 {Tk_OwnSelection procedure} -body {
     setup
     selection own -selection CLIPBOARD -command { destroy .f1 } .f1
     selection own -selection CLIPBOARD .
-} {}
-test select-3.9 {Tk_OwnSelection procedure} {
+} -result {}
+test select-3.9 {Tk_OwnSelection procedure} -body {
     setup .f2
     setup .f1
     selection own -selection CLIPBOARD -command { destroy .f2 } .f1
     selection own -selection CLIPBOARD .f2
-} {}
+} -result {}
 # multiple display tests
-test select-3.10 {Tk_OwnSelection procedure} {altDisplay} {
+test select-3.10 {Tk_OwnSelection procedure} -constraints {
+	altDisplay
+} -body {
     setup .f1
     setup .f2 $env(TK_ALT_DISPLAY)
     list [selection own -displayof .f1] [selection own -displayof .f2]
-} {.f1 .f2}
-test select-3.11 {Tk_OwnSelection procedure} {altDisplay} {
+} -result {.f1 .f2}
+test select-3.11 {Tk_OwnSelection procedure} -constraints {
+	altDisplay
+} -body {
     setup .f1
     setup .f2 $env(TK_ALT_DISPLAY)
     setupbg
@@ -348,27 +352,27 @@ test select-3.11 {Tk_OwnSelection procedure} {altDisplay} {
 	    [selection own -displayof .f2]
     cleanupbg
     set result
-} {{} .f1 {}}
+} -result {{} .f1 {}}
 
 ##############################################################################
 
-test select-4.1 {Tk_ClearSelection procedure} {
+test select-4.1 {Tk_ClearSelection procedure} -body {
     setup
     set result [selection own]
     selection clear .f1
     lappend result [selection own]
-} {.f1 {}}
-test select-4.2 {Tk_ClearSelection procedure} {
+} -result {.f1 {}}
+test select-4.2 {Tk_ClearSelection procedure} -body {
     setup
     selection own -selection CLIPBOARD .f1
     selection clear .f1
     selection own -selection CLIPBOARD
-} {.f1}
-test select-4.3 {Tk_ClearSelection procedure} {
+} -result {.f1}
+test select-4.3 {Tk_ClearSelection procedure} -body {
     setup
     list [selection clear .f1] [selection clear .f1]
-} {{} {}}
-test select-4.4 {Tk_ClearSelection procedure} unix {
+} -result {{} {}}
+test select-4.4 {Tk_ClearSelection procedure} -constraints unix -body {
     global lostSel
     setup
     setupbg
@@ -380,9 +384,11 @@ test select-4.4 {Tk_ClearSelection procedure} unix {
     update
     cleanupbg
     lappend result [selection own]
-} {{} {}}
+} -result {{} {}}
 # multiple display tests
-test select-4.5 {Tk_ClearSelection procedure} {altDisplay} {
+test select-4.5 {Tk_ClearSelection procedure} -constraints {
+	altDisplay
+} -body {
     global lostSel lostSel2
     setup .f1
     setup .f2 $env(TK_ALT_DISPLAY)
@@ -394,8 +400,10 @@ test select-4.5 {Tk_ClearSelection procedure} {altDisplay} {
     selection clear -displayof .f2
     update
     list $lostSel $lostSel2
-} {owned lost2}
-test select-4.6 {Tk_ClearSelection procedure} {unix altDisplay} {
+} -result {owned lost2}
+test select-4.6 {Tk_ClearSelection procedure} -constraints {
+	unix altDisplay
+} -body {
     setup .f1
     setup .f2 $env(TK_ALT_DISPLAY)
     setupbg
@@ -410,71 +418,71 @@ test select-4.6 {Tk_ClearSelection procedure} {unix altDisplay} {
 	    [selection own -displayof .f2] $lostSel $lostSel2
     cleanupbg
     set result
-} {{} .f1 {} owned lost2}
+} -result {{} .f1 {} owned lost2}
 
 ##############################################################################
 
-test select-5.1 {Tk_GetSelection procedure} {
+test select-5.1 {Tk_GetSelection procedure} -body {
     setup
-    list [catch {selection get TEST} msg] $msg
-} {1 {PRIMARY selection doesn't exist or form "TEST" not defined}}
-test select-5.2 {Tk_GetSelection procedure} {
+    selection get TEST
+} -returnCodes error -result {PRIMARY selection doesn't exist or form "TEST" not defined}
+test select-5.2 {Tk_GetSelection procedure} -body {
     setup
     selection get TK_WINDOW
-} {.f1}
-test select-5.3 {Tk_GetSelection procedure} {
+} -result {.f1}
+test select-5.3 {Tk_GetSelection procedure} -body {
     setup
     selection handle -selection PRIMARY .f1 {handler TEST} TEST
     set selValue "Test value"
     set selInfo ""
     list [selection get TEST] $selInfo
-} {{Test value} {TEST 0 4000}}
-test select-5.4 {Tk_GetSelection procedure} {
+} -result {{Test value} {TEST 0 4000}}
+test select-5.4 {Tk_GetSelection procedure} -body {
     setup
     selection handle .f1 ERROR errHandler
-    list [catch {selection get ERROR} msg] $msg
-} {1 {PRIMARY selection doesn't exist or form "ERROR" not defined}}
-test select-5.5 {Tk_GetSelection procedure} {
+    selection get ERROR
+} -returnCodes error -result {PRIMARY selection doesn't exist or form "ERROR" not defined}
+test select-5.5 {Tk_GetSelection procedure} -body {
     setup
     set selValue $longValue
     set selInfo ""
     selection handle .f1 {handler STRING}
     list [selection get] $selInfo
-} "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000}"
-test select-5.6 {Tk_GetSelection procedure} {
+} -result "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000}"
+test select-5.6 {Tk_GetSelection procedure} -body {
     proc weirdHandler {type offset count} {
 	selection handle .f1 {}
-	handler $type $offset $count
+	    handler $type $offset $count
     }
     setup
     set selValue $longValue
     set selInfo ""
     selection handle .f1 {weirdHandler STRING}
-    list [catch {selection get} msg] $msg
-} {1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
-test select-5.7 {Tk_GetSelection procedure} {
+    selection get
+} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined}
+test select-5.7 {Tk_GetSelection procedure} -body {
     proc weirdHandler {type offset count} {
 	destroy .f1
-	handler $type $offset $count
+	    handler $type $offset $count
     }
     setup
     set selValue "Test Value"
     set selInfo ""
     selection handle .f1 {weirdHandler STRING}
-    list [catch {selection get} msg] $msg
-} {1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
-test select-5.8 {Tk_GetSelection procedure} {
+    selection get
+} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined}
+test select-5.8 {Tk_GetSelection procedure} -body {
     proc weirdHandler {type offset count} {
 	selection clear
-	handler $type $offset $count
+	    handler $type $offset $count
     }
     setup
     set selValue $longValue
     set selInfo ""
     selection handle .f1 {weirdHandler STRING}
     list [selection get] $selInfo [catch {selection get} msg] $msg
-} "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection doesn't exist or form \"STRING\" not defined}"
-test select-5.9 {Tk_GetSelection procedure} unix {
+} -result "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection doesn't exist or form \"STRING\" not defined}"
+test select-5.9 {Tk_GetSelection procedure} -constraints unix -body {
     setup
     setupbg
     selection handle -selection PRIMARY .f1 {handler TEST} TEST
@@ -485,8 +493,8 @@ test select-5.9 {Tk_GetSelection procedure} unix {
     lappend result [dobg {selection get TEST}]
     cleanupbg
     lappend result $selInfo
-} {{Test value} {TEST 0 4000}}
-test select-5.10 {Tk_GetSelection procedure} unix {
+} -result {{Test value} {TEST 0 4000}}
+test select-5.10 {Tk_GetSelection procedure} -constraints unix -body {
     setup
     setupbg
     selection handle -selection PRIMARY .f1 {handler TEST} TEST
@@ -498,9 +506,11 @@ test select-5.10 {Tk_GetSelection procedure} unix {
     lappend result [dobg {selection get TEST} 1]
     cleanupbg
     lappend result $selInfo
-} {{selection owner didn't respond} {}}
+} -result {{selection owner didn't respond} {}}
 # multiple display tests
-test select-5.11 {Tk_GetSelection procedure} {altDisplay} {
+test select-5.11 {Tk_GetSelection procedure} -constraints {
+	altDisplay
+} -body {
     setup .f1
     setup .f2 $env(TK_ALT_DISPLAY)
     selection handle -selection PRIMARY .f1 {handler TEST} TEST
@@ -511,8 +521,10 @@ test select-5.11 {Tk_GetSelection procedure} {altDisplay} {
     set selValue "Test value2"
     set selInfo ""
     lappend result [selection get -displayof .f2 TEST] $selInfo
-} {{Test value} {TEST 0 4000} {Test value2} {TEST2 0 4000}}
-test select-5.12 {Tk_GetSelection procedure} {altDisplay} {
+} -result {{Test value} {TEST 0 4000} {Test value2} {TEST2 0 4000}}
+test select-5.12 {Tk_GetSelection procedure} -constraints {
+	altDisplay
+} -body {
     global lostSel lostSel2
     setup .f1
     setup .f2 $env(TK_ALT_DISPLAY)
@@ -525,8 +537,10 @@ test select-5.12 {Tk_GetSelection procedure} {altDisplay} {
     set selInfo ""
     lappend result [catch {selection get -displayof .f2 TEST} msg] $msg \
 	    $selInfo
-} {0 {Test value} {TEST 0 4000} 1 {PRIMARY selection doesn't exist or form "TEST" not defined} {}}
-test select-5.13 {Tk_GetSelection procedure} {unix altDisplay} {
+} -result {0 {Test value} {TEST 0 4000} 1 {PRIMARY selection doesn't exist or form "TEST" not defined} {}}
+test select-5.13 {Tk_GetSelection procedure} -constraints {
+	unix altDisplay
+} -body {
     setup .f1
     setup .f2 $env(TK_ALT_DISPLAY)
     setupbg
@@ -543,8 +557,10 @@ test select-5.13 {Tk_GetSelection procedure} {unix altDisplay} {
     lappend result [dobg "selection get TEST"]
     cleanupbg
     lappend result $selInfo
-} {{Test value} {Test value2} {TEST2 0 4000 TEST 0 4000}}
-test select-5.14 {Tk_GetSelection procedure} {unix altDisplay} {
+} -result {{Test value} {Test value2} {TEST2 0 4000 TEST 0 4000}}
+test select-5.14 {Tk_GetSelection procedure} -constraints {
+	unix altDisplay
+} -body {
     setup .f1
     setup .f2 $env(TK_ALT_DISPLAY)
     setupbg
@@ -561,81 +577,81 @@ test select-5.14 {Tk_GetSelection procedure} {unix altDisplay} {
     lappend result [dobg "selection get TEST"]
     cleanupbg
     lappend result $selInfo
-} {{PRIMARY selection doesn't exist or form "TEST" not defined} {Test value2} {TEST 0 4000}}
+} -result {{PRIMARY selection doesn't exist or form "TEST" not defined} {Test value2} {TEST 0 4000}}
 
 ##############################################################################
 
-test select-6.1 {Tk_SelectionCmd procedure} {
-    list [catch {selection} cmd] $cmd
-} {1 {wrong # args: should be "selection option ?arg ...?"}}
+test select-6.1 {Tk_SelectionCmd procedure} -body {
+    selection
+} -returnCodes error -result {wrong # args: should be "selection option ?arg ...?"}
 # selection clear
-test select-6.2 {Tk_SelectionCmd procedure} {
-    list [catch {selection clear -selection} cmd] $cmd
-} {1 {value for "-selection" missing}}
-test select-6.3 {Tk_SelectionCmd procedure} {
+test select-6.2 {Tk_SelectionCmd procedure} -body {
+    selection clear -selection
+} -returnCodes error -result {value for "-selection" missing}
+test select-6.3 {Tk_SelectionCmd procedure} -body {
     setup
     selection own .
     set result [selection own]
     selection clear -displayof .f1
     lappend result [selection own]
-} {. {}}
-test select-6.4 {Tk_SelectionCmd procedure} {
+} -result {. {}}
+test select-6.4 {Tk_SelectionCmd procedure} -body {
     setup
     selection own -selection CLIPBOARD .f1
     set result [list [selection own] [selection own -selection CLIPBOARD]]
     selection clear -selection CLIPBOARD .f1
     lappend result [selection own] [selection own -selection CLIPBOARD]
-} {.f1 .f1 .f1 {}}
-test select-6.5 {Tk_SelectionCmd procedure} {
+} -result {.f1 .f1 .f1 {}}
+test select-6.5 {Tk_SelectionCmd procedure} -body {
     setup
     selection own -selection CLIPBOARD .
     set result [list [selection own] [selection own -selection CLIPBOARD]]
     selection clear -selection CLIPBOARD -displayof .f1
     lappend result [selection own] [selection own -selection CLIPBOARD]
-} {.f1 . .f1 {}}
-test select-6.6 {Tk_SelectionCmd procedure} {
-    list [catch {selection clear -badopt foo} cmd] $cmd
-} {1 {bad option "-badopt": must be -displayof or -selection}}
-test select-6.7 {Tk_SelectionCmd procedure} {
-    list [catch {selection clear -selectionfoo foo} cmd] $cmd
-} {1 {bad option "-selectionfoo": must be -displayof or -selection}}
-test select-6.8 {Tk_SelectionCmd procedure} {
-    catch {destroy .f2}
-    list [catch {selection clear -displayof .f2} cmd] $cmd
-} {1 {bad window path name ".f2"}}
-test select-6.9 {Tk_SelectionCmd procedure} {
-    catch {destroy .f2}
-    list [catch {selection clear .f2} cmd] $cmd
-} {1 {bad window path name ".f2"}}
-test select-6.10 {Tk_SelectionCmd procedure} {
+} -result {.f1 . .f1 {}}
+test select-6.6 {Tk_SelectionCmd procedure} -body {
+    selection clear -badopt foo
+} -returnCodes error -result {bad option "-badopt": must be -displayof or -selection}
+test select-6.7 {Tk_SelectionCmd procedure} -body {
+    selection clear -selectionfoo foo
+} -returnCodes error -result {bad option "-selectionfoo": must be -displayof or -selection}
+test select-6.8 {Tk_SelectionCmd procedure} -body {
+    destroy .f2
+    selection clear -displayof .f2
+} -returnCodes error -result {bad window path name ".f2"}
+test select-6.9 {Tk_SelectionCmd procedure} -body {
+    destroy .f2
+    selection clear .f2
+} -returnCodes error -result {bad window path name ".f2"}
+test select-6.10 {Tk_SelectionCmd procedure} -body {
     setup
     set result [selection own -selection PRIMARY]
     selection clear
     lappend result [selection own -selection PRIMARY]
-} {.f1 {}}
-test select-6.11 {Tk_SelectionCmd procedure} {
+} -result {.f1 {}}
+test select-6.11 {Tk_SelectionCmd procedure} -body {
     setup
     selection own -selection CLIPBOARD .f1
     set result [selection own -selection CLIPBOARD]
     selection clear -selection CLIPBOARD
     lappend result [selection own -selection CLIPBOARD]
-} {.f1 {}}
-test select-6.12 {Tk_SelectionCmd procedure} {
-    list [catch {selection clear foo bar} cmd] $cmd
-} {1 {wrong # args: should be "selection clear ?-option value ...?"}}
+} -result {.f1 {}}
+test select-6.12 {Tk_SelectionCmd procedure} -body {
+    selection clear foo bar
+} -returnCodes error -result {wrong # args: should be "selection clear ?-option value ...?"}
 # selection get
-test select-6.13 {Tk_SelectionCmd procedure} {
-    list [catch {selection get -selection} cmd] $cmd
-} {1 {value for "-selection" missing}}
-test select-6.14 {Tk_SelectionCmd procedure} {
+test select-6.13 {Tk_SelectionCmd procedure} -body {
+    selection get -selection
+} -returnCodes error -result {value for "-selection" missing}
+test select-6.14 {Tk_SelectionCmd procedure} -body {
     global selValue selInfo
     setup
     selection handle .f1 {handler TEST}
     set selValue "Test value"
     set selInfo ""
     list [selection get -displayof .f1] $selInfo
-} {{Test value} {TEST 0 4000}}
-test select-6.15 {Tk_SelectionCmd procedure} {
+} -result {{Test value} {TEST 0 4000}}
+test select-6.15 {Tk_SelectionCmd procedure} -body {
     global selValue selInfo
     setup
     selection handle .f1 {handler STRING}
@@ -644,8 +660,8 @@ test select-6.15 {Tk_SelectionCmd procedure} {
     set selValue "Test value"
     set selInfo ""
     list [selection get -selection CLIPBOARD] $selInfo
-} {{Test value} {TEST 0 4000}}
-test select-6.16 {Tk_SelectionCmd procedure} {
+} -result {{Test value} {TEST 0 4000}}
+test select-6.16 {Tk_SelectionCmd procedure} -body {
     global selValue selInfo
     setup
     selection handle -type TEST .f1 {handler TEST}
@@ -653,21 +669,21 @@ test select-6.16 {Tk_SelectionCmd procedure} {
     set selValue "Test value"
     set selInfo ""
     list [selection get -type TEST] $selInfo
-} {{Test value} {TEST 0 4000}}
-test select-6.17 {Tk_SelectionCmd procedure} {
-    list [catch {selection get -badopt foo} cmd] $cmd
-} {1 {bad option "-badopt": must be -displayof, -selection, or -type}}
-test select-6.18 {Tk_SelectionCmd procedure} {
-    list [catch {selection get -selectionfoo foo} cmd] $cmd
-} {1 {bad option "-selectionfoo": must be -displayof, -selection, or -type}}
-test select-6.19 {Tk_SelectionCmd procedure} {
+} -result {{Test value} {TEST 0 4000}}
+test select-6.17 {Tk_SelectionCmd procedure} -body {
+    selection get -badopt foo
+} -returnCodes error -result {bad option "-badopt": must be -displayof, -selection, or -type}
+test select-6.18 {Tk_SelectionCmd procedure} -body {
+    selection get -selectionfoo foo
+} -returnCodes error -result {bad option "-selectionfoo": must be -displayof, -selection, or -type}
+test select-6.19 {Tk_SelectionCmd procedure} -body {
     catch { destroy .f2 }
-    list [catch {selection get -displayof .f2} cmd] $cmd
-} {1 {bad window path name ".f2"}}
-test select-6.20 {Tk_SelectionCmd procedure} {
-    list [catch {selection get foo bar} cmd] $cmd
-} {1 {wrong # args: should be "selection get ?-option value ...?"}}
-test select-6.21 {Tk_SelectionCmd procedure} {
+    selection get -displayof .f2
+} -returnCodes error -result {bad window path name ".f2"}
+test select-6.20 {Tk_SelectionCmd procedure} -body {
+    selection get foo bar
+} -returnCodes error -result {wrong # args: should be "selection get ?-option value ...?"}
+test select-6.21 {Tk_SelectionCmd procedure} -body {
     global selValue selInfo
     setup
     selection handle -type TEST .f1 {handler TEST}
@@ -675,54 +691,54 @@ test select-6.21 {Tk_SelectionCmd procedure} {
     set selValue "Test value"
     set selInfo ""
     list [selection get TEST] $selInfo
-} {{Test value} {TEST 0 4000}}
+} -result {{Test value} {TEST 0 4000}}
 # selection handle
 # most of the handle section has been covered earlier
-test select-6.22 {Tk_SelectionCmd procedure} {
-    list [catch {selection handle -selection} cmd] $cmd
-} {1 {value for "-selection" missing}}
-test select-6.23 {Tk_SelectionCmd procedure} {
+test select-6.22 {Tk_SelectionCmd procedure} -body {
+    selection handle -selection
+} -returnCodes error -result {value for "-selection" missing}
+test select-6.23 {Tk_SelectionCmd procedure} -body {
     global selValue selInfo
     setup
     set selValue "Test value"
     set selInfo ""
     list [selection handle -format INTEGER .f1 {handler TEST}] [selection get -displayof .f1] $selInfo
-} {{} {Test value} {TEST 0 4000}}
-test select-6.24 {Tk_SelectionCmd procedure} {
-    list [catch {selection handle -badopt foo} cmd] $cmd
-} {1 {bad option "-badopt": must be -format, -selection, or -type}}
-test select-6.25 {Tk_SelectionCmd procedure} {
-    list [catch {selection handle -selectionfoo foo} cmd] $cmd
-} {1 {bad option "-selectionfoo": must be -format, -selection, or -type}}
-test select-6.26 {Tk_SelectionCmd procedure} {
-    list [catch {selection handle} cmd] $cmd
-} {1 {wrong # args: should be "selection handle ?-option value ...? window command"}}
-test select-6.27 {Tk_SelectionCmd procedure} {
-    list [catch {selection handle .} cmd] $cmd
-} {1 {wrong # args: should be "selection handle ?-option value ...? window command"}}
-test select-6.28 {Tk_SelectionCmd procedure} {
-    list [catch {selection handle . foo bar baz blat} cmd] $cmd
-} {1 {wrong # args: should be "selection handle ?-option value ...? window command"}}
-test select-6.29 {Tk_SelectionCmd procedure} {
+} -result {{} {Test value} {TEST 0 4000}}
+test select-6.24 {Tk_SelectionCmd procedure} -body {
+    selection handle -badopt foo
+} -returnCodes error -result {bad option "-badopt": must be -format, -selection, or -type}
+test select-6.25 {Tk_SelectionCmd procedure} -body {
+    selection handle -selectionfoo foo
+} -returnCodes error -result {bad option "-selectionfoo": must be -format, -selection, or -type}
+test select-6.26 {Tk_SelectionCmd procedure} -body {
+    selection handle
+} -returnCodes error -result {wrong # args: should be "selection handle ?-option value ...? window command"}
+test select-6.27 {Tk_SelectionCmd procedure} -body {
+    selection handle .
+} -returnCodes error -result {wrong # args: should be "selection handle ?-option value ...? window command"}
+test select-6.28 {Tk_SelectionCmd procedure} -body {
+    selection handle . foo bar baz blat
+} -returnCodes error -result {wrong # args: should be "selection handle ?-option value ...? window command"}
+test select-6.29 {Tk_SelectionCmd procedure} -body {
     catch { destroy .f2 }
-    list [catch {selection handle .f2 dummy} cmd] $cmd
-} {1 {bad window path name ".f2"}}
+    selection handle .f2 dummy
+} -returnCodes error -result {bad window path name ".f2"}
 # selection own
-test select-6.30 {Tk_SelectionCmd procedure} {
-    list [catch {selection own -selection} cmd] $cmd
-} {1 {value for "-selection" missing}}
-test select-6.31 {Tk_SelectionCmd procedure} {
+test select-6.30 {Tk_SelectionCmd procedure} -body {
+    selection own -selection
+} -returnCodes error -result {value for "-selection" missing}
+test select-6.31 {Tk_SelectionCmd procedure} -body {
     setup
     selection own .
     selection own -displayof .f1
-} {.}
-test select-6.32 {Tk_SelectionCmd procedure} {
+} -result {.}
+test select-6.32 {Tk_SelectionCmd procedure} -body {
     setup
     selection own .
     selection own -selection CLIPBOARD .f1
     list [selection own] [selection own -selection CLIPBOARD]
-} {. .f1}
-test select-6.33 {Tk_SelectionCmd procedure} {
+} -result {. .f1}
+test select-6.33 {Tk_SelectionCmd procedure} -body {
     global lostSel
     setup
     set lostSel owned
@@ -731,40 +747,40 @@ test select-6.33 {Tk_SelectionCmd procedure} {
     set result $lostSel
     selection own .f1
     lappend result $lostSel
-} {owned lost}
-test select-6.34 {Tk_SelectionCmd procedure} {
-    list [catch {selection own -badopt foo} cmd] $cmd
-} {1 {bad option "-badopt": must be -command, -displayof, or -selection}}
-test select-6.35 {Tk_SelectionCmd procedure} {
-    list [catch {selection own -selectionfoo foo} cmd] $cmd
-} {1 {bad option "-selectionfoo": must be -command, -displayof, or -selection}}
-test select-6.36 {Tk_SelectionCmd procedure} {
-    catch {destroy .f2}
-    list [catch {selection own -displayof .f2} cmd] $cmd
-} {1 {bad window path name ".f2"}}
-test select-6.37 {Tk_SelectionCmd procedure} {
-    catch {destroy .f2}
-    list [catch {selection own .f2} cmd] $cmd
-} {1 {bad window path name ".f2"}}
-test select-6.38 {Tk_SelectionCmd procedure} {
-    list [catch {selection own foo bar baz} cmd] $cmd
-} {1 {wrong # args: should be "selection own ?-option value ...? ?window?"}}
-test select-6.39 {Tk_SelectionCmd procedure} {
-    list [catch {selection foo} cmd] $cmd
-} {1 {bad option "foo": must be clear, get, handle, or own}}
+} -result {owned lost}
+test select-6.34 {Tk_SelectionCmd procedure} -body {
+    selection own -badopt foo
+} -returnCodes error -result {bad option "-badopt": must be -command, -displayof, or -selection}
+test select-6.35 {Tk_SelectionCmd procedure} -body {
+    selection own -selectionfoo foo
+} -returnCodes error -result {bad option "-selectionfoo": must be -command, -displayof, or -selection}
+test select-6.36 {Tk_SelectionCmd procedure} -body {
+    destroy .f2
+    selection own -displayof .f2
+} -returnCodes error -result {bad window path name ".f2"}
+test select-6.37 {Tk_SelectionCmd procedure} -body {
+    destroy .f2
+    selection own .f2
+} -returnCodes error -result {bad window path name ".f2"}
+test select-6.38 {Tk_SelectionCmd procedure} -body {
+    selection own foo bar baz
+} -returnCodes error -result {wrong # args: should be "selection own ?-option value ...? ?window?"}
+test select-6.39 {Tk_SelectionCmd procedure} -body {
+    selection foo
+} -returnCodes error -result {bad option "foo": must be clear, get, handle, or own}
 
 ##############################################################################
 
 # This test is non-portable because some old X11/News servers ignore
 # a selection request when the window doesn't exist, which causes a
 # different error message.
-test select-7.1 {TkSelDeadWindow procedure} nonPortable {
+test select-7.1 {TkSelDeadWindow procedure} -constraints nonPortable -body {
     setup
     selection handle .f1 { handler TEST }
     set result [selection own]
     destroy .f1
     lappend result [selection own] [catch {selection get} msg] $msg
-} {.f1 {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
+} -result {.f1 {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
 
 ##############################################################################
 
@@ -790,14 +806,14 @@ test select-9.1 {SelCvtToX and SelCvtFromX procedures} -setup {
     set selValue "1024"
     set selInfo ""
     selection handle -selection PRIMARY -format INTEGER -type TEST \
-	    .f1 {handler TEST}
+        .f1 {handler TEST}
     update
     set result ""
     lappend result [dobg {selection get TEST}]
     cleanupbg
     lappend result $selInfo
 } -result {0x400 {TEST 0 4000}}
-test select-9.2 {SelCvtToX and SelCvtFromX procedures} unix {
+test select-9.2 {SelCvtToX and SelCvtFromX procedures} -constraints unix -body {
     setup
     setupbg
     set selValue "1024 0xffff  2048 -2  "
@@ -808,8 +824,8 @@ test select-9.2 {SelCvtToX and SelCvtFromX procedures} unix {
     lappend result [dobg {selection get TEST}]
     cleanupbg
     lappend result $selInfo
-} {{0x400 0xffff 0x800 0xfffffffe} {TEST 0 4000}}
-test select-9.3 {SelCvtToX and SelCvtFromX procedures} unix {
+} -result {{0x400 0xffff 0x800 0xfffffffe} {TEST 0 4000}}
+test select-9.3 {SelCvtToX and SelCvtFromX procedures} -constraints unix -body {
     setup
     setupbg
     set selValue "   "
@@ -820,8 +836,8 @@ test select-9.3 {SelCvtToX and SelCvtFromX procedures} unix {
     lappend result [dobg {selection get TEST}]
     cleanupbg
     lappend result $selInfo
-} {{} {TEST 0 4000}}
-test select-9.4 {SelCvtToX and SelCvtFromX procedures} unix {
+} -result {{} {TEST 0 4000}}
+test select-9.4 {SelCvtToX and SelCvtFromX procedures} -constraints unix -body {
     setup
     setupbg
     set selValue "16 foobar 32"
@@ -832,7 +848,7 @@ test select-9.4 {SelCvtToX and SelCvtFromX procedures} unix {
     lappend result [dobg {selection get TEST}]
     cleanupbg
     lappend result $selInfo
-} {{0x10 0x0 0x20} {TEST 0 4000}}
+} -result {{0x10 0x0 0x20} {TEST 0 4000}}
 test select-9.5 {SelCvtToX and SelCvtFromX procedures} -setup {
     setup
     setupbg
@@ -843,7 +859,7 @@ test select-9.5 {SelCvtToX and SelCvtFromX procedures} -setup {
     set selInfo ""
     set selType {text/x-tk-test;detail="foo bar"}
     selection handle -selection PRIMARY -format STRING -type $selType \
-	.f1 [list handler $selType]
+    .f1 [list handler $selType]
     lsort [dobg {selection get TARGETS}]
 } -cleanup {
     cleanupbg
@@ -854,11 +870,13 @@ test select-9.5 {SelCvtToX and SelCvtFromX procedures} -setup {
 # note, we are not testing MULTIPLE style selections
 
 # most control paths have been exercised above
-test select-10.1 {ConvertSelection procedure, race with selection clear} unix {
+test select-10.1 {ConvertSelection procedure, race with selection clear} -constraints {
+	unix 
+} -body {
     setup
     proc Ready {fd} {
-	variable x
-	lappend x [gets $fd]
+	    variable x
+	    lappend x [gets $fd]
     }
     set fd [open "|[list [interpreter] -geometry +0+0 -name tktest]" r+]
     puts $fd "puts foo; [loadTkCommand]; flush stdout"
@@ -881,10 +899,11 @@ test select-10.1 {ConvertSelection procedure, race with selection clear} unix {
     # a "broken pipe" error when Tk was actually [load]ed in the child.
     catch {close $fd}
     lappend x $selInfo
-} {{1 PRIMARY selection doesn't exist or form "STRING" not defined} {}}
-test select-10.2 {ConvertSelection procedure} unix {
+} -result {{1 PRIMARY selection doesn't exist or form "STRING" not defined} {}}
+test select-10.2 {ConvertSelection procedure} -constraints unix -setup {
     setup
     setupbg
+} -body {
     set selValue [string range $longValue 0 3999]
     set selInfo ""
     selection handle .f1 {handler STRING}
@@ -892,21 +911,24 @@ test select-10.2 {ConvertSelection procedure} unix {
     lappend result [dobg {selection get}]
     cleanupbg
     lappend result $selInfo
-} [list [string range $longValue 0 3999] {STRING 0 4000 STRING 4000 4000 STRING 0 4000 STRING 4000 4000}]
-test select-10.3 {ConvertSelection procedure} unix {
+} -result [list [string range $longValue 0 3999] {STRING 0 4000 STRING 4000 4000 STRING 0 4000 STRING 4000 4000}]
+test select-10.3 {ConvertSelection procedure} -constraints unix -setup {
     setup
     setupbg
+} -body {
     selection handle .f1 ERROR errHandler
-    set result ""
-    lappend result [dobg {selection get ERROR}]
+    dobg {selection get ERROR}
+} -cleanup {
     cleanupbg
-    set result
-} {{PRIMARY selection doesn't exist or form "ERROR" not defined}}
+} -result {PRIMARY selection doesn't exist or form "ERROR" not defined}
 # testing timers
 # This one hangs in Exceed
-test select-10.4 {ConvertSelection procedure} {unix noExceed} {
+test select-10.4 {ConvertSelection procedure} -constraints {
+	unix noExceed
+} -setup {
     setup
     setupbg
+} -body {
     set selValue $longValue
     set selInfo ""
     selection handle .f1 {errIncrHandler STRING}
@@ -915,10 +937,13 @@ test select-10.4 {ConvertSelection procedure} {unix noExceed} {
     lappend result [dobg {selection get}]
     cleanupbg
     lappend result $selInfo
-} {{selection owner didn't respond} {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000 STRING 0 4000 STRING 4000 4000}}
-test select-10.5 {ConvertSelection procedure, reentrancy issues} unix {
+} -result {{selection owner didn't respond} {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000 STRING 0 4000 STRING 4000 4000}}
+test select-10.5 {ConvertSelection procedure, reentrancy issues} -constraints {
+	unix 
+} -setup {
     setup
     setupbg
+} -body {
     set selValue "Test value"
     set selInfo ""
     selection handle -type TEST .f1 { handler TEST }
@@ -927,14 +952,17 @@ test select-10.5 {ConvertSelection procedure, reentrancy issues} unix {
     lappend result [dobg {selection get}]
     cleanupbg
     lappend result $selInfo
-} {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000}}
-test select-10.6 {ConvertSelection procedure, reentrancy issues} unix {
-    proc weirdHandler {type offset count} {
-	destroy .f1
-	handler $type $offset $count
-    }
+} -result {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000}}
+test select-10.6 {ConvertSelection procedure, reentrancy issues} -constraints {
+	unix 
+} -setup {
     setup
     setupbg
+} -body {
+    proc weirdHandler {type offset count} {
+	    destroy .f1
+	    handler $type $offset $count
+    }
     set selValue $longValue
     set selInfo ""
     selection handle .f1 {weirdHandler STRING}
@@ -942,14 +970,15 @@ test select-10.6 {ConvertSelection procedure, reentrancy issues} unix {
     lappend result [dobg {selection get}]
     cleanupbg
     lappend result $selInfo
-} {{PRIMARY selection doesn't exist or form "STRING" not defined} {STRING 0 4000}}
+} -result {{PRIMARY selection doesn't exist or form "STRING" not defined} {STRING 0 4000}}
 
 ##############################################################################
 
 # testing reentrancy
-test select-11.1 {TkSelPropProc procedure} unix {
+test select-11.1 {TkSelPropProc procedure} -constraints unix -setup {
     setup
     setupbg
+} -body {
     set selValue $longValue
     set selInfo ""
     selection handle -type TEST .f1 { handler TEST }
@@ -959,28 +988,28 @@ test select-11.1 {TkSelPropProc procedure} unix {
     lappend result [dobg {selection get}]
     cleanupbg
     lappend result $selInfo
-} {{selection owner didn't respond} {.f1 STRING 0 4000 .f1 STRING 4000 4000 .f1 STRING 8000 4000 .f1 STRING 12000 4000 .f1 STRING 16000 4000 .f1 STRING 0 4000 .f1 STRING 4000 4000}}
+} -result {{selection owner didn't respond} {.f1 STRING 0 4000 .f1 STRING 4000 4000 .f1 STRING 8000 4000 .f1 STRING 12000 4000 .f1 STRING 16000 4000 .f1 STRING 0 4000 .f1 STRING 4000 4000}}
 
 ##############################################################################
 
 # Note, this assumes we are using CurrentTtime
-test select-12.1 {DefaultSelection procedure} unix {
+test select-12.1 {DefaultSelection procedure} -constraints unix -body {
     setup
     set result [selection get -type TIMESTAMP]
     setupbg
     lappend result [dobg {selection get -type TIMESTAMP}]
     cleanupbg
     set result
-} {0x0 0x0}
-test select-12.2 {DefaultSelection procedure} unix {
+} -result {0x0 0x0}
+test select-12.2 {DefaultSelection procedure} -constraints unix -body {
     setup
     set result [lsort [list [selection get -type TARGETS]]]
     setupbg
     lappend result [dobg {lsort [selection get -type TARGETS]}]
     cleanupbg
     set result
-} {{MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
-test select-12.3 {DefaultSelection procedure} unix {
+} -result {{MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-12.3 {DefaultSelection procedure} -constraints unix -body {
     setup
     selection handle .f1 {handler TEST} TEST
     set result [list [lsort [selection get -type TARGETS]]]
@@ -988,25 +1017,26 @@ test select-12.3 {DefaultSelection procedure} unix {
     lappend result [dobg {lsort [selection get -type TARGETS]}]
     cleanupbg
     set result
-} {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
-test select-12.4 {DefaultSelection procedure} unix {
+} -result {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-12.4 {DefaultSelection procedure} -constraints unix -setup {
     setup
     set result ""
+} -body {
     lappend result [selection get -type TK_APPLICATION]
     setupbg
     lappend result [dobg {selection get -type TK_APPLICATION}]
     cleanupbg
     set result
-} [list [winfo name .] [winfo name .]]
-test select-12.5 {DefaultSelection procedure} unix {
+} -result [list [winfo name .] [winfo name .]]
+test select-12.5 {DefaultSelection procedure} -constraints unix -body {
     setup
     set result [selection get -type TK_WINDOW]
     setupbg
     lappend result [dobg {selection get -type TK_WINDOW}]
     cleanupbg
     set result
-} {.f1 .f1}
-test select-12.6 {DefaultSelection procedure} {
+} -result {.f1 .f1}
+test select-12.6 {DefaultSelection procedure} -body {
     setup
     selection handle .f1 {handler TARGETS.f1} TARGETS
     set selValue "Targets value"
@@ -1014,24 +1044,28 @@ test select-12.6 {DefaultSelection procedure} {
     set result [list [selection get TARGETS] $selInfo]
     selection handle .f1 {} TARGETS
     lappend result [selection get TARGETS]
-} {{Targets value} {TARGETS.f1 0 4000} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
+} -result {{Targets value} {TARGETS.f1 0 4000} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
 
-test select-13.1 {SelectionSize procedure, handler deleted} unix {
-    proc badHandler {path type offset count} {
-	global selValue selInfo abortCount
-	incr abortCount -1
-	if {$abortCount == 0} {
-	    selection handle -type $type $path {}
-	}
-	lappend selInfo $path $type $offset $count
-	set numBytes [expr {[string length $selValue] - $offset}]
-	if {$numBytes <= 0} {
-	    return ""
-	}
-	string range $selValue $offset [expr $numBytes+$offset]
-    }
+
+test select-13.1 {SelectionSize procedure, handler deleted} -constraints {
+	unix 
+} -setup {
     setup
     setupbg
+} -body {
+    proc badHandler {path type offset count} {
+	    global selValue selInfo abortCount
+	    incr abortCount -1
+	    if {$abortCount == 0} {
+	        selection handle -type $type $path {}
+	    }
+	    lappend selInfo $path $type $offset $count
+	    set numBytes [expr {[string length $selValue] - $offset}]
+	    if {$numBytes <= 0} {
+	        return ""
+	    }
+	    string range $selValue $offset [expr $numBytes+$offset]
+    }
     set selValue $longValue
     set selInfo ""
     selection handle .f1 {badHandler .f1 STRING}
@@ -1040,10 +1074,11 @@ test select-13.1 {SelectionSize procedure, handler deleted} unix {
     lappend result [dobg {selection get}]
     cleanupbg
     lappend result $selInfo
-} {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}}
+} -result {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}}
 
 catch {rename weirdHandler {}}
 
 # cleanup
 cleanupTests
 return
+
diff --git a/tests/textBTree.test b/tests/textBTree.test
index ed9762e..fc13817 100644
--- a/tests/textBTree.test
+++ b/tests/textBTree.test
@@ -8,644 +8,850 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textBTree.test,v 1.7 2004/05/23 17:34:49 dkf Exp $
+# RCS: @(#) $Id: textBTree.test,v 1.8 2008/08/28 08:52:06 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
-catch {destroy .t}
+proc setup {} {
+    .t delete 1.0 100000.0
+    .t tag delete x y
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    .t tag add x 1.1
+    .t tag add x 1.5 1.13
+    .t tag add x 2.2 2.6
+    .t tag add y 1.5
+}
+
+# setup procedure for tests 10.*, 11.*, 12.*
+proc msetup {} {
+    .t delete 1.0 100000.0
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    .t mark set m1 1.2
+    .t mark set l1 1.2
+    .t mark gravity l1 left
+    .t mark set next 1.6
+    .t mark set x 1.6
+    .t mark set m2 2.0
+    .t mark set m3 2.100
+    .t tag add x 1.3 1.8
+}
+
+# setup procedure for tests 16.*, 17.*, 18.9
+proc setupBig {} {
+    .t delete 1.0 end
+    .t tag delete x y
+    .t tag configure x -foreground blue
+    .t tag configure y -underline true
+    # Create a Btree with 2002 lines (2000 + already existing + phantom at end)
+    # This generates a level 3 node with 9 children
+    # Most level 2 nodes cover 216 lines and have 6 children, except the last
+    # level 2 node covers 274 lines and has 7 children.
+    # Most level 1 nodes cover 36 lines and have 6 children, except the
+    # rightmost node has 58 lines and 9 children.
+    # Level 2: 2002 = 8*216 + 274
+    # Level 1: 2002 = 54*36 + 58
+    # Level 0: 2002 = 332*6 + 10
+    for {set i 0} {$i < 2000} {incr i} {
+        append x "Line $i abcd efgh ijkl\n"
+    }
+    .t insert insert $x
+    .t debug 1
+}
+
+# Widget used in tests 1.* - 13.*
+destroy .t
 text .t
 .t debug on
 
-test btree-1.1 {basic insertions} {
+test btree-1.1 {basic insertions} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\nLine 3\n"
-test btree-1.2 {basic insertions} {
+} -result "Line 1\nLine 2\nLine 3\n"
+test btree-1.2 {basic insertions} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t insert 1.3 XXX
     .t get 1.0 1000000.0
-} "LinXXXe 1\nLine 2\nLine 3\n"
-test btree-1.3 {basic insertions} {
+} -result "LinXXXe 1\nLine 2\nLine 3\n"
+test btree-1.3 {basic insertions} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t insert 3.0 YYY
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\nYYYLine 3\n"
-test btree-1.4 {basic insertions} {
+} -result "Line 1\nLine 2\nYYYLine 3\n"
+test btree-1.4 {basic insertions} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t insert 2.1 X\nYY
     .t get 1.0 1000000.0
-} "Line 1\nLX\nYYine 2\nLine 3\n"
-test btree-1.5 {basic insertions} {
+} -result "Line 1\nLX\nYYine 2\nLine 3\n"
+test btree-1.5 {basic insertions} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t insert 2.0 X\n\n\n
     .t get 1.0 1000000.0
-} "Line 1\nX\n\n\nLine 2\nLine 3\n"
-test btree-1.6 {basic insertions} {
+} -result "Line 1\nX\n\n\nLine 2\nLine 3\n"
+test btree-1.6 {basic insertions} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t insert 2.6 X\n
     .t get 1.0 1000000.0
-} "Line 1\nLine 2X\n\nLine 3\n"
-test btree-1.7 {insertion before start of text} {
+} -result "Line 1\nLine 2X\n\nLine 3\n"
+test btree-1.7 {insertion before start of text} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t insert 0.4 XXX
     .t get 1.0 1000000.0
-} "XXXLine 1\nLine 2\nLine 3\n"
-test btree-1.8 {insertion past end of text} {
+} -result "XXXLine 1\nLine 2\nLine 3\n"
+test btree-1.8 {insertion past end of text} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t insert 100.0 ZZ
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\nLine 3ZZ\n"
-test btree-1.9 {insertion before start of line} {
+} -result "Line 1\nLine 2\nLine 3ZZ\n"
+test btree-1.9 {insertion before start of line} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t insert 2.-3 Q
     .t get 1.0 1000000.0
-} "Line 1\nQLine 2\nLine 3\n"
-test btree-1.10 {insertion past end of line} {
+} -result "Line 1\nQLine 2\nLine 3\n"
+test btree-1.10 {insertion past end of line} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t insert 2.40 XYZZY
     .t get 1.0 1000000.0
-} "Line 1\nLine 2XYZZY\nLine 3\n"
-test btree-1.11 {insertion past end of last line} {
+} -result "Line 1\nLine 2XYZZY\nLine 3\n"
+test btree-1.11 {insertion past end of last line} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t insert 3.40 ABC
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\nLine 3ABC\n"
+} -result "Line 1\nLine 2\nLine 3ABC\n"
+
 
-test btree-2.1 {basic deletions} {
+test btree-2.1 {basic deletions} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 1.0 1.3
     .t get 1.0 1000000.0
-} "e 1\nLine 2\nLine 3\n"
-test btree-2.2 {basic deletions} {
+} -result "e 1\nLine 2\nLine 3\n"
+test btree-2.2 {basic deletions} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 2.2
     .t get 1.0 1000000.0
-} "Line 1\nLie 2\nLine 3\n"
-test btree-2.3 {basic deletions} {
+} -result "Line 1\nLie 2\nLine 3\n"
+test btree-2.3 {basic deletions} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 2.0 2.3
     .t get 1.0 1000000.0
-} "Line 1\ne 2\nLine 3\n"
-test btree-2.4 {deleting whole lines} {
+} -result "Line 1\ne 2\nLine 3\n"
+test btree-2.4 {deleting whole lines} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 1.2 3.0
     .t get 1.0 1000000.0
-} "LiLine 3\n"
-test btree-2.5 {deleting whole lines} {
+} -result "LiLine 3\n"
+test btree-2.5 {deleting whole lines} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\n\n\nLine 5"
     .t delete 1.0 5.2
     .t get 1.0 1000000.0
-} "ne 5\n"
-test btree-2.6 {deleting before start of file} {
+} -result "ne 5\n"
+test btree-2.6 {deleting before start of file} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 0.3 1.2
     .t get 1.0 1000000.0
-} "ne 1\nLine 2\nLine 3\n"
-test btree-2.7 {deleting after end of file} {
+} -result "ne 1\nLine 2\nLine 3\n"
+test btree-2.7 {deleting after end of file} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 10.3
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\nLine 3\n"
-test btree-2.8 {deleting before start of line} {
+} -result "Line 1\nLine 2\nLine 3\n"
+test btree-2.8 {deleting before start of line} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 3.-1 3.3
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\ne 3\n"
-test btree-2.9 {deleting before start of line} {
+} -result "Line 1\nLine 2\ne 3\n"
+test btree-2.9 {deleting before start of line} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 1.-1 1.0
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\nLine 3\n"
-test btree-2.10 {deleting after end of line} {
+} -result "Line 1\nLine 2\nLine 3\n"
+test btree-2.10 {deleting after end of line} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 1.8 2.1
     .t get 1.0 1000000.0
-} "Line 1ine 2\nLine 3\n"
-test btree-2.11 {deleting after end of last line} {
+} -result "Line 1ine 2\nLine 3\n"
+test btree-2.11 {deleting after end of last line} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 3.8 4.1
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\nLine 3\n"
-test btree-2.12 {deleting before start of file} {
+} -result "Line 1\nLine 2\nLine 3\n"
+test btree-2.12 {deleting before start of file} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 1.8 0.0
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\nLine 3\n"
-test btree-2.13 {deleting past end of file} {
+} -result "Line 1\nLine 2\nLine 3\n"
+test btree-2.13 {deleting past end of file} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 1.8 4.0
     .t get 1.0 1000000.0
-} "Line 1\n"
-test btree-2.14 {deleting with end before start of line} {
+} -result "Line 1\n"
+test btree-2.14 {deleting with end before start of line} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 1.3 2.-3
     .t get 1.0 1000000.0
-} "LinLine 2\nLine 3\n"
-test btree-2.15 {deleting past end of line} {
+} -result "LinLine 2\nLine 3\n"
+test btree-2.15 {deleting past end of line} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 1.3 1.9
     .t get 1.0 1000000.0
-} "Lin\nLine 2\nLine 3\n"
-test btree-2.16 {deleting past end of line} {
+} -result "Lin\nLine 2\nLine 3\n"
+test btree-2.16 {deleting past end of line} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 3.2 3.15
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\nLi\n"
-test btree-2.17 {deleting past end of line} {
+} -result "Line 1\nLine 2\nLi\n"
+test btree-2.17 {deleting past end of line} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 3.0 3.15
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\n\n"
-test btree-2.18 {deleting past end of line} {
+} -result "Line 1\nLine 2\n\n"
+test btree-2.18 {deleting past end of line} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 1.0 3.15
     .t get 1.0 1000000.0
-} "\n"
-test btree-2.19 {deleting with negative range} {
+} -result "\n"
+test btree-2.19 {deleting with negative range} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 3.2 2.4
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\nLine 3\n"
-test btree-2.20 {deleting with negative range} {
+} -result "Line 1\nLine 2\nLine 3\n"
+test btree-2.20 {deleting with negative range} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 3.2 3.1
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\nLine 3\n"
-test btree-2.21 {deleting with negative range} {
+} -result "Line 1\nLine 2\nLine 3\n"
+test btree-2.21 {deleting with negative range} -body {
     .t delete 1.0 100000.0
     .t insert 1.0 "Line 1\nLine 2\nLine 3"
     .t delete 3.2 3.2
     .t get 1.0 1000000.0
-} "Line 1\nLine 2\nLine 3\n"
+} -result "Line 1\nLine 2\nLine 3\n"
 
-proc setup {} {
-    .t delete 1.0 100000.0
-    .t tag delete x y
-    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
-    .t tag add x 1.1
-    .t tag add x 1.5 1.13
-    .t tag add x 2.2 2.6
-    .t tag add y 1.5
-}
 
-test btree-3.1 {inserting with tags} {
+test btree-3.1 {inserting with tags} -body {
     setup
     .t insert 1.0 XXX
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.4 1.5 1.8 1.16 2.2 2.6} {1.8 1.9}}
-test btree-3.2 {inserting with tags} {
+} -result {{1.4 1.5 1.8 1.16 2.2 2.6} {1.8 1.9}}
+test btree-3.2 {inserting with tags} -body {
     setup
     .t insert 1.15 YYY
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 1.2 1.5 1.13 2.2 2.6} {1.5 1.6}}
-test btree-3.3 {inserting with tags} {
+} -result {{1.1 1.2 1.5 1.13 2.2 2.6} {1.5 1.6}}
+test btree-3.3 {inserting with tags} -body {
     setup
     .t insert 1.7 ZZZZ
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 1.2 1.5 1.17 2.2 2.6} {1.5 1.6}}
-test btree-3.4 {inserting with tags} {
+} -result {{1.1 1.2 1.5 1.17 2.2 2.6} {1.5 1.6}}
+test btree-3.4 {inserting with tags} -body {
     setup
     .t insert 1.7 \n\n
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 1.2 1.5 3.6 4.2 4.6} {1.5 1.6}}
-test btree-3.5 {inserting with tags} {
+} -result {{1.1 1.2 1.5 3.6 4.2 4.6} {1.5 1.6}}
+test btree-3.5 {inserting with tags} -body {
     setup
     .t insert 1.5 A\n
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 1.2 2.0 2.8 3.2 3.6} {2.0 2.1}}
-test btree-3.6 {inserting with tags} {
+} -result {{1.1 1.2 2.0 2.8 3.2 3.6} {2.0 2.1}}
+test btree-3.6 {inserting with tags} -body {
     setup
     .t insert 1.13 A\n
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 1.2 1.5 1.13 3.2 3.6} {1.5 1.6}}
+} -result {{1.1 1.2 1.5 1.13 3.2 3.6} {1.5 1.6}}
+
 
-test btree-4.1 {deleting with tags} {
+test btree-4.1 {deleting with tags} -body {
     setup
     .t delete 1.6 1.9
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 1.2 1.5 1.10 2.2 2.6} {1.5 1.6}}
-test btree-4.2 {deleting with tags} {
+} -result {{1.1 1.2 1.5 1.10 2.2 2.6} {1.5 1.6}}
+test btree-4.2 {deleting with tags} -body {
     setup
     .t delete 1.1 2.3
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 1.4} {}}
-test btree-4.3 {deleting with tags} {
+} -result {{1.1 1.4} {}}
+test btree-4.3 {deleting with tags} -body {
     setup
     .t delete 1.4 2.1
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 1.2 1.5 1.9} {}}
-test btree-4.4 {deleting with tags} {
+} -result {{1.1 1.2 1.5 1.9} {}}
+test btree-4.4 {deleting with tags} -body {
     setup
     .t delete 1.14 2.1
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 1.2 1.5 1.13 1.15 1.19} {1.5 1.6}}
-test btree-4.5 {deleting with tags} {
+} -result {{1.1 1.2 1.5 1.13 1.15 1.19} {1.5 1.6}}
+test btree-4.5 {deleting with tags} -body {
     setup
     .t delete 1.0 2.10
     list [.t tag ranges x] [.t tag ranges y]
-} {{} {}}
-test btree-4.6 {deleting with tags} {
+} -result {{} {}}
+test btree-4.6 {deleting with tags} -body {
     setup
     .t delete 1.0 1.5
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.0 1.8 2.2 2.6} {1.0 1.1}}
-test btree-4.7 {deleting with tags} {
+} -result {{1.0 1.8 2.2 2.6} {1.0 1.1}}
+test btree-4.7 {deleting with tags} -body {
     setup
     .t delete 1.6 1.9
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 1.2 1.5 1.10 2.2 2.6} {1.5 1.6}}
-test btree-4.8 {deleting with tags} {
+} -result {{1.1 1.2 1.5 1.10 2.2 2.6} {1.5 1.6}}
+test btree-4.8 {deleting with tags} -body {
     setup
     .t delete 1.5 1.13
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 1.2 2.2 2.6} {}}
+} -result {{1.1 1.2 2.2 2.6} {}}
 
-set bigText1 {}
-for {set i 0} {$i < 10} {incr i} {
-    append bigText1 "Line $i\n"
-}
-set bigText2 {}
-for {set i 0} {$i < 200} {incr i} {
-    append bigText2 "Line $i\n"
-}
-test btree-5.1 {very large inserts, with tags} {
+
+test btree-5.1 {very large inserts, with tags} -setup {
+    set bigText1 {}
+    for {set i 0} {$i < 10} {incr i} {
+        append bigText1 "Line $i\n"
+    }
+} -body {
     setup
     .t insert 1.0 $bigText1
     list [.t tag ranges x] [.t tag ranges y]
-} {{11.1 11.2 11.5 11.13 12.2 12.6} {11.5 11.6}}
-test btree-5.2 {very large inserts, with tags} {
+} -result {{11.1 11.2 11.5 11.13 12.2 12.6} {11.5 11.6}}
+test btree-5.2 {very large inserts, with tags} -setup {
+    set bigText2 {}
+    for {set i 0} {$i < 200} {incr i} {
+        append bigText2 "Line $i\n"
+    }
+} -body {
     setup
     .t insert 1.2 $bigText2
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 1.2 201.3 201.11 202.2 202.6} {201.3 201.4}}
-test btree-5.3 {very large inserts, with tags} {
+} -result {{1.1 1.2 201.3 201.11 202.2 202.6} {201.3 201.4}}
+test btree-5.3 {very large inserts, with tags} -body {
     setup
     for {set i 0} {$i < 200} {incr i} {
-	.t insert 1.8 "longer line $i\n"
+        .t insert 1.8 "longer line $i\n"
     }
-    list [.t tag ranges x] [.t tag ranges y] [.t get 1.0 1.100] [.t get 198.0 198.100]
-} {{1.1 1.2 1.5 201.5 202.2 202.6} {1.5 1.6} {Text forlonger line 199} {longer line 2}}
+    list [.t tag ranges x] [.t tag ranges y] [.t get 1.0 1.100] \
+        [.t get 198.0 198.100]
+} -result {{1.1 1.2 1.5 201.5 202.2 202.6} {1.5 1.6} {Text forlonger line 199} {longer line 2}}
 
-test btree-6.1 {very large deletes, with tags} {
+
+test btree-6.1 {very large deletes, with tags}  -setup {
+    set bigText2 {}
+    for {set i 0} {$i < 200} {incr i} {
+        append bigText2 "Line $i\n"
+    }
+} -body {
     setup
     .t insert 1.1 $bigText2
     .t delete 1.2 201.2
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.4 1.12 2.2 2.6} {1.4 1.5}}
-test btree-6.2 {very large deletes, with tags} {
+} -result {{1.4 1.12 2.2 2.6} {1.4 1.5}}
+test btree-6.2 {very large deletes, with tags}  -setup {
+    set bigText2 {}
+    for {set i 0} {$i < 200} {incr i} {
+        append bigText2 "Line $i\n"
+    }
+} -body {
     setup
     .t insert 1.1 $bigText2
     for {set i 0} {$i < 200} {incr i} {
-	.t delete 1.2 2.2
+        .t delete 1.2 2.2
     }
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.4 1.12 2.2 2.6} {1.4 1.5}}
-test btree-6.3 {very large deletes, with tags} {
+} -result {{1.4 1.12 2.2 2.6} {1.4 1.5}}
+test btree-6.3 {very large deletes, with tags}  -setup {
+    set bigText2 {}
+     for {set i 0} {$i < 200} {incr i} {
+            append bigText2 "Line $i\n"
+    }
+} -body {
     setup
     .t insert 1.1 $bigText2
     .t delete 2.3 10000.0
     .t get 1.0 1000.0
-} {TLine 0
+} -result {TLine 0
 Lin
 }
-test btree-6.4 {very large deletes, with tags} {
+test btree-6.4 {very large deletes, with tags} -setup {
+    set bigText2 {}
+    for {set i 0} {$i < 200} {incr i} {
+        append bigText2 "Line $i\n"
+    }
+} -body {
     setup
     .t insert 1.1 $bigText2
     for {set i 0} {$i < 100} {incr i} {
-	.t delete 30.0 31.0
+        .t delete 30.0 31.0
     }
     list [.t tag ranges x] [.t tag ranges y]
-} {{101.0 101.1 101.4 101.12 102.2 102.6} {101.4 101.5}}
-test btree-6.5 {very large deletes, with tags} {
+} -result {{101.0 101.1 101.4 101.12 102.2 102.6} {101.4 101.5}}
+test btree-6.5 {very large deletes, with tags} -setup {
+    set bigText2 {}
+    for {set i 0} {$i < 200} {incr i} {
+        append bigText2 "Line $i\n"
+    }
+} -body {
     setup
     .t insert 1.1 $bigText2
     for {set i 0} {$i < 100} {incr i} {
-	set j [expr $i+2]
-	set k [expr 1+2*$i]
-	.t tag add x $j.1 $j.3
-	.t tag add y $k.1 $k.6
+        set j [expr $i+2]
+        set k [expr 1+2*$i]
+        .t tag add x $j.1 $j.3
+        .t tag add y $k.1 $k.6
     }
     .t delete 2.0 200.0
     list [.t tag ranges x] [.t tag ranges y]
-} {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}}
-test btree-6.6 {very large deletes, with tags} {
+} -result {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}}
+test btree-6.6 {very large deletes, with tags} -setup {
+    set bigText2 {}
+    for {set i 0} {$i < 200} {incr i} {
+        append bigText2 "Line $i\n"
+    }
+} -body {
     setup
     .t insert 1.1 $bigText2
     for {set i 0} {$i < 100} {incr i} {
-	set j [expr $i+2]
-	set k [expr 1+2*$i]
-	.t tag add x $j.1 $j.3
-	.t tag add y $k.1 $k.6
+        set j [expr $i+2]
+        set k [expr 1+2*$i]
+        .t tag add x $j.1 $j.3
+        .t tag add y $k.1 $k.6
     }
     for {set i 199} {$i >= 2} {incr i -1} {
-	.t delete $i.0 [expr $i+1].0
+        .t delete $i.0 [expr $i+1].0
     }
     list [.t tag ranges x] [.t tag ranges y]
-} {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}}
-
-.t delete 1.0 end
-.t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
-set i 1
-foreach check {
-    {1.3 1.6 1.7 2.0 {1.3 1.6 1.7 2.0}}
-    {1.3 1.6 1.6 2.0 {1.3 2.0}}
-    {1.3 1.6 1.4 2.0 {1.3 2.0}}
-    {2.0 4.3 1.4 1.10 {1.4 1.10 2.0 4.3}}
-    {2.0 4.3 1.4 1.end {1.4 1.19 2.0 4.3}}
-    {2.0 4.3 1.4 2.0 {1.4 4.3}}
-    {2.0 4.3 1.4 3.0 {1.4 4.3}}
-    {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.1 4.2 {1.1 4.2}}
-    {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.3 4.2 {1.2 4.2}}
-    {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.1 3.0 {1.1 4.0}}
-    {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.2 3.0 {1.2 4.0}}
-} {
-    test btree-7.$i {tag addition and removal} {
-	.t tag remove x 1.0 end
-	while {[llength $check] > 2} {
-	    .t tag add x [lindex $check 0] [lindex $check 1]
-	    set check [lrange $check 2 end]
-	}
-	.t tag ranges x
-    } [lindex $check [expr [llength $check]-1]]
-    incr i
-}
+} -result {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}}
+
+
+test btree-7.1 {tag addition and removal} -setup {
+    .t delete 1.0 end
+    .t tag remove x 1.0 end
+} -body {
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    set check {1.3 1.6 1.7 2.0}
+    while {[llength $check]} {
+        .t tag add x [lindex $check 0] [lindex $check 1]
+        set check [lrange $check 2 end]
+    }
+    .t tag ranges x
+} -result {1.3 1.6 1.7 2.0}
+test btree-7.2 {tag addition and removal} -setup {
+    .t delete 1.0 end
+    .t tag remove x 1.0 end
+} -body {
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    set check {1.3 1.6 1.6 2.0}
+    while {[llength $check]} {
+        .t tag add x [lindex $check 0] [lindex $check 1]
+        set check [lrange $check 2 end]
+    }
+    .t tag ranges x
+} -result {1.3 2.0}
+test btree-7.3 {tag addition and removal} -setup {
+    .t delete 1.0 end
+    .t tag remove x 1.0 end
+} -body {
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    set check {1.3 1.6 1.4 2.0}
+    while {[llength $check]} {
+        .t tag add x [lindex $check 0] [lindex $check 1]
+        set check [lrange $check 2 end]
+    }
+    .t tag ranges x
+} -result {1.3 2.0}
+test btree-7.4 {tag addition and removal} -setup {
+    .t delete 1.0 end
+    .t tag remove x 1.0 end
+} -body {
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    set check {2.0 4.3 1.4 1.10}
+    while {[llength $check]} {
+        .t tag add x [lindex $check 0] [lindex $check 1]
+        set check [lrange $check 2 end]
+    }
+    .t tag ranges x
+} -result {1.4 1.10 2.0 4.3}
+test btree-7.5 {tag addition and removal} -setup {
+    .t delete 1.0 end
+    .t tag remove x 1.0 end
+} -body {
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    set check {2.0 4.3 1.4 1.end}
+    while {[llength $check]} {
+        .t tag add x [lindex $check 0] [lindex $check 1]
+        set check [lrange $check 2 end]
+    }
+    .t tag ranges x
+} -result {1.4 1.19 2.0 4.3}
+test btree-7.6 {tag addition and removal} -setup {
+    .t delete 1.0 end
+    .t tag remove x 1.0 end
+} -body {
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    set check {2.0 4.3 1.4 2.0}
+    while {[llength $check]} {
+        .t tag add x [lindex $check 0] [lindex $check 1]
+        set check [lrange $check 2 end]
+    }
+    .t tag ranges x
+} -result {1.4 4.3}
+test btree-7.7 {tag addition and removal} -setup {
+    .t delete 1.0 end
+    .t tag remove x 1.0 end
+} -body {
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    set check {2.0 4.3 1.4 3.0}
+    while {[llength $check]} {
+        .t tag add x [lindex $check 0] [lindex $check 1]
+        set check [lrange $check 2 end]
+    }
+    .t tag ranges x
+} -result {1.4 4.3}
+test btree-7.8 {tag addition and removal} -setup {
+    .t delete 1.0 end
+    .t tag remove x 1.0 end
+} -body {
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    set check {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.1 4.2}
+    while {[llength $check]} {
+        .t tag add x [lindex $check 0] [lindex $check 1]
+        set check [lrange $check 2 end]
+    }
+    .t tag ranges x
+} -result {1.1 4.2}
+test btree-7.9 {tag addition and removal} -setup {
+    .t delete 1.0 end
+    .t tag remove x 1.0 end
+} -body {
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    set check {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.3 4.2}
+    while {[llength $check]} {
+        .t tag add x [lindex $check 0] [lindex $check 1]
+        set check [lrange $check 2 end]
+    }
+    .t tag ranges x
+} -result {1.2 4.2}
+test btree-7.10 {tag addition and removal} -setup {
+    .t delete 1.0 end
+    .t tag remove x 1.0 end
+} -body {
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    set check {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.1 3.0}
+    while {[llength $check]} {
+        .t tag add x [lindex $check 0] [lindex $check 1]
+        set check [lrange $check 2 end]
+    }
+    .t tag ranges x
+} -result {1.1 4.0}
+test btree-7.11 {tag addition and removal} -setup {
+    .t delete 1.0 end
+    .t tag remove x 1.0 end
+} -body {
+    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+    set check {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.2 3.0}
+    while {[llength $check]} {
+        .t tag add x [lindex $check 0] [lindex $check 1]
+        set check [lrange $check 2 end]
+    }
+    .t tag ranges x
+} -result {1.2 4.0}
 
-test btree-8.1 {tag addition and removal, weird ranges} {
+
+test btree-8.1 {tag addition and removal, weird ranges} -body {
     .t delete 1.0 100000.0
     .t tag delete x
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 0.0 1.3
     .t tag ranges x
-} {1.0 1.3}
-test btree-8.2 {tag addition and removal, weird ranges} {
+} -result {1.0 1.3}
+test btree-8.2 {tag addition and removal, weird ranges} -body {
     .t delete 1.0 100000.0
     .t tag delete x
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 1.40 2.4
     .t tag ranges x
-} {1.19 2.4}
-test btree-8.3 {tag addition and removal, weird ranges} {
+} -result {1.19 2.4}
+test btree-8.3 {tag addition and removal, weird ranges} -body {
     .t delete 1.0 100000.0
     .t tag delete x
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 4.40 4.41
     .t tag ranges x
-} {}
-test btree-8.4 {tag addition and removal, weird ranges} {
+} -result {}
+test btree-8.4 {tag addition and removal, weird ranges} -body {
     .t delete 1.0 100000.0
     .t tag delete x
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 5.1 5.2
     .t tag ranges x
-} {}
-test btree-8.5 {tag addition and removal, weird ranges} {
+} -result {}
+test btree-8.5 {tag addition and removal, weird ranges} -body {
     .t delete 1.0 100000.0
     .t tag delete x
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 1.1 9.0
     .t tag ranges x
-} {1.1 5.0}
-test btree-8.6 {tag addition and removal, weird ranges} {
+} -result {1.1 5.0}
+test btree-8.6 {tag addition and removal, weird ranges} -body {
     .t delete 1.0 100000.0
     .t tag delete x
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 1.1 1.90
     .t tag ranges x
-} {1.1 1.19}
-test btree-8.7 {tag addition and removal, weird ranges} {
+} -result {1.1 1.19}
+test btree-8.7 {tag addition and removal, weird ranges} -body {
     .t delete 1.0 100000.0
     .t tag delete x
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 1.1 4.90
     .t tag ranges x
-} {1.1 4.17}
-test btree-8.8 {tag addition and removal, weird ranges} {
+} -result {1.1 4.17}
+test btree-8.8 {tag addition and removal, weird ranges} -body {
     .t delete 1.0 100000.0
     .t tag delete x
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 3.0 3.0
     .t tag ranges x
-} {}
+} -result {}
+
 
-test btree-9.1 {tag names} {
+test btree-9.1 {tag names} -body {
     setup
     .t tag names
-} {sel x y}
-test btree-9.2 {tag names} {
+} -result {sel x y}
+test btree-9.2 {tag names} -body {
     setup
     .t tag add tag1 1.8
     .t tag add tag2 1.8
     .t tag add tag3 1.7 1.9
     .t tag names 1.8
-} {x tag1 tag2 tag3}
-test btree-9.3 {lots of tag names} {
+} -result {x tag1 tag2 tag3}
+test btree-9.3 {lots of tag names} -setup {
+    set bigText2 {}
+    for {set i 0} {$i < 200} {incr i} {
+        append bigText2 "Line $i\n"
+    }
+} -body {
     setup
     .t insert 1.2 $bigText2
     foreach i {tag1 foo ThisOne {x space} q r s t} {
-	.t tag add $i 150.2
+    .t tag add $i 150.2
     }
     foreach i {u tagA tagB tagC and more {$} \{} {
-	.t tag add $i 150.1 150.3
+    .t tag add $i 150.1 150.3
     }
     .t tag names 150.2
-} {tag1 foo ThisOne {x space} q r s t u tagA tagB tagC and more {$} \{}
-test btree-9.4 {lots of tag names} {
+} -result {tag1 foo ThisOne {x space} q r s t u tagA tagB tagC and more {$} \{}
+test btree-9.4 {lots of tag names} -setup {
+    set bigText2 {}
+    for {set i 0} {$i < 200} {incr i} {
+        append bigText2 "Line $i\n"
+    }
+} -body {
     setup
     .t insert 1.2 $bigText2
     .t tag delete tag1 foo ThisOne more {x space} q r s t u
     .t tag delete tagA tagB tagC and {$} \{ more
     foreach i {tag1 foo ThisOne more {x space} q r s t} {
-	.t tag add $i 150.2
+    .t tag add $i 150.2
     }
     foreach i {foo ThisOne u tagA tagB tagC and more {$} \{} {
-	.t tag add $i 150.4
+    .t tag add $i 150.4
     }
     .t tag delete tag1 more q r tagA
     .t tag names 150.2
-} {foo ThisOne {x space} s t}
+} -result {foo ThisOne {x space} s t}
 
-proc msetup {} {
-    .t delete 1.0 100000.0
-    .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
-    .t mark set m1 1.2
-    .t mark set l1 1.2
-    .t mark gravity l1 left
-    .t mark set next 1.6
-    .t mark set x 1.6
-    .t mark set m2 2.0
-    .t mark set m3 2.100
-    .t tag add x 1.3 1.8
-}
-test btree-10.1 {basic mark facilities} {
+
+test btree-10.1 {basic mark facilities} -body {
     msetup
     list [lsort [.t mark names]] [.t index m1] [.t index m2] [.t index m3]
-} {{current insert l1 m1 m2 m3 next x} 1.2 2.0 2.11}
-test btree-10.2 {basic mark facilities} {
+} -result {{current insert l1 m1 m2 m3 next x} 1.2 2.0 2.11}
+test btree-10.2 {basic mark facilities} -body {
     msetup
     .t mark unset m2
     lsort [.t mark names]
-} {current insert l1 m1 m3 next x}
-test btree-10.3 {basic mark facilities} {
+} -result {current insert l1 m1 m3 next x}
+test btree-10.3 {basic mark facilities} -body {
     msetup
     .t mark set m2 1.8
     list [lsort [.t mark names]] [.t index m1] [.t index m2] [.t index m3]
-} {{current insert l1 m1 m2 m3 next x} 1.2 1.8 2.11}
+} -result {{current insert l1 m1 m2 m3 next x} 1.2 1.8 2.11}
 
-test btree-11.1 {marks and inserts} {
+
+test btree-11.1 {marks and inserts} -body {
     msetup
     .t insert 1.1 abcde
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {1.7 1.7 1.11 1.11 2.0 2.11}
-test btree-11.2 {marks and inserts} {
+} -result {1.7 1.7 1.11 1.11 2.0 2.11}
+test btree-11.2 {marks and inserts} -body {
     msetup
     .t insert 1.2 abcde
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {1.2 1.7 1.11 1.11 2.0 2.11}
-test btree-11.3 {marks and inserts} {
+} -result {1.2 1.7 1.11 1.11 2.0 2.11}
+test btree-11.3 {marks and inserts} -body {
     msetup
     .t insert 1.3 abcde
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {1.2 1.2 1.11 1.11 2.0 2.11}
-test btree-11.4 {marks and inserts} {
+} -result {1.2 1.2 1.11 1.11 2.0 2.11}
+test btree-11.4 {marks and inserts} -body {
     msetup
     .t insert 1.1 ab\n\ncde
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {3.4 3.4 3.8 3.8 4.0 4.11}
-test btree-11.5 {marks and inserts} {
+} -result {3.4 3.4 3.8 3.8 4.0 4.11}
+test btree-11.5 {marks and inserts} -body {
     msetup
     .t insert 1.4 ab\n\ncde
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {1.2 1.2 3.5 3.5 4.0 4.11}
-test btree-11.6 {marks and inserts} {
+} -result {1.2 1.2 3.5 3.5 4.0 4.11}
+test btree-11.6 {marks and inserts} -body {
     msetup
     .t insert 1.7 ab\n\ncde
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {1.2 1.2 1.6 1.6 4.0 4.11}
+} -result {1.2 1.2 1.6 1.6 4.0 4.11}
+
 
-test btree-12.1 {marks and deletes} {
+test btree-12.1 {marks and deletes} -body {
     msetup
     .t delete 1.3 1.5
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {1.2 1.2 1.4 1.4 2.0 2.11}
-test btree-12.2 {marks and deletes} {
+} -result {1.2 1.2 1.4 1.4 2.0 2.11}
+test btree-12.2 {marks and deletes} -body {
     msetup
     .t delete 1.3 1.8
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {1.2 1.2 1.3 1.3 2.0 2.11}
-test btree-12.3 {marks and deletes} {
+} -result {1.2 1.2 1.3 1.3 2.0 2.11}
+test btree-12.3 {marks and deletes} -body {
     msetup
     .t delete 1.2 1.8
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {1.2 1.2 1.2 1.2 2.0 2.11}
-test btree-12.4 {marks and deletes} {
+} -result {1.2 1.2 1.2 1.2 2.0 2.11}
+test btree-12.4 {marks and deletes} -body {
     msetup
     .t delete 1.1 1.8
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {1.1 1.1 1.1 1.1 2.0 2.11}
-test btree-12.5 {marks and deletes} {
+} -result {1.1 1.1 1.1 1.1 2.0 2.11}
+test btree-12.5 {marks and deletes} -body {
     msetup
     .t delete 1.5 3.1
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {1.2 1.2 1.5 1.5 1.5 1.5}
-test btree-12.6 {marks and deletes} {
+} -result {1.2 1.2 1.5 1.5 1.5 1.5}
+test btree-12.6 {marks and deletes} -body {
     msetup
     .t mark set m2 4.5
     .t delete 1.5 4.1
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {1.2 1.2 1.5 1.5 1.9 1.5}
-test btree-12.7 {marks and deletes} {
+} -result {1.2 1.2 1.5 1.5 1.9 1.5}
+test btree-12.7 {marks and deletes} -body {
     msetup
     .t mark set m2 4.5
     .t mark set m3 4.5
     .t mark set m1 4.7
     .t delete 1.5 4.1
     list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
-} {1.2 1.11 1.5 1.5 1.9 1.9}
+} -result {1.2 1.11 1.5 1.5 1.9 1.9}
 
-destroy .t
-text .t
-test btree-13.1 {tag searching} {
+
+test btree-13.1 {tag searching} -setup {
     .t delete 1.0 100000.0
+} -body {
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag next x 2.2 2.1
-} {}
-test btree-13.2 {tag searching} {
+} -result {}
+test btree-13.2 {tag searching} -setup {
     .t delete 1.0 100000.0
+} -body {
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 2.2 2.4
     .t tag next x 2.2 2.3
-} {2.2 2.4}
-test btree-13.3 {tag searching} {
+} -result {2.2 2.4}
+test btree-13.3 {tag searching} -setup {
     .t delete 1.0 100000.0
+} -body {
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 2.2 2.4
     .t tag next x 2.3 2.6
-} {}
-test btree-13.4 {tag searching} {
+} -result {}
+test btree-13.4 {tag searching} -setup {
     .t delete 1.0 100000.0
+} -body {
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 2.5 2.8
     .t tag next x 2.1 2.6
-} {2.5 2.8}
-test btree-13.5 {tag searching} {
+} -result {2.5 2.8}
+test btree-13.5 {tag searching} -setup {
     .t delete 1.0 100000.0
+} -body {
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 2.5 2.8
     .t tag next x 2.1 2.5
-} {}
-test btree-13.6 {tag searching} {
+} -result {}
+test btree-13.6 {tag searching} -setup {
     .t delete 1.0 100000.0
+} -body {
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 2.1 2.4
     .t tag next x 2.5 2.8
-} {}
-test btree-13.7 {tag searching} {
+} -result {}
+test btree-13.7 {tag searching} -setup {
     .t delete 1.0 100000.0
+} -body {
     .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
     .t tag add x 2.5 2.8
     .t tag next x 2.1 2.4
-} {}
-test btree-13.8 {tag searching} {
+} -result {}
+test btree-13.8 {tag searching} -setup {
+    set bigText2 {}
+    for {set i 0} {$i < 200} {incr i} {
+        append bigText2 "Line $i\n"
+    }
+} -body {
     setup
     .t insert 1.2 $bigText2
     .t tag add x 190.3 191.2
     .t tag next x 3.5
-} {190.3 191.2}
+} -result {190.3 191.2}
+destroy .t
+
 
-test btree-14.1 {check tag presence} {
+test btree-14.1 {check tag presence} -setup {
+    destroy .t
+    text .t
+    set bigText2 {}
+    for {set i 0} {$i < 200} {incr i} {
+        append bigText2 "Line $i\n"
+    }
+} -body {
     setup
     .t insert 1.2 $bigText2
     .t tag add x 3.5 3.7
@@ -658,242 +864,371 @@ test btree-14.1 {check tag presence} {
     .t tag add b 7.5
     .t tag add b 140.3
     for {set i 120} {$i < 160} {incr i} {
-	.t tag add c $i.4
+    .t tag add c $i.4
     }
     foreach i {a1 a2 a3 a4 a5 a6 a7 a8 a9 10 a11 a12 a13} {
-	.t tag add $i 122.2
+    .t tag add $i 122.2
     }
     .t tag add x 141.3
     .t tag names 141.1
-} {x y z}
+} -cleanup {
+    destroy .t
+} -result {x y z}
+
 
-test btree-15.1 {rebalance with empty node} {
-    catch {destroy .t}
+test btree-15.1 {rebalance with empty node} -setup {
+    destroy .t
+} -body {
     text .t
     .t debug 1
     .t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17\n18\n19\n20\n21\n22\n23"
     .t delete 6.0 12.0
     .t get 1.0 end
-} "1\n2\n3\n4\n5\n12\n13\n14\n15\n16\n17\n18\n19\n20\n21\n22\n23\n"
+} -cleanup {
+    destroy .t
+} -result "1\n2\n3\n4\n5\n12\n13\n14\n15\n16\n17\n18\n19\n20\n21\n22\n23\n"
 
-proc setupBig {} {
-    .t delete 1.0 end
-    .t tag delete x y
-    .t tag configure x -foreground blue
-    .t tag configure y -underline true
-    # Create a Btree with 2002 lines (2000 + already existing + phantom at end)
-    # This generates a level 3 node with 9 children
-    # Most level 2 nodes cover 216 lines and have 6 children, except the last
-    # level 2 node covers 274 lines and has 7 children.
-    # Most level 1 nodes cover 36 lines and have 6 children, except the
-    # rightmost node has 58 lines and 9 children.
-    # Level 2: 2002 = 8*216 + 274
-    # Level 1: 2002 = 54*36 + 58
-    # Level 0: 2002 = 332*6 + 10
-    for {set i 0} {$i < 2000} {incr i} {
-	append x "Line $i abcd efgh ijkl\n"
-    }
-    .t insert insert $x
-    .t debug 1
-}
 
-test btree-16.1 {add tag does not push root above level 0} {
-    catch {destroy .t}
+test btree-16.1 {add tag does not push root above level 0} -setup {
+    destroy .t
     text .t
+} -body {
     setupBig
+    .t debug 0
     .t tag add x 1.1 1.10
     .t tag add x 5.1 5.10
     .t tag ranges x
-} {1.1 1.10 5.1 5.10}
-test btree-16.2 {add tag pushes root up to level 1 node} {
-    catch {destroy .t}
+} -cleanup {
+    destroy .t
+} -result {1.1 1.10 5.1 5.10}
+test btree-16.2 {add tag pushes root up to level 1 node} -setup {
+    destroy .t
     text .t
-    .t debug 1
+} -body {
     setupBig
     .t tag add x 1.1 1.10
     .t tag add x 8.1 8.10
     .t tag ranges x
-} {1.1 1.10 8.1 8.10}
-test btree-16.3 {add tag pushes root up to level 2 node} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {1.1 1.10 8.1 8.10}
+test btree-16.3 {add tag pushes root up to level 2 node} -setup {
+    destroy .t
+    text .t
+} -body {
+    setupBig
     .t tag add x 8.1 9.10
     .t tag add x 180.1 180.end
     .t tag ranges x
-} {8.1 9.10 180.1 180.23}
-test btree-16.4 {add tag pushes root up to level 3 node} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {8.1 9.10 180.1 180.23}
+test btree-16.4 {add tag pushes root up to level 3 node} -setup {
+    destroy .t
+    text .t
+} -body {
+    setupBig
     .t tag add y 1.1 2000.0
     .t tag add x 1.1 8.10
     .t tag add x 180.end 217.0
     list [.t tag ranges x] [.t tag ranges y]
-} {{1.1 8.10 180.23 217.0} {1.1 2000.0}}
-test btree-16.5 {add tag doesn't push root up} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {{1.1 8.10 180.23 217.0} {1.1 2000.0}}
+test btree-16.5 {add tag doesn't push root up} -setup {
+    destroy .t
+    text .t
+} -body {
+    setupBig
     .t tag add x 1.1 8.10
     .t tag add x 2000.0 2000.3
     .t tag add x 180.end 217.0
     .t tag ranges x
-} {1.1 8.10 180.23 217.0 2000.0 2000.3}
-test btree-16.6 {two node splits at once pushes root up} {
-    .t delete 1.0 end
+} -cleanup {
+    destroy .t
+} -result {1.1 8.10 180.23 217.0 2000.0 2000.3}
+test btree-16.6 {two node splits at once pushes root up} -setup {
+    destroy .t
+    text .t
+} -body {
     for {set i 1} {$i < 10} {incr i} {
-	.t insert end "Line $i\n"
+        .t insert end "Line $i\n"
     }
     .t tag add x 8.0 8.end
     .t tag add y 9.0 end
     set x {}
     for {} {$i < 50} {incr i} {
-	append x "Line $i\n"
+        append x "Line $i\n"
     }
     .t insert end $x y
     list [.t tag ranges x] [.t tag ranges y]
-} {{8.0 8.6} {9.0 51.0}}
+} -cleanup {
+    destroy .t
+} -result {{8.0 8.6} {9.0 51.0}}
 # The following find bugs in the SearchStart procedures
-test btree-16.7 {Partial tag remove from before first range} {
-    .t tag remove x 1.0 end
+test btree-16.7 {Partial tag remove from before first range} -setup {
+    destroy .t
+    text .t
+    for {set i 1} {$i < 10} {incr i} {
+        .t insert end "Line $i\n"
+    }
+} -body {
     .t tag add x 2.0 2.6
     .t tag remove x 1.0 2.0
     .t tag ranges x
-} {2.0 2.6}
-test btree-16.8 {Partial tag remove from before first range} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {2.0 2.6}
+test btree-16.8 {Partial tag remove from before first range} -setup {
+    destroy .t
+    text .t
+    for {set i 1} {$i < 10} {incr i} {
+        .t insert end "Line $i\n"
+    }
+} -body {
     .t tag add x 2.0 2.6
     .t tag remove x 1.0 2.1
     .t tag ranges x
-} {2.1 2.6}
-test btree-16.9 {Partial tag remove from before first range} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {2.1 2.6}
+test btree-16.9 {Partial tag remove from before first range} -setup {
+    destroy .t
+    text .t
+    for {set i 1} {$i < 10} {incr i} {
+        .t insert end "Line $i\n"
+    }
+} -body {
     .t tag add x 2.0 2.6
     .t tag remove x 1.0 2.3
     .t tag ranges x
-} {2.3 2.6}
-test btree-16.10 {Partial tag remove from before first range} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {2.3 2.6}
+test btree-16.10 {Partial tag remove from before first range} -setup {
+    destroy .t
+    text .t
+    for {set i 1} {$i < 10} {incr i} {
+        .t insert end "Line $i\n"
+    }
+} -body {
     .t tag add x 1.0 2.6
     .t tag remove x 1.0 2.5
     .t tag ranges x
-} {2.5 2.6}
-test btree-16.11 {StartSearchBack boundary case} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {2.5 2.6}
+test btree-16.11 {StartSearchBack boundary case} -setup {
+    destroy .t
+    text .t
+    for {set i 1} {$i < 10} {incr i} {
+        .t insert end "Line $i\n"
+    }
+} -body {
     .t tag add x 1.3 1.4
     .t tag prevr x 2.0 1.4
-} {}
-test btree-16.12 {StartSearchBack boundary case} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {}
+test btree-16.12 {StartSearchBack boundary case} -setup {
+    destroy .t
+    text .t
+    for {set i 1} {$i < 10} {incr i} {
+        .t insert end "Line $i\n"
+    }
+} -body {
     .t tag add x 1.3 1.4
     .t tag prevr x 2.0 1.3
-} {1.3 1.4}
-test btree-16.13 {StartSearchBack boundary case} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {1.3 1.4}
+test btree-16.13 {StartSearchBack boundary case} -setup {
+    destroy .t
+    text .t
+    for {set i 1} {$i < 10} {incr i} {
+        .t insert end "Line $i\n"
+    }
+} -body {
     .t tag add x 1.0 1.4
     .t tag prevr x 1.3
-} {1.0 1.4}
+} -cleanup {
+    destroy .t
+} -result {1.0 1.4}
 
 
-test btree-17.1 {remove tag does not push root down} {
-    catch {destroy .t}
+test btree-17.1 {remove tag does not push root down} -setup {
+    destroy .t
     text .t
+} -body {
     .t debug 0
     setupBig
     .t tag add x 1.1 5.10
     .t tag remove x 3.1 5.end
     .t tag ranges x
-} {1.1 3.1}
-test btree-17.2 {remove tag pushes root from level 1 to level 0} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {1.1 3.1}
+test btree-17.2 {remove tag pushes root from level 1 to level 0} -setup {
+    destroy .t
+    text .t
+} -body {
+    setupBig
     .t tag add x 1.1 8.10
     .t tag remove x 3.1 end
     .t tag ranges x
-} {1.1 3.1}
-test btree-17.3 {remove tag pushes root from level 2 to level 1} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {1.1 3.1}
+test btree-17.3 {remove tag pushes root from level 2 to level 1} -setup {
+    destroy .t
+    text .t
+} -body {
+    setupBig
     .t tag add x 1.1 180.10
     .t tag remove x 35.1 end
     .t tag ranges x
-} {1.1 35.1}
-test btree-17.4 {remove tag doesn't change level 2} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {1.1 35.1}
+test btree-17.4 {remove tag doesn't change level 2} -setup {
+    destroy .t
+    text .t
+} -body {
+    setupBig
     .t tag add x 1.1 180.10
     .t tag remove x 35.1 180.0
     .t tag ranges x
-} {1.1 35.1 180.0 180.10}
-test btree-17.5 {remove tag pushes root from level 3 to level 0} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {1.1 35.1 180.0 180.10}
+test btree-17.5 {remove tag pushes root from level 3 to level 0} -setup {
+    destroy .t
+    text .t
+} -body {
+    setupBig
     .t tag add x 1.1 1.10
     .t tag add x 2000.1 2000.10
     .t tag remove x 1.0 2000.0
     .t tag ranges x
-} {2000.1 2000.10}
-test btree-17.6 {text deletion pushes root from level 3 to level 0} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {2000.1 2000.10}
+test btree-17.6 {text deletion pushes root from level 3 to level 0} -setup {
+    destroy .t
+    text .t
+} -body {
+    setupBig
     .t tag add x 1.1 1.10
     .t tag add x 2000.1 2000.10
     .t delete 1.0 "1000.0 lineend +1 char"
     .t tag ranges x
-} {1000.1 1000.10}
+} -cleanup {
+    destroy .t
+} -result {1000.1 1000.10}
 
-catch {destroy .t}
-text .t
-test btree-18.1 {tag search back, no tag} {
+
+test btree-18.1 {tag search back, no tag} -setup {
+    destroy .t
+    text .t
+} -body {
     .t insert 1.0 "Line 1 abcd efgh ijkl\n"
     .t tag prev x 1.1 1.1
-} {}
-test btree-18.2 {tag search back, start at existing range} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {}
+test btree-18.2 {tag search back, start at existing range} -setup {
+    destroy .t
+    text .t
+} -body {
+    .t insert 1.0 "Line 1 abcd efgh ijkl\n"
     .t tag add x 1.1 1.4
     .t tag add x 1.8 1.11
     .t tag add x 1.16
     .t tag prev x 1.1
-} {}
-test btree-18.3 {tag search back, end at existing range} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {}
+test btree-18.3 {tag search back, end at existing range} -setup {
+    destroy .t
+    text .t
+} -body {
+    .t insert 1.0 "Line 1 abcd efgh ijkl\n"
     .t tag add x 1.1 1.4
     .t tag add x 1.8 1.11
     .t tag add x 1.16
     .t tag prev x 1.3 1.1
-} {1.1 1.4}
-test btree-18.4 {tag search back, start within range} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {1.1 1.4}
+test btree-18.4 {tag search back, start within range} -setup {
+    destroy .t
+    text .t
+} -body {
+    .t insert 1.0 "Line 1 abcd efgh ijkl\n"
     .t tag add x 1.1 1.4
     .t tag add x 1.8 1.11
     .t tag add x 1.16
     .t tag prev x 1.10 1.0
-} {1.8 1.11}
-test btree-18.5 {tag search back, start at end of range} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {1.8 1.11}
+test btree-18.5 {tag search back, start at end of range} -setup {
+    destroy .t
+    text .t
+} -body {
+    .t insert 1.0 "Line 1 abcd efgh ijkl\n"
     .t tag add x 1.1 1.4
     .t tag add x 1.8 1.11
     .t tag add x 1.16
     list [.t tag prev x 1.4 1.0] [.t tag prev x 1.11 1.0]
-} {{1.1 1.4} {1.8 1.11}}
-test btree-18.6 {tag search back, start beyond range, same level 0 node} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {{1.1 1.4} {1.8 1.11}}
+test btree-18.6 {tag search back, start beyond range, same level 0 node} -setup {
+    destroy .t
+    text .t
+} -body {
+    .t insert 1.0 "Line 1 abcd efgh ijkl\n"
     .t tag add x 1.1 1.4
     .t tag add x 1.8 1.11
     .t tag add x 1.16
     .t tag prev x 3.0
-} {1.16 1.17}
-test btree-18.7 {tag search back, outside any range} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {1.16 1.17}
+test btree-18.7 {tag search back, outside any range} -setup {
+    destroy .t
+    text .t
+} -body {
+    .t insert 1.0 "Line 1 abcd efgh ijkl\n"
     .t tag add x 1.1 1.4
     .t tag add x 1.16
     .t tag prev x 1.8 1.5
-} {}
-test btree-18.8 {tag search back, start at start of node boundary} {
+} -cleanup {
+    destroy .t
+} -result {}
+test btree-18.8 {tag search back, start at start of node boundary} -setup {
+    destroy .t
+    text .t
+} -body {
     setupBig
-    .t tag remove x 1.0 end
     .t tag add x 2.5 2.8
     .t tag prev x 19.0
-} {2.5 2.8}
-test btree-18.9 {tag search back, large complex btree spans} {
-    .t tag remove x 1.0 end
+} -cleanup {
+    destroy .t
+} -result {2.5 2.8}
+test btree-18.9 {tag search back, large complex btree spans} -setup {
+    destroy .t
+    text .t
+} -body {
+    setupBig
     .t tag add x 1.3 1.end
     .t tag add x 200.0 220.0
     .t tag add x 500.0 520.0
     list [.t tag prev x end] [.t tag prev x 433.0]
-} {{500.0 520.0} {200.0 220.0}}
-
-destroy .t
+} -cleanup {
+    destroy .t
+} -result {{500.0 520.0} {200.0 220.0}}
 
 # cleanup
 cleanupTests
diff --git a/tests/textImage.test b/tests/textImage.test
index d78472a..e0fc05b 100644
--- a/tests/textImage.test
+++ b/tests/textImage.test
@@ -7,351 +7,446 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textImage.test,v 1.11 2008/07/23 23:24:25 nijtmans Exp $
+# RCS: @(#) $Id: textImage.test,v 1.12 2008/08/28 08:52:06 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
 # One time setup.  Create a font to insure the tests are font metric invariant.
-
-catch {destroy .t}
+destroy .t
 font create test_font -family courier -size 14
 text .t -font test_font
 destroy .t
 
-test textImage-1.1 {basic argument checking} {
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image} msg] $msg
-} {1 {wrong # args: should be ".t image option ?arg ...?"}}
-
-test textImage-1.2 {basic argument checking} {
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image c} msg] $msg
-} {1 {ambiguous option "c": must be cget, configure, create, or names}}
-
-test textImage-1.3 {cget argument checking} {
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image cget} msg] $msg
-} {1 {wrong # args: should be ".t image cget index option"}}
-
-test textImage-1.4 {cget argument checking} {
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image cget blurf -flurp} msg] $msg
-} {1 {bad text index "blurf"}}
-
-test textImage-1.5 {cget argument checking} {
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image cget 1.1 -flurp} msg] $msg
-} {1 {no embedded image at index "1.1"}}
-
-test textImage-1.6 {configure argument checking} {
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image configure } msg] $msg
-} {1 {wrong # args: should be ".t image configure index ?-option value ...?"}}
-
-test textImage-1.7 {configure argument checking} {
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image configure blurf } msg] $msg
-} {1 {bad text index "blurf"}}
-
-test textImage-1.8 {configure argument checking} {
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image configure 1.1 } msg] $msg
-} {1 {no embedded image at index "1.1"}}
-
-test textImage-1.9 {create argument checking} {
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image create} msg] $msg
-} {1 {wrong # args: should be ".t image create index ?-option value ...?"}}
-
-test textImage-1.10 {create argument checking} {
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image create blurf } msg] $msg
-} {1 {bad text index "blurf"}}
-
-test textImage-1.11 {basic argument checking} {
-	catch {
-	    image create photo small -width 5 -height 5
-	    small put red -to 0 0 4 4
-	}
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image create 1000.1000 -image small} msg] $msg
-} {0 small}
-
-test textImage-1.12 {names argument checking} {
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image names dates places} msg] $msg
-} {1 {wrong # args: should be ".t image names"}}
-
-
-test textImage-1.13 {names argument checking} {
-	catch {
-	    image create photo small -width 5 -height 5
-	    small put red -to 0 0 4 4
-	}
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	set result ""
-	lappend result [.t image names]
-	.t image create insert -image small
-	lappend result [.t image names]
-	.t image create insert -image small
-	lappend result [.t image names]
-	.t image create insert -image small -name little
-	lappend result [.t image names]
-} {{} small {small#1 small} {small#1 small little}}
-
-test textImage-1.14 {basic argument checking} {
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image huh} msg] $msg
-} {1 {bad option "huh": must be cget, configure, create, or names}}
-
-test textImage-1.15 {align argument checking} {
-	catch {
-	    image create photo small -width 5 -height 5
-	    small put red -to 0 0 4 4
-	}
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	list [catch {.t image create end -image small -align wrong} msg] $msg
-} {1 {bad align "wrong": must be baseline, bottom, center, or top}}
-
-test textImage-1.16 {configure} {
-	catch {
-	    image create photo small -width 5 -height 5
-	    small put red -to 0 0 4 4
-	}
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	.t image create end -image small
-	.t image configure small
-} {{-align {} {} center center} {-padx {} {} 0 0} {-pady {} {} 0 0} {-image {} {} {} small} {-name {} {} {} {}}}
-
-test textImage-1.17 {basic cget options} {
-	catch {
-	    image create photo small -width 5 -height 5
-	    small put red -to 0 0 4 4
-	}
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	.t image create end -image small
-	set result ""
-	foreach i {align padx pady image name} {
-	    lappend result $i:[.t image cget small -$i]
-	} 
-	set result
-} {align:center padx:0 pady:0 image:small name:}
-
-test textImage-1.18 {basic configure options} {
-	catch {
-	    image create photo small -width 5 -height 5
-	    small put red -to 0 0 4 4
-	    image create photo large -width 50 -height 50
-	    large put green -to 0 0 50 50
-	}
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	.t image create end -image small
-	set result ""
-	foreach {option value}  {align top padx 5 pady 7 image large name none} {
-	    .t image configure small -$option $value
-	} 
-	update
-	.t image configure small
-} {{-align {} {} center top} {-padx {} {} 0 5} {-pady {} {} 0 7} {-image {} {} {} large} {-name {} {} {} none}}
-
-test textImage-1.19 {basic image naming} {
-	catch {
-	    image create photo small -width 5 -height 5
-	    small put red -to 0 0 4 4
-	}
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	.t image create end -image small
-	.t image create end -image small -name small
-	.t image create end -image small -name small#6342
-	.t image create end -image small -name small
-	lsort [.t image names]
-} {small small#1 small#6342 small#6343}
-
-test textImage-2.1 {debug} {
-	catch {
-	    image create photo small -width 5 -height 5
-	    small put red -to 0 0 4 4
-	}
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	.t debug 1
-	.t insert end front
-	.t image create end -image small
-	.t insert end back
-	.t delete small
-	.t image names
-	.t debug 0
-} {}
-
-test textImage-3.1 {image change propagation} {
-	catch {
-	    image create photo vary -width 5 -height 5
-	    small put red -to 0 0 4 4
-	}
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	.t image create end -image vary -align top
-	update
-	set result ""
-	lappend result base:[.t bbox vary]
-	foreach i {10 20 40} {
-	    vary configure -width $i -height $i
-	    update
-	    lappend result $i:[.t bbox vary]
-	} 
-	set result
-} {{base:0 0 5 5} {10:0 0 10 10} {20:0 0 20 20} {40:0 0 40 40}}
-
-test textImage-3.2 {delayed image management} {
-	catch {
-	    image create photo small -width 5 -height 5
-	    small put red -to 0 0 4 4
-	}
-	catch {destroy .t}
-	text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
-	pack .t
-	.t image create end -name test
-	update
-	set result ""
-	lappend result [.t bbox test]
-	.t image configure test -image small -align top
-	update
-	lappend result [.t bbox test]
-} {{} {0 0 5 5}}
+test textImage-1.1 {basic argument checking} -setup {
+    destroy .t
+} -body {
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {wrong # args: should be ".t image option ?arg ...?"}
+
+test textImage-1.2 {basic argument checking} -setup {
+    destroy .t
+} -body {
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image c
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {ambiguous option "c": must be cget, configure, create, or names}
+
+test textImage-1.3 {cget argument checking} -setup {
+    destroy .t
+} -body {
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image cget
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {wrong # args: should be ".t image cget index option"}
+
+test textImage-1.4 {cget argument checking} -setup {
+    destroy .t
+} -body {
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image cget blurf -flurp
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {bad text index "blurf"}
+
+test textImage-1.5 {cget argument checking} -setup {
+    destroy .t
+} -body {
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image cget 1.1 -flurp
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {no embedded image at index "1.1"}
+
+test textImage-1.6 {configure argument checking} -setup {
+    destroy .t
+} -body {
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image configure 
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {wrong # args: should be ".t image configure index ?-option value ...?"}
+
+test textImage-1.7 {configure argument checking} -setup {
+    destroy .t
+} -body {
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image configure blurf 
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {bad text index "blurf"}
+
+test textImage-1.8 {configure argument checking} -setup {
+    destroy .t
+} -body {
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image configure 1.1 
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {no embedded image at index "1.1"}
+
+test textImage-1.9 {create argument checking} -setup {
+    destroy .t
+} -body {
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image create
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {wrong # args: should be ".t image create index ?-option value ...?"}
+
+test textImage-1.10 {create argument checking} -setup {
+    destroy .t
+} -body {
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image create blurf 
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {bad text index "blurf"}
+
+test textImage-1.11 {basic argument checking} -setup {
+    destroy .t
+} -body {
+    catch {
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+    }
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image create 1000.1000 -image small
+} -cleanup {
+    destroy .t
+    image delete small
+} -returnCodes ok -result {small}
+
+test textImage-1.12 {names argument checking} -setup {
+    destroy .t
+} -body {
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image names dates places
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {wrong # args: should be ".t image names"}
+
+
+test textImage-1.13 {names argument checking} -setup {
+    destroy .t
+    set result ""
+} -body {
+    catch {
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+    }
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    lappend result [.t image names]
+    .t image create insert -image small
+    lappend result [.t image names]
+    .t image create insert -image small
+    lappend result [.t image names]
+    .t image create insert -image small -name little
+    lappend result [.t image names]
+} -cleanup {
+    destroy .t
+    image delete small
+} -result {{} small {small#1 small} {small#1 small little}}
+
+test textImage-1.14 {basic argument checking} -setup {
+    destroy .t
+} -body {
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image huh
+} -cleanup {
+    destroy .t
+} -returnCodes error -result {bad option "huh": must be cget, configure, create, or names}
+
+test textImage-1.15 {align argument checking} -setup {
+    destroy .t
+} -body {
+    catch {
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+    }
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image create end -image small -align wrong
+} -cleanup {
+    destroy .t
+    image delete small
+} -returnCodes error -result {bad align "wrong": must be baseline, bottom, center, or top}
+
+test textImage-1.16 {configure} -setup {
+    destroy .t
+} -body {
+    catch {
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+    }
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image create end -image small
+    .t image configure small
+} -cleanup {
+    destroy .t
+    image delete small
+} -result {{-align {} {} center center} {-padx {} {} 0 0} {-pady {} {} 0 0} {-image {} {} {} small} {-name {} {} {} {}}}
+
+test textImage-1.17 {basic cget options} -setup {
+    destroy .t
+    set result ""
+} -body {
+    catch {
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+    }
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image create end -image small
+    foreach i {align padx pady image name} {
+        lappend result $i:[.t image cget small -$i]
+    } 
+    return $result
+} -cleanup {
+    destroy .t
+    image delete small
+} -result {align:center padx:0 pady:0 image:small name:}
+
+test textImage-1.18 {basic configure options} -setup {
+    destroy .t
+    set result ""
+} -body {
+    catch {
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+        image create photo large -width 50 -height 50
+        large put green -to 0 0 50 50
+    }
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image create end -image small
+    foreach {option value}  {align top padx 5 pady 7 image large name none} {
+        .t image configure small -$option $value
+    } 
+    update
+    .t image configure small
+} -cleanup {
+    destroy .t
+    image delete small large
+} -result {{-align {} {} center top} {-padx {} {} 0 5} {-pady {} {} 0 7} {-image {} {} {} large} {-name {} {} {} none}}
+
+test textImage-1.19 {basic image naming} -setup {
+    destroy .t
+} -body {
+    catch {
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+    }
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image create end -image small
+    .t image create end -image small -name small
+    .t image create end -image small -name small#6342
+    .t image create end -image small -name small
+    lsort [.t image names]
+} -cleanup {
+    destroy .t
+    image delete small
+} -result {small small#1 small#6342 small#6343}
+
+test textImage-2.1 {debug} -setup {
+    destroy .t
+} -body {
+    catch {
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+    }
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t debug 1
+    .t insert end front
+    .t image create end -image small
+    .t insert end back
+    .t delete small
+    .t image names
+    .t debug 0
+} -cleanup {
+    destroy .t
+    image delete small
+} -result {}
+
+
+test textImage-3.1 {image change propagation} -setup {
+    destroy .t
+    set result ""
+} -body {
+    catch {
+        image create photo vary -width 5 -height 5
+        vary put red -to 0 0 4 4
+    }
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image create end -image vary -align top
+    update
+    lappend result base:[.t bbox vary]
+    foreach i {10 20 40} {
+        vary configure -width $i -height $i
+        update
+        lappend result $i:[.t bbox vary]
+    } 
+    return $result
+} -cleanup {
+    destroy .t
+    image delete vary
+} -result {{base:0 0 5 5} {10:0 0 10 10} {20:0 0 20 20} {40:0 0 40 40}}
+
+# Fails in some environments (both in Linux and winXP)
+test textImage-3.2 {delayed image management} -setup {
+    destroy .t
+    set result ""
+} -body {
+    catch {
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+    }
+    text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+    pack .t
+    .t image create end -name test
+    update
+    lappend result [.t bbox test]
+    .t image configure test -image small -align top
+    update
+    lappend result [.t bbox test]
+} -cleanup {
+    destroy .t
+    image delete small
+} -result {{} {0 0 5 5}}
+
 
 # some temporary random tests
 
-test textImage-4.1 {alignment checking - except baseline} {
+test textImage-4.1 {alignment checking - except baseline} -setup {
+    destroy .t
+    set result ""
+} -body {
     catch {
-	image create photo small -width 5 -height 5
-	small put red -to 0 0 4 4
-	image create photo large -width 50 -height 50
-	large put green -to 0 0 50 50
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+        image create photo large -width 50 -height 50
+        large put green -to 0 0 50 50
     }
-    catch {destroy .t}
     text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
     pack .t
     .t image create end -image large
     .t image create end -image small
     .t insert end test
     update
-    set result ""
     lappend result default:[.t bbox small]
     foreach i {top bottom center} {
-	.t image configure small -align $i
-	update
-	lappend result [.t image cget small -align]:[.t bbox small]
+        .t image configure small -align $i
+        update
+        lappend result [.t image cget small -align]:[.t bbox small]
     }
-    set result
-} {{default:50 22 5 5} {top:50 0 5 5} {bottom:50 45 5 5} {center:50 22 5 5}}
-
-test textImage-4.2 {alignment checking - baseline} {
+    return $result
+} -cleanup {
+    destroy .t
+    image delete small large
+} -result {{default:50 22 5 5} {top:50 0 5 5} {bottom:50 45 5 5} {center:50 22 5 5}}
+
+test textImage-4.2 {alignment checking - baseline} -setup {
+    destroy .t
+    set result ""
+} -body {
     catch {
-	image create photo small -width 5 -height 5
-	small put red -to 0 0 4 4
-	image create photo large -width 50 -height 50
-	large put green -to 0 0 50 50
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+        image create photo large -width 50 -height 50
+        large put green -to 0 0 50 50
     }
-    catch {destroy .t}
     font create test_font2 -size 5
     text .t -font test_font2 -bd 0 -highlightthickness 0 -padx 0 -pady 0
     pack .t
     .t image create end -image large
     .t image create end -image small -align baseline
     .t insert end test
-    set result ""
     # Sizes larger than 25 can be too big and lead to a negative 'norm',
     # at least on Windows XP with certain settings.
     foreach size {10 15 20 25} {
-	font configure test_font2 -size $size
-	array set Metrics [font metrics test_font2]
-	update
-	foreach {x y w h} [.t bbox small] {}
-	set norm [expr {
-	    (([image height large] - $Metrics(-linespace))/2
-	    + $Metrics(-ascent) - [image height small] - $y)
-	 }]
-        lappend result "$size $norm"
+    font configure test_font2 -size $size
+    array set Metrics [font metrics test_font2]
+    update
+    foreach {x y w h} [.t bbox small] {}
+    set norm [expr {
+            (([image height large] - $Metrics(-linespace))/2
+            + $Metrics(-ascent) - [image height small] - $y)
+        }]
+            lappend result "$size $norm"
     }
+    return $result
+} -cleanup {
+    destroy .t
+    image delete small large
     font delete test_font2
     unset Metrics
-    set result
-} {{10 0} {15 0} {20 0} {25 0}}
+} -result {{10 0} {15 0} {20 0} {25 0}}
 
-test textImage-4.3 {alignment and padding checking} {fonts} {
+test textImage-4.3 {alignment and padding checking} -constraints {
+    fonts
+} -setup {
+    destroy .t
+    set result ""
+} -body {
     catch {
-	image create photo small -width 5 -height 5
-	small put red -to 0 0 4 4
-	image create photo large -width 50 -height 50
-	large put green -to 0 0 50 50
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+        image create photo large -width 50 -height 50
+        large put green -to 0 0 50 50
     }
-    catch {destroy .t}
     text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
     pack .t
     .t image create end -image large
     .t image create end -image small -padx 5 -pady 10
     .t insert end test
     update
-    set result ""
     lappend result default:[.t bbox small]
     foreach i {top bottom center baseline} {
-	.t image configure small -align $i
-	update
-	lappend result $i:[.t bbox small]
+        .t image configure small -align $i
+        update
+        lappend result $i:[.t bbox small]
     }
-    set result
-} {{default:55 22 5 5} {top:55 10 5 5} {bottom:55 35 5 5} {center:55 22 5 5} {baseline:55 22 5 5}}
+    return $result
+} -cleanup {
+    destroy .t
+    image delete small large
+} -result {{default:55 22 5 5} {top:55 10 5 5} {bottom:55 35 5 5} {center:55 22 5 5} {baseline:55 22 5 5}}
 
-test textImage-5.0 {peer widget images} {
+
+test textImage-5.1 {peer widget images} -setup {
+    destroy .t .tt
+} -body {
     catch {
-	image create photo small -width 5 -height 5
-	small put red -to 0 0 4 4
-	image create photo large -width 50 -height 50
-	large put green -to 0 0 50 50
+        image create photo small -width 5 -height 5
+        small put red -to 0 0 4 4
+        image create photo large -width 50 -height 50
+        large put green -to 0 0 50 50
     }
-    catch {destroy .t .tt}
     pack [text .t]
     toplevel .tt
     pack [.t peer create .tt.t]
@@ -360,13 +455,18 @@ test textImage-5.0 {peer widget images} {
     .t insert end test
     update
     destroy .t .tt
-} {}
+} -cleanup {
+    image delete small large
+} -result {}
 
 # cleanup
-catch {destroy .t}
+destroy .t
 foreach image [image names] {image delete $image}
 font delete test_font
 
 # cleanup
 cleanupTests
 return
+
+
+
diff --git a/tests/textMark.test b/tests/textMark.test
index d08b037..2942cba 100644
--- a/tests/textMark.test
+++ b/tests/textMark.test
@@ -6,22 +6,34 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textMark.test,v 1.10 2008/07/23 23:24:24 nijtmans Exp $
+# RCS: @(#) $Id: textMark.test,v 1.11 2008/08/28 08:52:06 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
-catch {destroy .t}
+
+destroy .t
 text .t -width 20 -height 10
-testConstraint haveCourier12 [expr {[catch {
-    .t configure -font {Courier 12}
-}] == 0}]
 pack append . .t {top expand fill}
 update
 .t debug on
 wm geometry . {}
+entry .t.e
+
+.t insert 1.0 "Line 1
+abcdefghijklm
+12345
+Line 4
+bOy GIrl .#@? x_yz
+!@#$%
+Line 7"
   
+testConstraint haveCourier12 [expr {[catch {
+    .t configure -font {Courier 12}
+}] == 0}]
+
 # The statements below reset the main window;  it's needed if the window
 # manager is mwm to make mwm forget about a previous minimum size setting.
 
@@ -30,195 +42,298 @@ wm minsize . 1 1
 wm positionfrom . user
 wm deiconify .
 
-entry .t.e
-.t insert 1.0 "Line 1
-abcdefghijklm
-12345
-Line 4
-bOy GIrl .#@? x_yz
-!@#$%
-Line 7"
 
-test textMark-1.1 {TkTextMarkCmd - missing option} haveCourier12 {
-    list [catch {.t mark} msg] $msg
-} {1 {wrong # args: should be ".t mark option ?arg ...?"}}
-test textMark-1.2 {TkTextMarkCmd - bogus option} haveCourier12 {
-    list [catch {.t mark gorp} msg] $msg
-} {1 {bad mark option "gorp": must be gravity, names, next, previous, set, or unset}}
-test textMark-1.3 {TkTextMarkCmd - "gravity" option} haveCourier12 {
-    list [catch {.t mark gravity foo} msg] $msg
-} {1 {there is no mark named "foo"}}
-test textMark-1.4 {TkTextMarkCmd - "gravity" option} haveCourier12 {
-    .t mark unset x
+test textMark-1.1 {TkTextMarkCmd - missing option} -constraints {
+	haveCourier12 
+} -body {
+    .t mark
+} -returnCodes error -result {wrong # args: should be ".t mark option ?arg ...?"}
+test textMark-1.2 {TkTextMarkCmd - bogus option} -constraints {
+	haveCourier12 
+} -body {
+    .t mark gorp
+} -returnCodes error -result {bad mark option "gorp": must be gravity, names, next, previous, set, or unset}
+test textMark-1.3 {TkTextMarkCmd - "gravity" option} -constraints {
+	haveCourier12 
+} -body {
+    .t mark gravity foo
+} -returnCodes error -result {there is no mark named "foo"}
+test textMark-1.4 {TkTextMarkCmd - "gravity" option} -constraints {
+	haveCourier12 
+} -body {
     .t mark set x 1.3
     .t insert 1.3 x
     list [.t mark gravity x] [.t index x]
-} {right 1.4}
-test textMark-1.5 {TkTextMarkCmd - "gravity" option} haveCourier12 {
-    .t mark unset x
+} -result {right 1.4}
+test textMark-1.5 {TkTextMarkCmd - "gravity" option} -constraints {
+	haveCourier12 
+} -body {
     .t mark set x 1.3
     .t mark g x left
     .t insert 1.3 x
     list [.t mark gravity x] [.t index x]
-} {left 1.3}
-test textMark-1.6 {TkTextMarkCmd - "gravity" option} haveCourier12 {
-    .t mark unset x
+} -result {left 1.3}
+test textMark-1.6 {TkTextMarkCmd - "gravity" option} -constraints {
+	haveCourier12 
+} -body {
     .t mark set x 1.3
     .t mark gravity x right
     .t insert 1.3 x
     list [.t mark gravity x] [.t index x]
-} {right 1.4}
-test textMark-1.7 {TkTextMarkCmd - "gravity" option} haveCourier12 {
-    list [catch {.t mark gravity x gorp} msg] $msg
-} {1 {bad mark gravity "gorp": must be left or right}}
-test textMark-1.8 {TkTextMarkCmd - "gravity" option} haveCourier12 {
-    list [catch {.t mark gravity} msg] $msg
-} {1 {wrong # args: should be ".t mark gravity markName ?gravity?"}}
-
-test textMark-2.1 {TkTextMarkCmd - "names" option} haveCourier12 {
-    list [catch {.t mark names 2} msg] $msg
-} {1 {wrong # args: should be ".t mark names"}}
-.t mark unset x
-test textMark-2.2 {TkTextMarkCmd - "names" option} haveCourier12 {
+} -result {right 1.4}
+test textMark-1.7 {TkTextMarkCmd - "gravity" option} -constraints {
+	haveCourier12 
+} -body {
+    .t mark set x 1.3
+    .t mark gravity x gorp
+} -returnCodes error -result {bad mark gravity "gorp": must be left or right}
+test textMark-1.8 {TkTextMarkCmd - "gravity" option} -constraints {
+	haveCourier12 
+} -body {
+    .t mark gravity
+} -returnCodes error -result {wrong # args: should be ".t mark gravity markName ?gravity?"}
+
+
+test textMark-2.1 {TkTextMarkCmd - "names" option} -constraints {
+	haveCourier12 
+} -body {
+    .t mark names 2
+} -returnCodes error -result {wrong # args: should be ".t mark names"}
+test textMark-2.2 {TkTextMarkCmd - "names" option} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     lsort [.t mark na]
-} {current insert}
-test textMark-2.3 {TkTextMarkCmd - "names" option} haveCourier12 {
+} -result {current insert}
+test textMark-2.3 {TkTextMarkCmd - "names" option} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     .t mark set a 1.1
     .t mark set "b c" 2.3
     lsort [.t mark names]
-} {a {b c} current insert}
-
-test textMark-3.1 {TkTextMarkCmd - "set" option} haveCourier12 {
-    list [catch {.t mark set a} msg] $msg
-} {1 {wrong # args: should be ".t mark set markName index"}}
-test textMark-3.2 {TkTextMarkCmd - "set" option} haveCourier12 {
-    list [catch {.t mark s a b c} msg] $msg
-} {1 {wrong # args: should be ".t mark set markName index"}}
-test textMark-3.3 {TkTextMarkCmd - "set" option} haveCourier12 {
-    list [catch {.t mark set a @x} msg] $msg
-} {1 {bad text index "@x"}}
-test textMark-3.4 {TkTextMarkCmd - "set" option} haveCourier12 {
+} -result {a {b c} current insert}
+
+
+test textMark-3.1 {TkTextMarkCmd - "set" option} -constraints {
+	haveCourier12 
+} -body {
+    .t mark set a
+} -returnCodes error -result {wrong # args: should be ".t mark set markName index"}
+test textMark-3.2 {TkTextMarkCmd - "set" option} -constraints {
+	haveCourier12 
+} -body {
+    .t mark s a b c
+} -returnCodes error -result {wrong # args: should be ".t mark set markName index"}
+test textMark-3.3 {TkTextMarkCmd - "set" option} -constraints {
+	haveCourier12 
+} -body {
+    .t mark set a @x
+} -returnCodes error -result {bad text index "@x"}
+test textMark-3.4 {TkTextMarkCmd - "set" option} -constraints {
+	haveCourier12 
+} -body {
     .t mark set a 1.2
     .t index a
-} 1.2
-test textMark-3.5 {TkTextMarkCmd - "set" option} haveCourier12 {
+} -result 1.2
+test textMark-3.5 {TkTextMarkCmd - "set" option} -constraints {
+	haveCourier12 
+} -body {
     .t mark set a end
     .t index a
-} {8.0}
+} -result {8.0}
 
-test textMark-4.1 {TkTextMarkCmd - "unset" option} haveCourier12 {
-    list [catch {.t mark unset} msg] $msg
-} {0 {}}
-test textMark-4.2 {TkTextMarkCmd - "unset" option} haveCourier12 {
+
+test textMark-4.1 {TkTextMarkCmd - "unset" option} -constraints {
+	haveCourier12 
+} -body {
+    .t mark unset
+} -returnCodes ok -result {}
+test textMark-4.2 {TkTextMarkCmd - "unset" option} -constraints {
+	haveCourier12 
+} -body {
     .t mark set a 1.2
     .t mark set b 2.3
     .t mark unset a b
-        list [catch {.t index a} msg] $msg [catch {.t index b} msg2] $msg2
-} {1 {bad text index "a"} 1 {bad text index "b"}}
-test textMark-4.3 {TkTextMarkCmd - "unset" option} haveCourier12 {
+    .t index a
+} -returnCodes error -result {bad text index "a"}
+test textMark-4.2 {TkTextMarkCmd - "unset" option} -constraints {
+    haveCourier12 
+} -body {
+    .t mark set a 1.2
+    .t mark set b 2.3
+    .t mark unset a b
+    .t index b
+} -returnCodes error -result {bad text index "b"}
+test textMark-4.3 {TkTextMarkCmd - "unset" option} -constraints {
+	haveCourier12 
+} -body {
     .t mark set a 1.2
     .t mark set b 2.3
     .t mark set 49ers 3.1
     eval .t mark unset [.t mark names]
     lsort [.t mark names]
-} {current insert}
+} -result {current insert}
+
+
+test textMark-5.1 {TkTextMarkCmd - miscellaneous} -constraints {
+	haveCourier12 
+} -body {
+    .t mark
+} -returnCodes error -result {wrong # args: should be ".t mark option ?arg ...?"}
+test textMark-5.2 {TkTextMarkCmd - miscellaneous} -constraints {
+	haveCourier12 
+} -body {
+    .t mark foo
+} -returnCodes error -result {bad mark option "foo": must be gravity, names, next, previous, set, or unset}
 
-test textMark-5.1 {TkTextMarkCmd - miscellaneous} haveCourier12 {
-    list [catch {.t mark} msg] $msg
-} {1 {wrong # args: should be ".t mark option ?arg ...?"}}
-test textMark-5.2 {TkTextMarkCmd - miscellaneous} haveCourier12 {
-    list [catch {.t mark foo} msg] $msg
-} {1 {bad mark option "foo": must be gravity, names, next, previous, set, or unset}}
 
-test textMark-6.1 {TkTextMarkSegToIndex} haveCourier12 {
+test textMark-6.1 {TkTextMarkSegToIndex} -constraints haveCourier12 -body {
     .t mark set a 1.2
     .t mark set b 1.2
     .t mark set c 1.2
     .t mark set d 1.4
     list [.t index a] [.t index b] [.t index c ] [.t index d]
-} {1.2 1.2 1.2 1.4}
-
-catch {eval {.t mark unset} [.t mark names]}
-test textMark-7.1 {MarkFindNext - invalid mark name} haveCourier12 {
-    catch {.t mark next bogus} x
-    set x
-} {bad text index "bogus"}
-test textMark-7.2 {MarkFindNext - marks at same location} haveCourier12 {
+} -result {1.2 1.2 1.2 1.4}
+
+
+test textMark-7.1 {MarkFindNext - invalid mark name} -constraints {
+	haveCourier12 
+} -body {
+    .t mark next bogus
+} -returnCodes error -result {bad text index "bogus"}
+test textMark-7.2 {MarkFindNext - marks at same location} -constraints {
+	haveCourier12 
+} -body {
     .t mark set insert 2.0
     .t mark set current 2.0
     .t mark next current
-} {insert}
-test textMark-7.3 {MarkFindNext - numerical starting mark} haveCourier12 {
+} -result {insert}
+test textMark-7.3 {MarkFindNext - numerical starting mark} -constraints {
+	haveCourier12 
+} -body {
     .t mark set current 1.0
     .t mark set insert 1.0
     .t mark next 1.0
-} {insert}
-test textMark-7.4 {MarkFindNext - mark on the same line} haveCourier12 {
+} -result {insert}
+test textMark-7.4 {MarkFindNext - mark on the same line} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     .t mark set current 1.0
     .t mark set insert 1.1
     .t mark next current
-} {insert}
-test textMark-7.5 {MarkFindNext - mark on the next line} haveCourier12 {
+} -result {insert}
+test textMark-7.5 {MarkFindNext - mark on the next line} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     .t mark set current 1.end
     .t mark set insert 2.0
     .t mark next current
-} {insert}
-test textMark-7.6 {MarkFindNext - mark far away} haveCourier12 {
+} -result {insert}
+test textMark-7.6 {MarkFindNext - mark far away} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     .t mark set current 1.2
     .t mark set insert 7.0
     .t mark next current
-} {insert}
-test textMark-7.7 {MarkFindNext - mark on top of end} haveCourier12 {
+} -result {insert}
+test textMark-7.7 {MarkFindNext - mark on top of end} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     .t mark set current end
     .t mark next end
-} {current}
-test textMark-7.8 {MarkFindNext - no next mark} haveCourier12 {
+} -result {current}
+test textMark-7.8 {MarkFindNext - no next mark} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     .t mark set current 1.0
     .t mark set insert 3.0
     .t mark next insert
-} {}
-test textMark-8.1 {MarkFindPrev - invalid mark name} haveCourier12 {
-    catch {.t mark prev bogus} x
-    set x
-} {bad text index "bogus"}
-test textMark-8.2 {MarkFindPrev - marks at same location} haveCourier12 {
+} -result {}
+
+
+test textMark-8.1 {MarkFindPrev - invalid mark name} -constraints {
+	haveCourier12 
+} -body {
+    .t mark prev bogus
+} -returnCodes error -result {bad text index "bogus"}
+test textMark-8.2 {MarkFindPrev - marks at same location} -constraints {
+	haveCourier12 
+} -body {
     .t mark set insert 2.0
     .t mark set current 2.0
     .t mark prev insert
-} {current}
-test textMark-8.3 {MarkFindPrev - numerical starting mark} haveCourier12 {
+} -result {current}
+test textMark-8.3 {MarkFindPrev - numerical starting mark} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     .t mark set current 1.0
     .t mark set insert 1.0
     .t mark prev 1.1
-} {current}
-test textMark-8.4 {MarkFindPrev - mark on the same line} haveCourier12 {
+} -result {current}
+test textMark-8.4 {MarkFindPrev - mark on the same line} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     .t mark set current 1.0
     .t mark set insert 1.1
     .t mark prev insert
-} {current}
-test textMark-8.5 {MarkFindPrev - mark on the previous line} haveCourier12 {
+} -result {current}
+test textMark-8.5 {MarkFindPrev - mark on the previous line} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     .t mark set current 1.end
     .t mark set insert 2.0
     .t mark prev insert
-} {current}
-test textMark-8.6 {MarkFindPrev - mark far away} haveCourier12 {
+} -result {current}
+test textMark-8.6 {MarkFindPrev - mark far away} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     .t mark set current 1.2
     .t mark set insert 7.0
     .t mark prev insert
-} {current}
-test textMark-8.7 {MarkFindPrev - mark on top of end} haveCourier12 {
+} -result {current}
+test textMark-8.7 {MarkFindPrev - mark on top of end} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     .t mark set insert 3.0
     .t mark set current end
     .t mark prev end
-} {insert}
-test textMark-8.8 {MarkFindPrev - no previous mark} haveCourier12 {
+} -result {insert}
+test textMark-8.8 {MarkFindPrev - no previous mark} -constraints {
+	haveCourier12 
+} -setup {
+    .t mark unset {*}[.t mark names]
+} -body {
     .t mark set current 1.0
     .t mark set insert 3.0
     .t mark prev current
-} {}
+} -result {}
 
-catch {destroy .t}
+destroy .t
 
 # cleanup
 cleanupTests
 return
+
diff --git a/tests/textTag.test b/tests/textTag.test
index fa950fc..bbda6e4 100644
--- a/tests/textTag.test
+++ b/tests/textTag.test
@@ -6,21 +6,23 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textTag.test,v 1.13 2008/07/23 23:24:26 nijtmans Exp $
+# RCS: @(#) $Id: textTag.test,v 1.14 2008/08/28 08:52:06 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
-namespace import -force tcltest::test
 
-catch {destroy .t}
+destroy .t
 text .t -width 20 -height 10
 testConstraint haveCourier12 [expr {[catch {
     .t configure -font {Courier 12}
 }] == 0}]
+
 pack append . .t {top expand fill}
 update
 .t debug on
+
 wm geometry . {}
 set bigFont {Helvetica 24}
   
@@ -32,9 +34,6 @@ wm minsize . 1 1
 wm positionfrom . user
 wm deiconify .
 
-entry .t.e
-.t.e insert 0 "Text"
-
 .t insert 1.0 "Line 1
 abcdefghijklm
 12345
@@ -44,539 +43,1289 @@ bOy GIrl .#@? x_yz
 Line 7"
 
 
-set i 1
-foreach test {
-    {-background #012345 #012345 non-existent
-	    {unknown color name "non-existent"}}
-    {-bgstipple gray50 gray50 badStipple
-	    {bitmap "badStipple" not defined}}
-    {-borderwidth 2 2 46q
-	    {bad screen distance "46q"}}
-    {-fgstipple gray25 gray25 bogus
-	    {bitmap "bogus" not defined}}
-    {-font fixed fixed {}
-	    {font "" doesn't exist}}
-    {-foreground #001122 #001122 {silly color}
-	    {unknown color name "silly color"}}
-    {-justify left left middle
-	    {bad justification "middle": must be left, right, or center}}
-    {-lmargin1 10 10 bad
-	    {bad screen distance "bad"}}
-    {-lmargin2 10 10 bad
-	    {bad screen distance "bad"}}
-    {-offset 2 2 100xyz
-	    {bad screen distance "100xyz"}}
-    {-overstrike on on stupid
-	    {expected boolean value but got "stupid"}}
-    {-relief raised raised stupid
-	    {bad relief type "stupid": must be flat, groove, raised, ridge, solid, or sunken}}
-    {-rmargin 10 10 bad
-	    {bad screen distance "bad"}}
-    {-spacing1 10 10 bad
-	    {bad screen distance "bad"}}
-    {-spacing2 10 10 bad
-	    {bad screen distance "bad"}}
-    {-spacing3 10 10 bad
-	    {bad screen distance "bad"}}
-    {-tabs {10 20 30} {10 20 30} {10 fork}
-	    {bad tab alignment "fork": must be left, right, center, or numeric}}
-    {-underline no no stupid
-	    {expected boolean value but got "stupid"}}
-} {
-    set name [lindex $test 0]
-    test textTag-1.$i {tag configuration options} haveCourier12 {
-	.t tag configure x $name [lindex $test 1]
-	.t tag cget x $name
-    } [lindex $test 2]
-    incr i
-    if {[lindex $test 3] != ""} {
-	test textTag-1.$i {configuration options} haveCourier12 {
-	    list [catch {.t tag configure x $name [lindex $test 3]} msg] $msg
-	} [list 1 [lindex $test 4]]
-    }
-    .t tag configure x $name [lindex [.t tag configure x $name] 3]
-    incr i
-}
-test textTag-2.1 {TkTextTagCmd - "add" option} haveCourier12 {
-    list [catch {.t tag} msg] $msg
-} {1 {wrong # args: should be ".t tag option ?arg ...?"}}
-test textTag-2.2 {TkTextTagCmd - "add" option} haveCourier12 {
-    list [catch {.t tag gorp} msg] $msg
-} {1 {bad tag option "gorp": must be add, bind, cget, configure, delete, lower, names, nextrange, prevrange, raise, ranges, or remove}}
-test textTag-2.3 {TkTextTagCmd - "add" option} haveCourier12 {
-    list [catch {.t tag add foo} msg] $msg
-} {1 {wrong # args: should be ".t tag add tagName index1 ?index2 index1 index2 ...?"}}
-test textTag-2.4 {TkTextTagCmd - "add" option} haveCourier12 {
-    list [catch {.t tag add x gorp} msg] $msg
-} {1 {bad text index "gorp"}}
-test textTag-2.5 {TkTextTagCmd - "add" option} haveCourier12 {
-    list [catch {.t tag add x 1.2 gorp} msg] $msg
-} {1 {bad text index "gorp"}}
-test textTag-2.6 {TkTextTagCmd - "add" option} haveCourier12 {
+test textTag-1.1 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -background #012345
+    .t tag cget x -background
+} -cleanup {
+    .t tag configure x -background [lindex [.t tag configure x -background] 3]
+} -result {#012345}
+test textTag-1.2 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -background non-existent
+} -cleanup {
+    .t tag configure x -background [lindex [.t tag configure x -background] 3]
+} -returnCodes error -result {unknown color name "non-existent"}
+test textTag-1.3 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -bgstipple gray50
+    .t tag cget x -bgstipple
+} -cleanup {
+    .t tag configure x -bgstipple [lindex [.t tag configure x -bgstipple] 3]
+} -result {gray50}
+test textTag-1.4 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -bgstipple badStipple
+} -cleanup {
+    .t tag configure x -bgstipple [lindex [.t tag configure x -bgstipple] 3]
+} -returnCodes error -result {bitmap "badStipple" not defined}
+test textTag-1.5 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -borderwidth 2
+    .t tag cget x -borderwidth
+} -cleanup {
+    .t tag configure x -borderwidth [lindex [.t tag configure x -borderwidth] 3]
+} -result {2}
+test textTag-1.6 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -borderwidth 46q
+} -cleanup {
+    .t tag configure x -borderwidth [lindex [.t tag configure x -borderwidth] 3]
+} -returnCodes error -result {bad screen distance "46q"}
+test textTag-1.7 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -fgstipple gray25
+    .t tag cget x -fgstipple
+} -cleanup {
+    .t tag configure x -fgstipple [lindex [.t tag configure x -fgstipple] 3]
+} -result {gray25}
+test textTag-1.8 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -fgstipple bogus
+} -cleanup {
+    .t tag configure x -fgstipple [lindex [.t tag configure x -fgstipple] 3]
+} -returnCodes error -result {bitmap "bogus" not defined}
+test textTag-1.9 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -font fixed
+    .t tag cget x -font
+} -cleanup {
+    .t tag configure x -font [lindex [.t tag configure x -font] 3]
+} -result {fixed}
+test textTag-1.10 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -foreground #001122
+    .t tag cget x -foreground
+} -cleanup {
+    .t tag configure x -foreground [lindex [.t tag configure x -foreground] 3]
+} -result {#001122}
+test textTag-1.11 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -foreground {silly color}
+} -cleanup {
+    .t tag configure x -foreground [lindex [.t tag configure x -foreground] 3]
+} -returnCodes error -result {unknown color name "silly color"}
+test textTag-1.12 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -justify left
+    .t tag cget x -justify
+} -cleanup {
+    .t tag configure x -justify [lindex [.t tag configure x -justify] 3]
+} -result {left}
+test textTag-1.13 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -justify middle
+} -cleanup {
+    .t tag configure x -justify [lindex [.t tag configure x -justify] 3]
+} -returnCodes error -result {bad justification "middle": must be left, right, or center}
+test textTag-1.14 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -lmargin1 10
+    .t tag cget x -lmargin1
+} -cleanup {
+    .t tag configure x -lmargin1 [lindex [.t tag configure x -lmargin1] 3]
+} -result {10}
+test textTag-1.15 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -lmargin1 bad
+} -cleanup {
+    .t tag configure x -lmargin1 [lindex [.t tag configure x -lmargin1] 3]
+} -returnCodes error -result {bad screen distance "bad"}
+test textTag-1.16 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -lmargin2 10
+    .t tag cget x -lmargin2
+} -cleanup {
+    .t tag configure x -lmargin2 [lindex [.t tag configure x -lmargin2] 3]
+} -result {10}
+test textTag-1.17 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -lmargin2 bad
+} -cleanup {
+    .t tag configure x -lmargin2 [lindex [.t tag configure x -lmargin2] 3]
+} -returnCodes error -result {bad screen distance "bad"}
+test textTag-1.18 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -offset 2
+    .t tag cget x -offset
+} -cleanup {
+    .t tag configure x -offset [lindex [.t tag configure x -offset] 3]
+} -result {2}
+test textTag-1.19 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -offset 100xyz
+} -cleanup {
+    .t tag configure x -offset [lindex [.t tag configure x -offset] 3]
+} -returnCodes error -result {bad screen distance "100xyz"}
+test textTag-1.20 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -overstrike on
+    .t tag cget x -overstrike
+} -cleanup {
+    .t tag configure x -overstrike [lindex [.t tag configure x -overstrike] 3]
+} -result {on}
+test textTag-1.21 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -overstrike stupid
+} -cleanup {
+    .t tag configure x -overstrike [lindex [.t tag configure x -overstrike] 3]
+} -returnCodes error -result {expected boolean value but got "stupid"}
+test textTag-1.22 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -relief raised
+    .t tag cget x -relief
+} -cleanup {
+    .t tag configure x -relief [lindex [.t tag configure x -relief] 3]
+} -result {raised}
+test textTag-1.23 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -relief stupid
+} -cleanup {
+    .t tag configure x -relief [lindex [.t tag configure x -relief] 3]
+} -returnCodes error -result {bad relief type "stupid": must be flat, groove, raised, ridge, solid, or sunken}
+test textTag-1.24 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -rmargin 10
+    .t tag cget x -rmargin
+} -cleanup {
+    .t tag configure x -rmargin [lindex [.t tag configure x -rmargin] 3]
+} -result {10}
+test textTag-1.25 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -rmargin bad
+} -cleanup {
+    .t tag configure x -rmargin [lindex [.t tag configure x -rmargin] 3]
+} -returnCodes error -result {bad screen distance "bad"}
+test textTag-1.26 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -spacing1 10
+    .t tag cget x -spacing1
+} -cleanup {
+    .t tag configure x -spacing1 [lindex [.t tag configure x -spacing1] 3]
+} -result {10}
+test textTag-1.27 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -spacing1 bad
+} -cleanup {
+    .t tag configure x -spacing1 [lindex [.t tag configure x -spacing1] 3]
+} -returnCodes error -result {bad screen distance "bad"}
+test textTag-1.28 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -spacing2 10
+    .t tag cget x -spacing2
+} -cleanup {
+    .t tag configure x -spacing2 [lindex [.t tag configure x -spacing2] 3]
+} -result {10}
+test textTag-1.29 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -spacing2 bad
+} -cleanup {
+    .t tag configure x -spacing2 [lindex [.t tag configure x -spacing2] 3]
+} -returnCodes error -result {bad screen distance "bad"}
+test textTag-1.30 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -spacing3 10
+    .t tag cget x -spacing3
+} -cleanup {
+    .t tag configure x -spacing3 [lindex [.t tag configure x -spacing3] 3]
+} -result {10}
+test textTag-1.31 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -spacing3 bad
+} -cleanup {
+    .t tag configure x -spacing3 [lindex [.t tag configure x -spacing3] 3]
+} -returnCodes error -result {bad screen distance "bad"}
+test textTag-1.32 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -tabs {10 20 30}
+    .t tag cget x -tabs
+} -cleanup {
+    .t tag configure x -tabs [lindex [.t tag configure x -tabs] 3]
+} -result {10 20 30}
+test textTag-1.33 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -tabs {10 fork}
+} -cleanup {
+    .t tag configure x -tabs [lindex [.t tag configure x -tabs] 3]
+} -returnCodes error -result {bad tab alignment "fork": must be left, right, center, or numeric}
+test textTag-1.34 {tag configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -underline no
+    .t tag cget x -underline
+} -cleanup {
+    .t tag configure x -underline [lindex [.t tag configure x -underline] 3]
+} -result {no}
+test textTag-1.35 {configuration options} -constraints {
+    haveCourier12
+} -body {
+    .t tag configure x -underline stupid
+} -cleanup {
+    .t tag configure x -underline [lindex [.t tag configure x -underline] 3]
+} -returnCodes error -result {expected boolean value but got "stupid"}
+
+
+test textTag-2.1 {TkTextTagCmd - "add" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag
+} -returnCodes error -result {wrong # args: should be ".t tag option ?arg ...?"}
+test textTag-2.2 {TkTextTagCmd - "add" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag gorp
+} -returnCodes error -result {bad tag option "gorp": must be add, bind, cget, configure, delete, lower, names, nextrange, prevrange, raise, ranges, or remove}
+test textTag-2.3 {TkTextTagCmd - "add" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag add foo
+} -returnCodes error -result {wrong # args: should be ".t tag add tagName index1 ?index2 index1 index2 ...?"}
+test textTag-2.4 {TkTextTagCmd - "add" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag add x gorp
+} -returnCodes error -result {bad text index "gorp"}
+test textTag-2.5 {TkTextTagCmd - "add" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag add x 1.2 gorp
+} -returnCodes error -result {bad text index "gorp"}
+test textTag-2.6 {TkTextTagCmd - "add" option} -constraints {
+	haveCourier12 
+} -setup {
+    .t tag delete sel
+} -body {
     .t tag add sel 3.2 3.4
     .t tag add sel 3.2 3.0
     .t tag ranges sel
-} {3.2 3.4}
-test textTag-2.7 {TkTextTagCmd - "add" option} haveCourier12 {
+} -result {3.2 3.4}
+test textTag-2.7 {TkTextTagCmd - "add" option} -constraints {
+	haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
     .t tag add x 1.0 1.end
     .t tag ranges x
-} {1.0 1.6}
-test textTag-2.8 {TkTextTagCmd - "add" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {1.0 1.6}
+test textTag-2.8 {TkTextTagCmd - "add" option} -constraints {
+	haveCourier12 
+} -setup {
     .t tag remove x 1.0 end
+} -body {
     .t tag add x 1.2
     .t tag ranges x
-} {1.2 1.3}
-test textTag-2.9 {TkTextTagCmd - "add" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {1.2 1.3}
+test textTag-2.9 {TkTextTagCmd - "add" option} -constraints {
+	haveCourier12 
+} -setup {
+    destroy .t.e
+} -body {
+    entry .t.e
+    .t.e insert 0 "Text"
     .t.e select from 0
     .t.e select to 4
     .t tag add sel 3.2 3.4
     selection get
-} 34
-test textTag-2.11 {TkTextTagCmd - "add" option} haveCourier12 {
+} -cleanup {
+    destroy .t.e
+} -result 34
+test textTag-2.10 {TkTextTagCmd - "add" option} -constraints {
+	haveCourier12 
+} -setup {
+    destroy .t.e
+} -body {
+    entry .t.e
+    .t.e insert 0 "Text"
     .t.e select from 0
     .t.e select to 4
     .t configure -exportselection 0
     .t tag add sel 3.2 3.4
     selection get
-} Text
-test textTag-2.12 {TkTextTagCmd - "add" option} haveCourier12 {
+} -cleanup {
+    destroy .t.e
+}  -result {Text}
+test textTag-2.11 {TkTextTagCmd - "add" option} -constraints {
+	haveCourier12 
+} -body {
     .t tag remove sel 1.0 end
     .t tag add sel 1.1 1.5 2.4 3.1 4.2 4.4
     .t tag ranges sel
-} {1.1 1.5 2.4 3.1 4.2 4.4}
-test textTag-2.13 {TkTextTagCmd - "add" option} haveCourier12 {
+} -result {1.1 1.5 2.4 3.1 4.2 4.4}
+test textTag-2.12 {TkTextTagCmd - "add" option} -constraints {
+	haveCourier12 
+} -body {
     .t tag remove sel 1.0 end
     .t tag add sel 1.1 1.5 2.4
     .t tag ranges sel
-} {1.1 1.5 2.4 2.5}
-
-catch {.t tag delete x}
-test textTag-3.1 {TkTextTagCmd - "bind" option} haveCourier12 {
-    list [catch {.t tag bind} msg] $msg
-} {1 {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}}
-test textTag-3.2 {TkTextTagCmd - "bind" option} haveCourier12 {
-    list [catch {.t tag bind 1 2 3 4} msg] $msg
-} {1 {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}}
-test textTag-3.3 {TkTextTagCmd - "bind" option} haveCourier12 {
+} -cleanup {
+    .t tag remove sel 1.0 end
+} -result {1.1 1.5 2.4 2.5}
+
+
+test textTag-3.1 {TkTextTagCmd - "bind" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag bind
+} -returnCodes error -result {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}
+test textTag-3.2 {TkTextTagCmd - "bind" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag bind 1 2 3 4
+} -returnCodes error -result {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}
+test textTag-3.3 {TkTextTagCmd - "bind" option} -constraints {
+	haveCourier12 
+} -body {
     .t tag bind x <Enter> script1
     .t tag bind x <Enter>
-} script1
-test textTag-3.4 {TkTextTagCmd - "bind" option} haveCourier12 {
-    list [catch {.t tag bind x <Gorp> script2} msg] $msg
-} {1 {bad event type or keysym "Gorp"}}
-test textTag-3.5 {TkTextTagCmd - "bind" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {script1}
+test textTag-3.4 {TkTextTagCmd - "bind" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag bind x <Gorp> script2
+} -returnCodes error -result {bad event type or keysym "Gorp"}
+test textTag-3.5 {TkTextTagCmd - "bind" option} -constraints {
+	haveCourier12 
+} -body {
     .t tag delete x
     .t tag bind x <Enter> script1
-    list [catch {.t tag bind x <FocusIn> script2} msg] $msg [.t tag bind x]
-} {1 {requested illegal events; only key, button, motion, enter, leave, and virtual events may be used} <Enter>}
-test textTag-3.6 {TkTextTagCmd - "bind" option} haveCourier12 {
+    .t tag bind x <FocusIn> script2
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {requested illegal events; only key, button, motion, enter, leave, and virtual events may be used}
+test textTag-3.6 {TkTextTagCmd - "bind" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag delete x
+    .t tag bind x <Enter> script1
+    catch {.t tag bind x <FocusIn> script2} 
+    .t tag bind x
+} -cleanup {
+    .t tag delete x
+} -result {<Enter>}
+test textTag-3.7 {TkTextTagCmd - "bind" option} -constraints {
+	haveCourier12 
+} -body {
     .t tag delete x
     .t tag bind x <Enter> script1
     .t tag bind x <Leave> script2
     .t tag bind x a xyzzy
     list [lsort [.t tag bind x]] [.t tag bind x <Enter>] [.t tag bind x a]
-} {{<Enter> <Leave> a} script1 xyzzy}
-test textTag-3.7 {TkTextTagCmd - "bind" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {{<Enter> <Leave> a} script1 xyzzy}
+test textTag-3.8 {TkTextTagCmd - "bind" option} -constraints {
+	haveCourier12 
+} -body {
     .t tag delete x
     .t tag bind x <Enter> script1
     .t tag bind x <Enter> +script2
     .t tag bind x <Enter>
-} {script1
+} -cleanup {
+    .t tag delete x
+} -result {script1
 script2}
-test textTag-3.7a {TkTextTagCmd - "bind" option} haveCourier12 {
-    .t tag delete x
-    list [catch {.t tag bind x <Enter>} msg] $msg
-} {0 {}}
-test textTag-3.8 {TkTextTagCmd - "bind" option} haveCourier12 {
-    .t tag delete x
-    list [catch {.t tag bind x <} msg] $msg
-} {1 {no event type or button # or keysym}}
-
-test textTag-4.1 {TkTextTagCmd - "cget" option} haveCourier12 {
-    list [catch {.t tag cget a} msg] $msg
-} {1 {wrong # args: should be ".t tag cget tagName option"}}
-test textTag-4.2 {TkTextTagCmd - "cget" option} haveCourier12 {
-    list [catch {.t tag cget a b c} msg] $msg
-} {1 {wrong # args: should be ".t tag cget tagName option"}}
-test textTag-4.3 {TkTextTagCmd - "cget" option} haveCourier12 {
+test textTag-3.9 {TkTextTagCmd - "bind" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag delete x
+    .t tag bind x <Enter>
+} -cleanup {
+    .t tag delete x
+} -returnCodes ok -result {}
+test textTag-3.10 {TkTextTagCmd - "bind" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag delete x
+    .t tag bind x <
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {no event type or button # or keysym}
+
+
+test textTag-4.1 {TkTextTagCmd - "cget" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag cget a
+} -returnCodes error -result {wrong # args: should be ".t tag cget tagName option"}
+test textTag-4.2 {TkTextTagCmd - "cget" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag cget a b c
+} -returnCodes error -result {wrong # args: should be ".t tag cget tagName option"}
+test textTag-4.3 {TkTextTagCmd - "cget" option} -constraints {
+	haveCourier12 
+} -body {
     .t tag delete foo
-    list [catch {.t tag cget foo bar} msg] $msg
-} {1 {tag "foo" isn't defined in text widget}}
-test textTag-4.4 {TkTextTagCmd - "cget" option} haveCourier12 {
-    list [catch {.t tag cget sel bogus} msg] $msg
-} {1 {unknown option "bogus"}}
-test textTag-4.5 {TkTextTagCmd - "cget" option} haveCourier12 {
+    .t tag cget foo bar
+} -returnCodes error -result {tag "foo" isn't defined in text widget}
+test textTag-4.4 {TkTextTagCmd - "cget" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag cget sel bogus
+} -returnCodes error -result {unknown option "bogus"}
+test textTag-4.5 {TkTextTagCmd - "cget" option} -constraints {
+	haveCourier12 
+} -body {
     .t tag delete x
     .t tag configure x -background red
-    list [catch {.t tag cget x -background} msg] $msg
-} {0 red}
-
-test textTag-5.1 {TkTextTagCmd - "configure" option} haveCourier12 {
-    list [catch {.t tag configure} msg] $msg
-} {1 {wrong # args: should be ".t tag configure tagName ?-option? ?value? ?-option value ...?"}}
-test textTag-5.2 {TkTextTagCmd - "configure" option} haveCourier12 {
-    list [catch {.t tag configure x -foo} msg] $msg
-} {1 {unknown option "-foo"}}
-test textTag-5.3 {TkTextTagCmd - "configure" option} haveCourier12 {
-    list [catch {.t tag configure x -background red -underline} msg] $msg
-} {1 {value for "-underline" missing}}
-test textTag-5.4 {TkTextTagCmd - "configure" option} haveCourier12 {
+    .t tag cget x -background
+} -cleanup {
+    .t tag delete x
+} -result {red}
+
+
+test textTag-5.1 {TkTextTagCmd - "configure" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag configure
+} -returnCodes error -result {wrong # args: should be ".t tag configure tagName ?-option? ?value? ?-option value ...?"}
+test textTag-5.2 {TkTextTagCmd - "configure" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag configure x -foo
+} -returnCodes error -result {unknown option "-foo"}
+test textTag-5.3 {TkTextTagCmd - "configure" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag configure x -background red -underline
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {value for "-underline" missing}
+test textTag-5.4 {TkTextTagCmd - "configure" option} -constraints {
+	haveCourier12 
+} -body {
     .t tag delete x
     .t tag configure x -underline yes
     .t tag configure x -underline
-} {-underline {} {} {} yes}
-test textTag-5.5 {TkTextTagCmd - "configure" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {-underline {} {} {} yes}
+test textTag-5.5 {TkTextTagCmd - "configure" option} -constraints {
+	haveCourier12 
+} -body {
     .t tag delete x
     .t tag configure x -overstrike on
     .t tag cget x -overstrike
-} {on}
-test textTag-5.6 {TkTextTagCmd - "configure" option} haveCourier12 {
-    list [catch {.t tag configure x -overstrike foo} msg] $msg
-} {1 {expected boolean value but got "foo"}}
-test textTag-5.7 {TkTextTagCmd - "configure" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {on}
+test textTag-5.6 {TkTextTagCmd - "configure" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag configure x -overstrike foo
+} -cleanup {
     .t tag delete x
-    list [catch {.t tag configure x -underline stupid} msg] $msg
-} {1 {expected boolean value but got "stupid"}}
-test textTag-5.8 {TkTextTagCmd - "configure" option} haveCourier12 {
+} -returnCodes error -result {expected boolean value but got "foo"}
+test textTag-5.7 {TkTextTagCmd - "configure" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag delete x
+    .t tag configure x -underline stupid
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {expected boolean value but got "stupid"}
+test textTag-5.8 {TkTextTagCmd - "configure" option} -constraints {
+	haveCourier12 
+} -body {
     .t tag delete x
     .t tag configure x -justify left
     .t tag configure x -justify
-} {-justify {} {} {} left}
-test textTag-5.9 {TkTextTagCmd - "configure" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {-justify {} {} {} left}
+test textTag-5.9 {TkTextTagCmd - "configure" option} -constraints {
+	haveCourier12 
+} -body {
+    .t tag delete x
+    .t tag configure x -justify bogus
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {bad justification "bogus": must be left, right, or center}
+test textTag-5.10 {TkTextTagCmd - "configure" option} -constraints {
+	haveCourier12 
+} -body {
     .t tag delete x
-    list [catch {.t tag configure x -justify bogus} msg] $msg
-} {1 {bad justification "bogus": must be left, right, or center}}
-test textTag-5.10 {TkTextTagCmd - "configure" option} haveCourier12 {
+    .t tag configure x -justify fill
+} -cleanup {
     .t tag delete x
-    list [catch {.t tag configure x -justify fill} msg] $msg
-} {1 {bad justification "fill": must be left, right, or center}}
-test textTag-5.11 {TkTextTagCmd - "configure" option} haveCourier12 {
+} -returnCodes error -result {bad justification "fill": must be left, right, or center}
+test textTag-5.11 {TkTextTagCmd - "configure" option} -constraints {
+    haveCourier12 
+} -body {
     .t tag delete x
     .t tag configure x -offset 2
     .t tag configure x -offset
-} {-offset {} {} {} 2}
-test textTag-5.12 {TkTextTagCmd - "configure" option} haveCourier12 {
+} -cleanup {
     .t tag delete x
-    list [catch {.t tag configure x -offset 1.0q} msg] $msg
-} {1 {bad screen distance "1.0q"}}
-test textTag-5.13 {TkTextTagCmd - "configure" option} haveCourier12 {
+} -result {-offset {} {} {} 2}
+test textTag-5.12 {TkTextTagCmd - "configure" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag delete x
+    .t tag configure x -offset 1.0q
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {bad screen distance "1.0q"}
+test textTag-5.13 {TkTextTagCmd - "configure" option} -constraints {
+    haveCourier12 
+} -body {
     .t tag delete x
     .t tag configure x -lmargin1 2 -lmargin2 4 -rmargin 5
     list [.t tag configure x -lmargin1] [.t tag configure x -lmargin2] \
-	    [.t tag configure x -rmargin]
-} {{-lmargin1 {} {} {} 2} {-lmargin2 {} {} {} 4} {-rmargin {} {} {} 5}}
-test textTag-5.14 {TkTextTagCmd - "configure" option} haveCourier12 {
+        [.t tag configure x -rmargin]
+} -cleanup {
+    .t tag delete x
+} -result {{-lmargin1 {} {} {} 2} {-lmargin2 {} {} {} 4} {-rmargin {} {} {} 5}}
+test textTag-5.14 {TkTextTagCmd - "configure" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag delete x
+    .t tag configure x -lmargin1 2.0x
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {bad screen distance "2.0x"}
+test textTag-5.15 {TkTextTagCmd - "configure" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag delete x
+    .t tag configure x -lmargin2 gorp
+} -cleanup {
     .t tag delete x
-    list [catch {.t tag configure x -lmargin1 2.0x} msg] $msg
-} {1 {bad screen distance "2.0x"}}
-test textTag-5.15 {TkTextTagCmd - "configure" option} haveCourier12 {
+} -returnCodes error -result {bad screen distance "gorp"}
+test textTag-5.16 {TkTextTagCmd - "configure" option} -constraints {
+    haveCourier12 
+} -body {
     .t tag delete x
-    list [catch {.t tag configure x -lmargin2 gorp} msg] $msg
-} {1 {bad screen distance "gorp"}}
-test textTag-5.16 {TkTextTagCmd - "configure" option} haveCourier12 {
+    .t tag configure x -rmargin 140.1.1
+} -cleanup {
     .t tag delete x
-    list [catch {.t tag configure x -rmargin 140.1.1} msg] $msg
-} {1 {bad screen distance "140.1.1"}}
+} -returnCodes error -result {bad screen distance "140.1.1"}
 .t tag delete x
-test textTag-5.17 {TkTextTagCmd - "configure" option} haveCourier12 {
+test textTag-5.17 {TkTextTagCmd - "configure" option} -constraints {
+    haveCourier12 
+} -body {
     .t tag delete x
     .t tag configure x -spacing1 2 -spacing2 4 -spacing3 6
     list [.t tag configure x -spacing1] [.t tag configure x -spacing2] \
-	    [.t tag configure x -spacing3]
-} {{-spacing1 {} {} {} 2} {-spacing2 {} {} {} 4} {-spacing3 {} {} {} 6}}
-test textTag-5.18 {TkTextTagCmd - "configure" option} haveCourier12 {
+        [.t tag configure x -spacing3]
+} -cleanup {
     .t tag delete x
-    list [catch {.t tag configure x -spacing1 2.0x} msg] $msg
-} {1 {bad screen distance "2.0x"}}
-test textTag-5.19 {TkTextTagCmd - "configure" option} haveCourier12 {
+} -result {{-spacing1 {} {} {} 2} {-spacing2 {} {} {} 4} {-spacing3 {} {} {} 6}}
+test textTag-5.18 {TkTextTagCmd - "configure" option} -constraints {
+    haveCourier12 
+} -body {
     .t tag delete x
-    list [catch {.t tag configure x -spacing1 lousy} msg] $msg
-} {1 {bad screen distance "lousy"}}
-test textTag-5.20 {TkTextTagCmd - "configure" option} haveCourier12 {
+    .t tag configure x -spacing1 2.0x
+} -cleanup {
     .t tag delete x
-    list [catch {.t tag configure x -spacing1 4.2.3} msg] $msg
-} {1 {bad screen distance "4.2.3"}}
-test textTag-5.21 {TkTextTagCmd - "configure" option} haveCourier12 {
+} -returnCodes error -result {bad screen distance "2.0x"}
+test textTag-5.19 {TkTextTagCmd - "configure" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag delete x
+    .t tag configure x -spacing1 lousy
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {bad screen distance "lousy"}
+test textTag-5.20 {TkTextTagCmd - "configure" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag delete x
+    .t tag configure x -spacing1 4.2.3
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {bad screen distance "4.2.3"}
+test textTag-5.21 {TkTextTagCmd - "configure" option} -constraints {
+    haveCourier12 
+} -body {
     .t configure -selectborderwidth 2 -selectforeground blue \
-	    -selectbackground black
+        -selectbackground black
     .t tag configure sel -borderwidth 4 -foreground green -background yellow
     set x {}
     foreach i {-selectborderwidth -selectforeground -selectbackground} {
-	lappend x [lindex [.t configure $i] 4]
+        lappend x [lindex [.t configure $i] 4]
     }
-    set x
-} {4 green yellow}
-test textTag-5.22 {TkTextTagCmd - "configure" option} haveCourier12 {
+    return $x
+} -result {4 green yellow}
+test textTag-5.22 {TkTextTagCmd - "configure" option} -constraints {
+    haveCourier12 
+} -body {
     .t configure -selectborderwidth 20
     .t tag configure sel -borderwidth {}
     .t cget -selectborderwidth
-} {}
+} -result {}
 
-test textTag-6.1 {TkTextTagCmd - "delete" option} haveCourier12 {
-    list [catch {.t tag delete} msg] $msg
-} {1 {wrong # args: should be ".t tag delete tagName ?tagName ...?"}}
-test textTag-6.2 {TkTextTagCmd - "delete" option} haveCourier12 {
-    list [catch {.t tag delete zork} msg] $msg
-} {0 {}}
-test textTag-6.3 {TkTextTagCmd - "delete" option} haveCourier12 {
-    .t tag delete x
+
+test textTag-6.1 {TkTextTagCmd - "delete" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag delete
+} -returnCodes error -result {wrong # args: should be ".t tag delete tagName ?tagName ...?"}
+test textTag-6.2 {TkTextTagCmd - "delete" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag delete zork
+} -returnCodes ok -result {}
+test textTag-6.3 {TkTextTagCmd - "delete" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete {*}[.t tag names]
+} -body {
     .t tag config x -background black
     .t tag config y -foreground white
     .t tag config z -background black
     .t tag delete y z
     lsort [.t tag names]
-} {sel x}
-test textTag-6.4 {TkTextTagCmd - "delete" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {sel x}
+test textTag-6.4 {TkTextTagCmd - "delete" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete {*}[.t tag names]
+} -body {
     .t tag config x -background black
     .t tag config y -foreground white
     .t tag config z -background black
     eval .t tag delete [.t tag names]
     .t tag names
-} {sel}
-test textTag-6.5 {TkTextTagCmd - "delete" option} haveCourier12 {
+} -result {sel}
+test textTag-6.5 {TkTextTagCmd - "delete" option} -constraints {
+    haveCourier12 
+} -body {
     .t tag bind x <Enter> foo
     .t tag delete x
     .t tag configure x -background black
     .t tag bind x
-} {}
+} -cleanup {
+    .t tag delete x
+} -result {}
 
-proc tagsetup {} {
-    .t tag delete x y z a b c d
+
+test textTag-7.1 {TkTextTagCmd - "lower" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag lower
+} -returnCodes error -result {wrong # args: should be ".t tag lower tagName ?belowThis?"}
+test textTag-7.2 {TkTextTagCmd - "lower" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag lower foo
+} -returnCodes error -result {tag "foo" isn't defined in text widget}
+test textTag-7.3 {TkTextTagCmd - "lower" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag lower sel bar
+} -returnCodes error -result {tag "bar" isn't defined in text widget}
+test textTag-7.4 {TkTextTagCmd - "lower" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete {*}[.t tag names]
     .t tag remove sel 1.0 end
     foreach i {a b c d} {
-	.t tag configure $i -background black
+        .t tag configure $i -background black
     }
-}
-test textTag-7.1 {TkTextTagCmd - "lower" option} haveCourier12 {
-    list [catch {.t tag lower} msg] $msg
-} {1 {wrong # args: should be ".t tag lower tagName ?belowThis?"}}
-test textTag-7.2 {TkTextTagCmd - "lower" option} haveCourier12 {
-    list [catch {.t tag lower foo} msg] $msg
-} {1 {tag "foo" isn't defined in text widget}}
-test textTag-7.3 {TkTextTagCmd - "lower" option} haveCourier12 {
-    list [catch {.t tag lower sel bar} msg] $msg
-} {1 {tag "bar" isn't defined in text widget}}
-test textTag-7.4 {TkTextTagCmd - "lower" option} haveCourier12 {
-    tagsetup
+} -body {
     .t tag lower c
     .t tag names
-} {c sel a b d}
-test textTag-7.5 {TkTextTagCmd - "lower" option} haveCourier12 {
-    tagsetup
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -result {c sel a b d}
+test textTag-7.5 {TkTextTagCmd - "lower" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete {*}[.t tag names]
+    .t tag remove sel 1.0 end
+    foreach i {a b c d} {
+        .t tag configure $i -background black
+    }
+} -body {
     .t tag lower d b
     .t tag names
-} {sel a d b c}
-test textTag-7.6 {TkTextTagCmd - "lower" option} haveCourier12 {
-    tagsetup
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -result {sel a d b c}
+test textTag-7.6 {TkTextTagCmd - "lower" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete {*}[.t tag names]
+    .t tag remove sel 1.0 end
+    foreach i {a b c d} {
+        .t tag configure $i -background black
+    }
+} -body {
     .t tag lower a c
     .t tag names
-} {sel b a c d}
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -result {sel b a c d}
 
-test textTag-8.1 {TkTextTagCmd - "names" option} haveCourier12 {
-    list [catch {.t tag names a b} msg] $msg
-} {1 {wrong # args: should be ".t tag names ?index?"}}
-test textTag-8.2 {TkTextTagCmd - "names" option} haveCourier12 {
-    tagsetup
+
+test textTag-8.1 {TkTextTagCmd - "names" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag names a b
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -returnCodes error -result {wrong # args: should be ".t tag names ?index?"}
+test textTag-8.2 {TkTextTagCmd - "names" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete {*}[.t tag names]
+    .t tag remove sel 1.0 end
+    foreach i {a b c d} {
+        .t tag configure $i -background black
+    }
+} -body {
     .t tag names
-} {sel a b c d}
-test textTag-8.3 {TkTextTagCmd - "names" option} haveCourier12 {
-    tagsetup
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -result {sel a b c d}
+test textTag-8.3 {TkTextTagCmd - "names" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete {*}[.t tag names]
+    .t tag remove sel 1.0 end
+    foreach i {a b c d} {
+        .t tag configure $i -background black
+    }
+} -body {
     .t tag add "a b" 2.1 2.6
     .t tag add c 2.4 2.7
     .t tag names 2.5
-} {c {a b}}
-
-.t tag delete x y z a b c d {a b}
-.t tag add x 2.3 2.5
-.t tag add x 2.9 3.1
-.t tag add x 7.2
-test textTag-9.1 {TkTextTagCmd - "nextrange" option} haveCourier12 {
-    list [catch {.t tag nextrange x} msg] $msg
-} {1 {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}}
-test textTag-9.2 {TkTextTagCmd - "nextrange" option} haveCourier12 {
-    list [catch {.t tag nextrange x 1 2 3} msg] $msg
-} {1 {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}}
-test textTag-9.3 {TkTextTagCmd - "nextrange" option} haveCourier12 {
-    list [catch {.t tag nextrange foo 1.0} msg] $msg
-} {0 {}}
-test textTag-9.4 {TkTextTagCmd - "nextrange" option} haveCourier12 {
-    list [catch {.t tag nextrange x foo} msg] $msg
-} {1 {bad text index "foo"}}
-test textTag-9.5 {TkTextTagCmd - "nextrange" option} haveCourier12 {
-    list [catch {.t tag nextrange x 1.0 bar} msg] $msg
-} {1 {bad text index "bar"}}
-test textTag-9.6 {TkTextTagCmd - "nextrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -result {c {a b}}
+
+
+test textTag-9.1 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag nextrange x
+} -returnCodes error -result {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}
+test textTag-9.2 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag nextrange x 1 2 3
+} -returnCodes error -result {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}
+test textTag-9.3 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag nextrange foo 1.0
+} -returnCodes ok -result {}
+test textTag-9.4 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag nextrange x foo
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {bad text index "foo"}
+test textTag-9.5 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
+    .t tag nextrange x 1.0 bar
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {bad text index "bar"}
+test textTag-9.6 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag nextrange x 1.0
-} {2.3 2.5}
-test textTag-9.7 {TkTextTagCmd - "nextrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.3 2.5}
+test textTag-9.7 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag nextrange x 2.2
-} {2.3 2.5}
-test textTag-9.8 {TkTextTagCmd - "nextrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.3 2.5}
+test textTag-9.8 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag nextrange x 2.3
-} {2.3 2.5}
-test textTag-9.9 {TkTextTagCmd - "nextrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.3 2.5}
+test textTag-9.9 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag nextrange x 2.4
-} {2.9 3.1}
-test textTag-9.10 {TkTextTagCmd - "nextrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.9 3.1}
+test textTag-9.10 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag nextrange x 2.4 2.9
-} {}
-test textTag-9.11 {TkTextTagCmd - "nextrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {}
+test textTag-9.11 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag nextrange x 2.4 2.10
-} {2.9 3.1}
-test textTag-9.12 {TkTextTagCmd - "nextrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.9 3.1}
+test textTag-9.12 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag nextrange x 2.4 2.11
-} {2.9 3.1}
-test textTag-9.13 {TkTextTagCmd - "nextrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.9 3.1}
+test textTag-9.13 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag nextrange x 7.0
-} {7.2 7.3}
-test textTag-9.14 {TkTextTagCmd - "nextrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {7.2 7.3}
+test textTag-9.14 {TkTextTagCmd - "nextrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag nextrange x 7.3
-} {}
-
-test textTag-10.1 {TkTextTagCmd - "prevrange" option} haveCourier12 {
-    list [catch {.t tag prevrange x} msg] $msg
-} {1 {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}}
-test textTag-10.2 {TkTextTagCmd - "prevrange" option} haveCourier12 {
-    list [catch {.t tag prevrange x 1 2 3} msg] $msg
-} {1 {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}}
-test textTag-10.3 {TkTextTagCmd - "prevrange" option} haveCourier12 {
-    list [catch {.t tag prevrange foo end} msg] $msg
-} {0 {}}
-test textTag-10.4 {TkTextTagCmd - "prevrange" option} haveCourier12 {
-    list [catch {.t tag prevrange x foo} msg] $msg
-} {1 {bad text index "foo"}}
-test textTag-10.5 {TkTextTagCmd - "prevrange" option} haveCourier12 {
-    list [catch {.t tag prevrange x end bar} msg] $msg
-} {1 {bad text index "bar"}}
-test textTag-10.6 {TkTextTagCmd - "prevrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {}
+
+
+test textTag-10.1 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag prevrange x
+} -returnCodes error -result {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}
+test textTag-10.2 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag prevrange x 1 2 3
+} -returnCodes error -result {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}
+test textTag-10.3 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag prevrange foo end
+} -cleanup {
+    .t tag delete x
+} -returnCodes ok -result {}
+test textTag-10.4 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
+    .t tag prevrange x foo
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {bad text index "foo"}
+test textTag-10.5 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
+    .t tag prevrange x end bar
+} -cleanup {
+    .t tag delete x
+} -returnCodes error -result {bad text index "bar"}
+test textTag-10.6 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag prevrange x end
-} {7.2 7.3}
-test textTag-10.7 {TkTextTagCmd - "prevrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {7.2 7.3}
+test textTag-10.7 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag prevrange x 2.4
-} {2.3 2.5}
-test textTag-10.8 {TkTextTagCmd - "prevrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.3 2.5}
+test textTag-10.8 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag prevrange x 2.5
-} {2.3 2.5}
-test textTag-10.9 {TkTextTagCmd - "prevrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.3 2.5}
+test textTag-10.9 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag prevrange x 2.9
-} {2.3 2.5}
-test textTag-10.10 {TkTextTagCmd - "prevrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.3 2.5}
+test textTag-10.10 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag prevrange x 2.9 2.6
-} {}
-test textTag-10.11 {TkTextTagCmd - "prevrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {}
+test textTag-10.11 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag prevrange x 2.9 2.5
-} {}
-test textTag-10.12 {TkTextTagCmd - "prevrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {}
+test textTag-10.12 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag prevrange x 2.9 2.3
-} {2.3 2.5}
-test textTag-10.13 {TkTextTagCmd - "prevrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.3 2.5}
+test textTag-10.13 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag prevrange x 7.0
-} {2.9 3.1}
-test textTag-10.14 {TkTextTagCmd - "prevrange" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.9 3.1}
+test textTag-10.14 {TkTextTagCmd - "prevrange" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete x
+} -body {
+    .t tag add x 2.3 2.5
+    .t tag add x 2.9 3.1
+    .t tag add x 7.2
     .t tag prevrange x 2.3
-} {}
-
-test textTag-11.1 {TkTextTagCmd - "raise" option} haveCourier12 {
-    list [catch {.t tag raise} msg] $msg
-} {1 {wrong # args: should be ".t tag raise tagName ?aboveThis?"}}
-test textTag-11.2 {TkTextTagCmd - "raise" option} haveCourier12 {
-    list [catch {.t tag raise foo} msg] $msg
-} {1 {tag "foo" isn't defined in text widget}}
-test textTag-11.3 {TkTextTagCmd - "raise" option} haveCourier12 {
-    list [catch {.t tag raise sel bar} msg] $msg
-} {1 {tag "bar" isn't defined in text widget}}
-test textTag-11.4 {TkTextTagCmd - "raise" option} haveCourier12 {
-    tagsetup
+} -cleanup {
+    .t tag delete x
+} -result {}
+
+
+test textTag-11.1 {TkTextTagCmd - "raise" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag raise
+} -returnCodes error -result {wrong # args: should be ".t tag raise tagName ?aboveThis?"}
+test textTag-11.2 {TkTextTagCmd - "raise" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag raise foo
+} -returnCodes error -result {tag "foo" isn't defined in text widget}
+test textTag-11.3 {TkTextTagCmd - "raise" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag raise sel bar
+} -returnCodes error -result {tag "bar" isn't defined in text widget}
+test textTag-11.4 {TkTextTagCmd - "raise" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete {*}[.t tag names]
+    .t tag remove sel 1.0 end
+    foreach i {a b c d} {
+        .t tag configure $i -background black
+    }
+} -body {
     .t tag raise c
     .t tag names
-} {sel a b d c}
-test textTag-11.5 {TkTextTagCmd - "raise" option} haveCourier12 {
-    tagsetup
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -result {sel a b d c}
+test textTag-11.5 {TkTextTagCmd - "raise" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete {*}[.t tag names]
+    .t tag remove sel 1.0 end
+    foreach i {a b c d} {
+        .t tag configure $i -background black
+    }
+} -body {
     .t tag raise d b
     .t tag names
-} {sel a b d c}
-test textTag-11.6 {TkTextTagCmd - "raise" option} haveCourier12 {
-    tagsetup
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -result {sel a b d c}
+test textTag-11.6 {TkTextTagCmd - "raise" option} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete {*}[.t tag names]
+    .t tag remove sel 1.0 end
+    foreach i {a b c d} {
+        .t tag configure $i -background black
+    }
+} -body {
     .t tag raise a c
     .t tag names
-} {sel b c a d}
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -result {sel b c a d}
 
-test textTag-12.1 {TkTextTagCmd - "ranges" option} haveCourier12 {
-    list [catch {.t tag ranges} msg] $msg
-} {1 {wrong # args: should be ".t tag ranges tagName"}}
-test textTag-12.2 {TkTextTagCmd - "ranges" option} haveCourier12 {
+
+test textTag-12.1 {TkTextTagCmd - "ranges" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag ranges
+} -returnCodes error -result {wrong # args: should be ".t tag ranges tagName"}
+test textTag-12.2 {TkTextTagCmd - "ranges" option} -constraints {
+    haveCourier12 
+} -body {
     .t tag delete x
     .t tag ranges x
-} {}
-test textTag-12.3 {TkTextTagCmd - "ranges" option} haveCourier12 {
+} -result {}
+test textTag-12.3 {TkTextTagCmd - "ranges" option} -constraints {
+    haveCourier12 
+} -setup {
     .t tag delete x
+} -body {
     .t tag add x 2.2
     .t tag add x 2.7 4.15
     .t tag add x 5.2 5.5
     .t tag ranges x
-} {2.2 2.3 2.7 4.6 5.2 5.5}
-test textTag-12.4 {TkTextTagCmd - "ranges" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.2 2.3 2.7 4.6 5.2 5.5}
+test textTag-12.4 {TkTextTagCmd - "ranges" option} -constraints {
+    haveCourier12 
+} -setup {
     .t tag delete x
+} -body {
     .t tag add x 1.0 3.0
     .t tag add x 4.0 end
     .t tag ranges x
-} {1.0 3.0 4.0 8.0}
+} -cleanup {
+    .t tag delete x
+} -result {1.0 3.0 4.0 8.0}
 
-test textTag-13.1 {TkTextTagCmd - "remove" option} haveCourier12 {
-    list [catch {.t tag remove} msg] $msg
-} {1 {wrong # args: should be ".t tag remove tagName index1 ?index2 index1 index2 ...?"}}
-test textTag-13.2 {TkTextTagCmd - "remove" option} haveCourier12 {
+
+test textTag-13.1 {TkTextTagCmd - "remove" option} -constraints {
+    haveCourier12 
+} -body {
+    .t tag remove
+} -returnCodes error -result {wrong # args: should be ".t tag remove tagName index1 ?index2 index1 index2 ...?"}
+test textTag-13.2 {TkTextTagCmd - "remove" option} -constraints {
+    haveCourier12 
+} -setup {
     .t tag delete x
+} -body {
     .t tag add x 2.2 2.11
     .t tag remove x 2.3 2.7
     .t tag ranges x
-} {2.2 2.3 2.7 2.11}
-test textTag-13.3 {TkTextTagCmd - "remove" option} haveCourier12 {
+} -cleanup {
+    .t tag delete x
+} -result {2.2 2.3 2.7 2.11}
+test textTag-13.3 {TkTextTagCmd - "remove" option} -constraints {
+    haveCourier12 
+} -setup {
+    destroy .t.e
+} -body {
+    entry .t.e
+    .t.e insert 0 "Text"
     .t configure -exportselection 1
     .t tag remove sel 1.0 end
     .t tag add sel 2.4 3.3
     .t.e select to 4
     .t tag remove sel 2.7 3.1
     selection get
-} Text
+} -cleanup {
+    destroy .t.e
+} -result {Text}
 
-.t tag delete x a b c d
-test textTag-14.1 {SortTags} haveCourier12 {
+
+test textTag-14.1 {SortTags} -constraints haveCourier12 -setup {
+    .t tag delete a b c d
+} -body {
     foreach i {a b c d} {
-	.t tag add $i 2.0 2.2
+        .t tag add $i 2.0 2.2
     }
     .t tag names 2.1
-} {a b c d}
+} -cleanup {
+    .t tag delete a b c d
+} -result {a b c d}
 .t tag delete a b c d
-test textTag-14.2 {SortTags} haveCourier12 {
+test textTag-14.2 {SortTags} -constraints haveCourier12 -setup {
+    .t tag delete a b c d
+} -body {
     foreach i {a b c d} {
-	.t tag configure $i -background black
+        .t tag configure $i -background black
     }
     foreach i {d c b a} {
-	.t tag add $i 2.0 2.2
+        .t tag add $i 2.0 2.2
     }
     .t tag names 2.1
-} {a b c d}
-.t tag delete x a b c d
-test textTag-14.3 {SortTags} haveCourier12 {
+} -cleanup {
+    .t tag delete a b c d
+} -result {a b c d}
+test textTag-14.3 {SortTags} -constraints haveCourier12 -setup {
+    .t tag delete {*}[.t tag names]
+} -body {
     for {set i 0} {$i < 30} {incr i} {
-	.t tag add x$i 2.0 2.2
+        .t tag add x$i 2.0 2.2
     }
     .t tag names 2.1
-} {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29}
-test textTag-14.4 {SortTags} haveCourier12 {
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -result {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29}
+test textTag-14.4 {SortTags} -constraints haveCourier12 -setup {
+    .t tag delete {*}[.t tag names]
+} -body {
     for {set i 0} {$i < 30} {incr i} {
-	.t tag configure x$i -background black
+        .t tag configure x$i -background black
     }
     for {set i 29} {$i >= 0} {incr i -1} {
-	.t tag add x$i 2.0 2.2
+        .t tag add x$i 2.0 2.2
     }
     .t tag names 2.1
-} {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29}
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -result {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29}
+
+
 
-foreach tag [.t tag names] {
-    catch {.t tag delete $tag}
-}
 set c [.t bbox 2.1]
 set x1 [expr [lindex $c 0] + [lindex $c 2]/2]
 set y1 [expr [lindex $c 1] + [lindex $c 3]/2]
@@ -587,7 +1336,9 @@ set c [.t bbox 4.3]
 set x3 [expr [lindex $c 0] + [lindex $c 2]/2]
 set y3 [expr [lindex $c 1] + [lindex $c 3]/2]
 
-test textTag-15.1 {TkTextBindProc} haveCourier12 {
+test textTag-15.1 {TkTextBindProc} -constraints haveCourier12 -setup {
+    .t tag delete x y
+} -body {
     bind .t <ButtonRelease> {lappend x up}
     .t tag bind x <ButtonRelease> {lappend x x-up}
     .t tag bind y <ButtonRelease> {lappend x y-up}
@@ -603,12 +1354,15 @@ test textTag-15.1 {TkTextBindProc} haveCourier12 {
     event gen .t <Button> -x $x2 -y $y2
     event gen .t <Motion> -x $x3 -y $y3
     event gen .t <ButtonRelease> -x $x3 -y $y3
+    return $x
+} -cleanup {
+    .t tag delete x y
     bind .t <ButtonRelease> {}
-    set x
-} {x-up up up y-up up}
-test textTag-15.2 {TkTextBindProc} haveCourier12 {
-    catch {.t tag delete x}
-    catch {.t tag delete y}
+} -result {x-up up up y-up up}
+
+test textTag-15.2 {TkTextBindProc} -constraints haveCourier12 -setup {
+    .t tag delete x y
+} -body {
     .t tag bind x <Enter> {lappend x x-enter}
     .t tag bind x <ButtonPress> {lappend x x-down}
     .t tag bind x <ButtonRelease> {lappend x x-up}
@@ -628,11 +1382,14 @@ test textTag-15.2 {TkTextBindProc} haveCourier12 {
     event gen .t <Motion> -x $x3 -y $y3 -state 0x100
     lappend x |
     event gen .t <ButtonRelease> -x $x3 -y $y3
-    set x
-} {x-enter | x-down | | x-up x-leave y-enter}
-test textTag-15.3 {TkTextBindProc} haveCourier12 {
-    catch {.t tag delete x}
-    catch {.t tag delete y}
+    return $x
+} -cleanup {
+    .t tag delete x y
+} -result {x-enter | x-down | | x-up x-leave y-enter}
+
+test textTag-15.3 {TkTextBindProc} -constraints haveCourier12 -setup {
+    .t tag delete x y
+} -body {
     .t tag bind x <Enter> {lappend x x-enter}
     .t tag bind x <Any-ButtonPress-1> {lappend x x-down}
     .t tag bind x <Any-ButtonRelease-1> {lappend x x-up}
@@ -656,14 +1413,17 @@ test textTag-15.3 {TkTextBindProc} haveCourier12 {
     event gen .t <ButtonRelease-1> -x $x3 -y $y3 -state 0x300
     lappend x |
     event gen .t <ButtonRelease-2> -x $x3 -y $y3 -state 0x200
-    set x
-} {x-enter | x-down | | | x-up | x-leave y-enter}
-
-foreach tag [.t tag names] {
-    catch {.t tag delete $tag}
-}
-.t tag configure big -font $bigFont
-test textTag-16.1 {TkTextPickCurrent procedure} haveCourier12 {
+    return $x
+} -cleanup {
+    .t tag delete x y
+} -result {x-enter | x-down | | | x-up | x-leave y-enter}
+
+
+test textTag-16.1 {TkTextPickCurrent procedure} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete {*}[.t tag names]
+} -body {
     event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1
     set x [.t index current]
     event gen .t <Motion> -x $x2 -y $y2
@@ -678,23 +1438,34 @@ test textTag-16.1 {TkTextPickCurrent procedure} haveCourier12 {
     lappend x [.t index current]
     event gen .t <ButtonRelease-1> -state 0x100 -x $x3 -y $y3
     lappend x [.t index current]
-} {2.1 3.2 3.2 3.2 3.2 3.2 4.3}
-test textTag-16.2 {TkTextPickCurrent procedure} haveCourier12 {
+} -result {2.1 3.2 3.2 3.2 3.2 3.2 4.3}
+
+test textTag-16.2 {TkTextPickCurrent procedure} -constraints {
+    haveCourier12 
+} -setup {
+    .t tag delete {*}[.t tag names]
+} -body {
+    .t tag configure big -font $bigFont
     event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1
     event gen .t <Motion> -x $x2 -y $y2
     set x [.t index current]
     .t tag add big 3.0
     update
     lappend x [.t index current]
-} {3.2 3.1}
-.t tag remove big 1.0 end
-foreach i {a b c d} {
-    .t tag bind $i <Enter> "lappend x enter-$i"
-    .t tag bind $i <Leave> "lappend x leave-$i"
-}
-test textTag-16.3 {TkTextPickCurrent procedure} haveCourier12 {
+} -cleanup {
+    .t tag delete big
+} -result {3.2 3.1}
+
+test textTag-16.3 {TkTextPickCurrent procedure} -constraints {
+    haveCourier12 
+} -setup {
     foreach i {a b c d} {
-	.t tag remove $i 1.0 end
+        .t tag remove $i 1.0 end
+    }
+} -body {
+    foreach i {a b c d} {
+        .t tag bind $i <Enter> "lappend x enter-$i"
+        .t tag bind $i <Leave> "lappend x leave-$i"
     }
     .t tag lower b
     .t tag lower a
@@ -708,11 +1479,21 @@ test textTag-16.3 {TkTextPickCurrent procedure} haveCourier12 {
     event gen .t <Motion> -x $x2 -y $y2
     lappend x |
     event gen .t <Motion> -x $x3 -y $y3
-    set x
-} {enter-a enter-b | leave-b enter-c | leave-a leave-c}
-test textTag-16.4 {TkTextPickCurrent procedure} haveCourier12 {
+    return $x
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -result {enter-a enter-b | leave-b enter-c | leave-a leave-c}
+
+test textTag-16.4 {TkTextPickCurrent procedure} -constraints {
+    haveCourier12 
+} -setup {
     foreach i {a b c d} {
-	.t tag remove $i 1.0 end
+        .t tag remove $i 1.0 end
+    }
+} -body {
+    foreach i {a b c d} {
+        .t tag bind $i <Enter> "lappend x enter-$i"
+        .t tag bind $i <Leave> "lappend x leave-$i"
     }
     .t tag lower b
     .t tag lower a
@@ -725,55 +1506,82 @@ test textTag-16.4 {TkTextPickCurrent procedure} haveCourier12 {
     lappend x |
     .t tag lower c
     event gen .t <Motion> -x $x2 -y $y2
-    set x
-} {enter-a enter-b enter-c | leave-c leave-b}
-foreach i {a b c d} {
-    .t tag delete $i
-}
-test textTag-16.5 {TkTextPickCurrent procedure} haveCourier12 {
-    foreach i {a b c d} {
-	.t tag remove $i 1.0 end
+    return $x
+} -cleanup {
+    .t tag delete {*}[.t tag names]
+} -result {enter-a enter-b enter-c | leave-c leave-b}
+
+test textTag-16.5 {TkTextPickCurrent procedure} -constraints {
+    haveCourier12 
+} -setup {
+    foreach i {big a b c d} {
+        .t tag remove $i 1.0 end
     }
+} -body {
+    .t tag configure big -font $bigFont
     event gen .t <Motion> -x $x1 -y $y1
     .t tag bind a <Enter> {.t tag add big 3.0 3.2}
     .t tag add a 3.2
     event gen .t <Motion> -x $x2 -y $y2
     .t index current
-} {3.2}
-test textTag-16.6 {TkTextPickCurrent procedure} haveCourier12 {
-    foreach i {a b c d} {
-	.t tag remove $i 1.0 end
+} -cleanup {
+    .t tag delete a big
+} -result {3.2}
+
+test textTag-16.6 {TkTextPickCurrent procedure} -constraints {
+    haveCourier12 
+} -setup {
+    foreach i {big a b c d} {
+        .t tag remove $i 1.0 end
     }
+} -body {
+    .t tag configure big -font $bigFont
     event gen .t <Motion> -x $x1 -y $y1
     .t tag bind a <Enter> {.t tag add big 3.0 3.2}
     .t tag add a 3.2
     event gen .t <Motion> -x $x2 -y $y2
     update
     .t index current
-} {3.1}
-test textTag-16.7 {TkTextPickCurrent procedure} haveCourier12 {
-    foreach i {a b c d} {
-	.t tag remove $i 1.0 end
+} -cleanup {
+    .t tag delete a big
+} -result {3.1}
+
+test textTag-16.7 {TkTextPickCurrent procedure} -constraints {
+    haveCourier12 
+} -setup {
+    foreach i {big a b c d} {
+        .t tag remove $i 1.0 end
     }
+} -body {
+    .t tag configure big -font $bigFont
+    .t tag bind a <Enter> {.t tag add big 3.0 3.2}
+    .t tag add a 3.2
+
     event gen .t <Motion> -x $x1 -y $y1
     .t tag bind a <Leave> {.t tag add big 3.0 3.2}
     .t tag add a 2.1
     event gen .t <Motion> -x $x2 -y $y2
+    update
     .t index current
-} {3.1}
+} -cleanup {
+    .t tag delete a big
+} -result {3.1}
+
 
-test textTag-17.1 {insert procedure inserts tags} {
+test textTag-17.1 {insert procedure inserts tags} -setup {
     .t delete 1.0 end
+} -body {
     # Objectification of the text widget had a problem
     # with inserting tags when using 'end'. Check that
     # bug has been fixed.
     .t insert end abcd {x} \n {} efgh {y} \n {}
     .t dump -tag 1.0 end
-} {tagon x 1.0 tagoff x 1.4 tagon y 2.0 tagoff y 2.4}
+} -result {tagon x 1.0 tagoff x 1.4 tagon y 2.0 tagoff y 2.4}
 
-catch {destroy .t}
 
-test textTag-18.1 {TkTextPickCurrent tag bindings} {
+test textTag-18.1 {TkTextPickCurrent tag bindings} -setup {
+    destroy .t
+} -body {
     text .t -width 30 -height 4 -relief sunken -borderwidth 10 \
       -highlightthickness 10 -pady 2
     pack .t
@@ -794,11 +1602,18 @@ test textTag-18.1 {TkTextPickCurrent tag bindings} {
     event gen .t <Motion> -warp 1 -x 20 -y 20 ; update
     event gen .t <Motion> -warp 1 -x 10 -y 10 ; update
     event gen .t <Motion> -warp 1 -x 25 -y 25 ; update
-    set res
-} {Enter {25 25 tag-Enter} {20 20 tag-Leave} {25 25 tag-Enter}}
+    return $res
+} -cleanup {
+    destroy .t
+} -result {Enter {25 25 tag-Enter} {20 20 tag-Leave} {25 25 tag-Enter}}
 
-catch {destroy .t}
+destroy .t
 
 # cleanup
 cleanupTests
 return
+
+
+
+
+
diff --git a/tests/unixMenu.test b/tests/unixMenu.test
index a56b62e..e354006 100644
--- a/tests/unixMenu.test
+++ b/tests/unixMenu.test
@@ -7,476 +7,650 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: unixMenu.test,v 1.10 2007/05/09 12:52:44 das Exp $
+# RCS: @(#) $Id: unixMenu.test,v 1.11 2008/08/28 08:52:07 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
-test unixMenu-1.1 {TkpNewMenu - normal menu} unix {
-    catch {destroy .m1}
-    list [catch {menu .m1} msg] $msg [destroy .m1]
-} {0 .m1 {}}
-test unixMenu-1.2 {TkpNewMenu - help menu} unix {
-    catch {destroy .m1}
+
+test unixMenu-1.1 {TkpNewMenu - normal menu} -constraints unix -setup {
+    destroy .m1
+} -body {
+    list [menu .m1] [destroy .m1]
+} -returnCodes ok -result {.m1 {}}
+test unixMenu-1.2 {TkpNewMenu - help menu} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     . configure -menu .m1
     .m1 add cascade -label Help -menu .m1.help
-    list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 .m1.help {} {}}
+    list [menu .m1.help] [. configure -menu ""] [destroy .m1]
+} -returnCodes ok -result {.m1.help {} {}}
+
+
+test unixMenu-2.1 {TkpDestroyMenu - nothing to do} -constraints unix -body {}
 
-test unixMenu-2.1 {TkpDestroyMenu - nothing to do} {} {}
-test unixMenu-3.1 {TkpDestroymenuEntry - nothing to do} {} {}
 
-test unixMenu-4.1 {TkpConfigureMenuEntry - non-cascade entry} unix {
-    catch {destroy .m1}
+test unixMenu-3.1 {TkpDestroymenuEntry - nothing to do} -constraints unix -body {}
+
+
+test unixMenu-4.1 {TkpConfigureMenuEntry - non-cascade entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add command -label test
-    list [catch {.m1 entryconfigure test -label foo} msg] $msg [destroy .m1]
-} {0 {} {}}
-test unixMenu-4.2 {TkpConfigureMenuEntry - cascade entry} unix {
-    catch {destroy .m1}
+    list [.m1 entryconfigure test -label foo] [destroy .m1]
+} -returnCodes ok -result {{} {}}
+test unixMenu-4.2 {TkpConfigureMenuEntry - cascade entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -menu .m2 -label test
     menu .m1.foo -tearoff 0
-    list [catch {.m1 entryconfigure test -menu .m1.foo} msg] $msg [destroy .m1]
-} {0 {} {}}
+    list [.m1 entryconfigure test -menu .m1.foo] [destroy .m1]
+} -returnCodes ok -result {{} {}}
+
 
-test unixMenu-5.1 {TkpMenuNewEntry - nothing to do} {} {}
+test unixMenu-5.1 {TkpMenuNewEntry - nothing to do} -constraints unix -body {}
 
-test unixMenu-6.1 {TkpSetWindowMenuBar - null menu} unix {
-    catch {destroy .m1}
+
+test unixMenu-6.1 {TkpSetWindowMenuBar - null menu} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add cascade -label foo
     . configure -menu .m1
-    list [catch {. configure -menu ""} msg] $msg [destroy .m1]
-} {0 {} {}}
-test unixMenu-6.2 {TkpSetWindowMenuBar - menu} unix {
-    catch {destroy .m1}
+    list [. configure -menu ""] [destroy .m1]
+} -returnCodes ok -result {{} {}}
+test unixMenu-6.2 {TkpSetWindowMenuBar - menu} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add cascade -label foo
-    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
+    list [. configure -menu .m1] [. configure -menu ""] [destroy .m1]
+} -returnCodes ok -result {{} {} {}}
+
+
+test unixMenu-7.1 {TkpSetMainMenubar - nothing to do} -constraints unix -body {}
 
-test unixMenu-7.1 {TkpSetMainMenubar - nothing to do} {} {}
 
-test unixMenu-8.1 {GetMenuIndicatorGeometry - indicator off} unix {
-    catch {destroy .m1}
+test unixMenu-8.1 {GetMenuIndicatorGeometry - indicator off} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add checkbutton -label foo -indicatoron 0
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test unixMenu-8.2 {GetMenuIndicatorGeometry - not checkbutton or radio} unix {
-    catch {destroy .m1}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -returnCodes ok
+test unixMenu-8.2 {GetMenuIndicatorGeometry - not checkbutton or radio} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test unixMenu-8.3 {GetMenuIndicatorGeometry - checkbutton image} {unix testImageType} {
-    catch {destroy .m1}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -returnCodes ok
+test unixMenu-8.3 {GetMenuIndicatorGeometry - checkbutton image} -constraints {
+    unix testImageType
+} -setup {
+    destroy .m1
     catch {image delete image1}
+} -body {
     menu .m1
     image create test image1
     .m1 add checkbutton -image image1 -label foo
     .m1 invoke foo
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] [image delete image1]
-} {0 {} {}}
-test unixMenu-8.4 {GetMenuIndicatorGeometry - checkbutton bitmap} unix {
-    catch {destroy .m1}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -cleanup {
+    image delete image1
+} -returnCodes ok 
+test unixMenu-8.4 {GetMenuIndicatorGeometry - checkbutton bitmap} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add checkbutton -bitmap questhead -label foo
     .m1 invoke foo
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test unixMenu-8.5 {GetMenuIndicatorGeometry - checkbutton} unix {
-    catch {destroy .m1}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -returnCodes ok
+test unixMenu-8.5 {GetMenuIndicatorGeometry - checkbutton} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add checkbutton -label foo
     .m1 invoke foo
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test unixMenu-8.6 {GetMenuIndicatorGeometry - radiobutton image} {unix testImageType} {
-    catch {destroy .m1}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -returnCodes ok
+test unixMenu-8.6 {GetMenuIndicatorGeometry - radiobutton image} -constraints {
+    unix testImageType
+} -setup {
+    destroy .m1
     catch {image delete image1}
+} -body {
     menu .m1
     image create test image1
     .m1 add radiobutton -image image1 -label foo
     .m1 invoke foo
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] [image delete image1]
-} {0 {} {}}
-test unixMenu-8.7 {GetMenuIndicatorGeometry - radiobutton bitmap} unix {
-    catch {destroy .m1}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+    image delete image1
+} -returnCodes ok
+test unixMenu-8.7 {GetMenuIndicatorGeometry - radiobutton bitmap} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add radiobutton -bitmap questhead -label foo
     .m1 invoke foo
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test unixMenu-8.8 {GetMenuIndicatorGeometry - radiobutton} unix {
-    catch {destroy .m1}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -returnCodes ok 
+test unixMenu-8.8 {GetMenuIndicatorGeometry - radiobutton} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add radiobutton -label foo
     .m1 invoke foo
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test unixMenu-8.9 {GetMenuIndicatorGeometry - hideMargin} unix {
-    catch {destroy .m1}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -returnCodes ok
+test unixMenu-8.9 {GetMenuIndicatorGeometry - hideMargin} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add radiobutton -label foo -hidemargin 1
     .m1 invoke foo
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -returnCodes ok 
 
-test unixMenu-9.1 {GetMenuAccelGeometry - cascade entry} unix {
-    catch {destroy .m1}
+
+test unixMenu-9.1 {GetMenuAccelGeometry - cascade entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add cascade -label foo
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test unixMenu-9.2 {GetMenuAccelGeometry - non-null label} unix {
-    catch {destroy .m1}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -returnCodes ok
+test unixMenu-9.2 {GetMenuAccelGeometry - non-null label} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo -accel "Ctrl+S"
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
-test unixMenu-9.3 {GetMenuAccelGeometry - null label} unix {
-    catch {destroy .m1}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -returnCodes ok
+test unixMenu-9.3 {GetMenuAccelGeometry - null label} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -returnCodes ok
+
 
-test unixMenu-10.1 {DrawMenuEntryBackground - active menubar} unix {
-    catch {destroy .m1}
+test unixMenu-10.1 {DrawMenuEntryBackground - active menubar} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add cascade -label foo
     . configure -menu .m1
     .m1 activate 1
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-10.2 {DrawMenuEntryBackground - active} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -returnCodes ok -result {{} {} {}}
+test unixMenu-10.2 {DrawMenuEntryBackground - active} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
     $tearoff activate 0
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test unixMenu-10.3 {DrawMenuEntryBackground - non-active} unix {
-    catch {destroy .m1}
+    list [update] [destroy .m1]
+} -returnCodes ok -result {{} {}}
+test unixMenu-10.3 {DrawMenuEntryBackground - non-active} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
+    list [update] [destroy .m1]
+} -returnCodes ok -result {{} {}}
+
 
-test unixMenu-11.1 {DrawMenuEntryAccelerator - menubar} unix {
-    catch {destroy .m1}
+test unixMenu-11.1 {DrawMenuEntryAccelerator - menubar} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo -accel "Ctrl+U"
     . configure -menu .m1
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
 # drawArrow parameter is never false under Unix
-test unixMenu-11.2 {DrawMenuEntryAccelerator - cascade entry} unix {
-    catch {destroy .m1}
+test unixMenu-11.2 {DrawMenuEntryAccelerator - cascade entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add cascade -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test unixMenu-11.3 {DrawMenuEntryAccelerator - normal entry} unix {
-    catch {destroy .m1}
+    list [update] [destroy .m1]
+}  -result {{} {}}
+test unixMenu-11.3 {DrawMenuEntryAccelerator - normal entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo -accel "Ctrl+U"
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test unixMenu-11.4 {DrawMenuEntryAccelerator - null entry} unix {
-    catch {destroy .m1}
+    list [update] [destroy .m1]
+} -result {{} {}}
+test unixMenu-11.4 {DrawMenuEntryAccelerator - null entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
+    list [update] [destroy .m1]
+} -result {{} {}}
+
 
-test unixMenu-12.1 {DrawMenuEntryIndicator - non-check or radio} unix {
-    catch {destroy .m1}
+test unixMenu-12.1 {DrawMenuEntryIndicator - non-check or radio} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test unixMenu-12.2 {DrawMenuEntryIndicator - checkbutton - indicator off} unix {
-    catch {destroy .m1}
+    list [update] [destroy .m1]
+} -result {{} {}}
+test unixMenu-12.2 {DrawMenuEntryIndicator - checkbutton - indicator off} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add checkbutton -label foo -indicatoron 0
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test unixMenu-12.3 {DrawMenuEntryIndicator - checkbutton - not selected} unix {
-    catch {destroy .m1}
+    list [update] [destroy .m1]
+} -result {{} {}}
+test unixMenu-12.3 {DrawMenuEntryIndicator - checkbutton - not selected} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add checkbutton -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test unixMenu-12.4 {DrawMenuEntryIndicator - checkbutton - selected} unix {
-    catch {destroy .m1}
+    list [update] [destroy .m1]
+} -result {{} {}}
+test unixMenu-12.4 {DrawMenuEntryIndicator - checkbutton - selected} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add checkbutton -label foo
     .m1 invoke 1
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test unixMenu-12.5 {DrawMenuEntryIndicator - radiobutton - indicator off} unix {
-    catch {destroy .m1}
+    list [update] [destroy .m1]
+} -result {{} {}}
+test unixMenu-12.5 {DrawMenuEntryIndicator - radiobutton - indicator off} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add radiobutton -label foo -indicatoron 0
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test unixMenu-12.6 {DrawMenuEntryIndicator - radiobutton - not selected} unix {
-    catch {destroy .m1}
+    list [update] [destroy .m1]
+} -result {{} {}}
+test unixMenu-12.6 {DrawMenuEntryIndicator - radiobutton - not selected} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add radiobutton -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
-test unixMenu-12.7 {DrawMenuEntryIndicator - radiobutton - selected} unix {
-    catch {destroy .m1}
+    list [update] [destroy .m1]
+} -result {{} {}}
+test unixMenu-12.7 {DrawMenuEntryIndicator - radiobutton - selected} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add radiobutton -label foo
     .m1 invoke 1
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
+    list [update] [destroy .m1]
+} -result {{} {}}
+
 
-test unixMenu-13.1 {DrawMenuSeparator - menubar case} unix {
-    catch {destroy .m1}
+test unixMenu-13.1 {DrawMenuSeparator - menubar case} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add separator
     . configure -menu .m1
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-13.2 {DrawMenuSepartor - normal menu} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-13.2 {DrawMenuSepartor - normal menu} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add separator
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
+    list [update] [destroy .m1]
+} -result {{} {}}
+
 
-test unixMenu-14.1 {DrawMenuEntryLabel} unix {
-    catch {destroy .m1}
+test unixMenu-14.1 {DrawMenuEntryLabel} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
+    list [update] [destroy .m1]
+} -result {{} {}}
 
-test unixMenu-15.1 {DrawMenuUnderline - menubar} unix {
-    catch {destroy .m1}
+
+test unixMenu-15.1 {DrawMenuUnderline - menubar} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo -underline 0
     . configure -menu .m1
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-15.2 {DrawMenuUnderline - no menubar} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-15.2 {DrawMenuUnderline - no menubar} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo -underline 0
     set tearoff [tk::TearOffMenu .m1 40 40]
-    list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
+    list [update] [destroy .m1]
+} -result {{} {}}
+
 
-test unixMenu-16.1 {TkpPostMenu} unix {
-    catch {destroy .m1}
+test unixMenu-16.1 {TkpPostMenu} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -returnCodes ok
 
-test unixMenu-17.1 {GetMenuSeparatorGeometry} unix {
-    catch {destroy .m1}
+
+test unixMenu-17.1 {GetMenuSeparatorGeometry} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add separator
-    list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
-} {0 {}}
+    tk::TearOffMenu .m1 40 40
+    destroy .m1
+} -returnCodes ok
+
 
-test unixMenu-18.1 {GetTearoffEntryGeometry} {unix nonUnixUserInteraction} {
-    catch {destroy .m1}
+test unixMenu-18.1 {GetTearoffEntryGeometry} -constraints {
+    unix nonUnixUserInteraction
+} -setup {
+    destroy .mb
+} -body {
     menubutton .mb -text "test" -menu .mb.m
     menu .mb.m
     .mb.m add command -label test
     pack .mb
     raise .
-    list [catch {tk::MbPost .mb} msg] $msg [tk::MenuUnpost .mb.m] [destroy .mb]
-} {0 {} {} {}}
+    list [tk::MbPost .mb] [tk::MenuUnpost .mb.m] [destroy .mb]
+} -result {{} {} {}}
+
 
 # Don't know how to reproduce the case where the tkwin has been deleted.
-test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} unix {
-    catch {destroy .m1}
+
+test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     . configure -menu .m1
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
 # Don't know how to generate one width windows
-test unixMenu-19.2 {TkpComputeMenubarGeometry - one entry} unix {
-    catch {destroy .m1}
+test unixMenu-19.2 {TkpComputeMenubarGeometry - one entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add cascade -label File
     . configure -menu .m1
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.3 {TkpComputeMenubarGeometry - entry with different font} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.3 {TkpComputeMenubarGeometry - entry with different font} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -font "Courier 24"
     .m1 add cascade -label File -font "Helvetica 18"
     . configure -menu .m1
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.4 {TkpComputeMenubarGeometry - separator} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.4 {TkpComputeMenubarGeometry - separator} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add separator
     . configure -menu .m1
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.5 {TkpComputeMenubarGeometry - First entry} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.5 {TkpComputeMenubarGeometry - First entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label File
     . configure -menu .m1
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.6 {TkpComputeMenubarGeometry - First entry too wide} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.6 {TkpComputeMenubarGeometry - First entry too wide} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label File -font "Times 72"
     . configure -menu .m1
     wm geometry . 10x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.7 {TkpComputeMenubarGeometry - two entries fit} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.7 {TkpComputeMenubarGeometry - two entries fit} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label File
     .m1 add cascade -label Edit
     . configure -menu .m1
     wm geometry . 200x200
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.8 {TkpComputeMenubarGeometry - two entries; 2nd don't fit} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.8 {TkpComputeMenubarGeometry - two entries; 2nd don't fit} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label File
     .m1 add cascade -label Edit -font "Times 72"
     . configure -menu .m1
     wm geometry . 100x100
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.9 {TkpComputeMenubarGeometry - two entries; 1st dont fit} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.9 {TkpComputeMenubarGeometry - two entries; 1st dont fit} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label File -font "Times 72"
     .m1 add cascade -label Edit
     . configure -menu .m1
     wm geometry . 100x100
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.10 {TkpComputeMenubarGeometry - two entries; neither fit} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.10 {TkpComputeMenubarGeometry - two entries; neither fit} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0 -font "Times 72"
     .m1 add cascade -label File
     .m1 add cascade -label Edit
     . configure -menu .m1
     wm geometry . 10x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
 # ABC notation; capital A means first window fits, small a means it
 # does not. capital B menu means second window fist, etc.
-test unixMenu-19.11 {TkpComputeMenubarGeometry - abc} unix {
-    catch {destroy .m1}
+test unixMenu-19.11 {TkpComputeMenubarGeometry - abc} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0 -font "Times 72"
     .m1 add cascade -label "aaaaa"
     .m1 add cascade -label "bbbbb"
     .m1 add cascade -label "ccccc"
     . configure -menu .m1
     wm geometry . 10x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.12 {TkpComputeMenubarGeometry - abC} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.12 {TkpComputeMenubarGeometry - abC} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label "aaaaa" -font "Times 72"
     .m1 add cascade -label "bbbbb" -font "Times 72"
     .m1 add cascade -label "C"
     . configure -menu .m1
     wm geometry . 10x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.13 {TkpComputeMenubarGeometry - aBc} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.13 {TkpComputeMenubarGeometry - aBc} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label "aaaaa" -font "Times 72"
     .m1 add cascade -label "B"
     .m1 add cascade -label "ccccc" -font "Times 72"
     . configure -menu .m1
     wm geometry . 10x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.14 {TkpComputeMenubarGeometry - aBC} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.14 {TkpComputeMenubarGeometry - aBC} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label "aaaaa" -font "Times 72"
     .m1 add cascade -label "B"
     .m1 add cascade -label "C"
     . configure -menu .m1
     wm geometry . 60x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.15 {TkpComputeMenubarGeometry - Abc} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.15 {TkpComputeMenubarGeometry - Abc} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label "A"
     .m1 add cascade -label "bbbbb" -font "Times 72"
     .m1 add cascade -label "ccccc" -font "Times 72"
     . configure -menu .m1
     wm geometry . 60x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.16 {TkpComputeMenubarGeometry - AbC} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.16 {TkpComputeMenubarGeometry - AbC} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label "A"
     .m1 add cascade -label "bbbbb" -font "Times 72"
     .m1 add cascade -label "C"
     . configure -menu .m1
     wm geometry . 60x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.17 {TkpComputeMenubarGeometry - ABc} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.17 {TkpComputeMenubarGeometry - ABc} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label "A"
     .m1 add cascade -label "B"
     .m1 add cascade -label "ccccc" -font "Times 72"
     . configure -menu .m1
     wm geometry . 60x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.18 {TkpComputeMenubarGeometry - ABC} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.18 {TkpComputeMenubarGeometry - ABC} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label "A"
     .m1 add cascade -label "B"
     .m1 add cascade -label "C"
     . configure -menu .m1
     wm geometry . 100x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.19 {TkpComputeMenubarGeometry - help menu in first position} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.19 {TkpComputeMenubarGeometry - help menu in first position} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label Help -menu .m1.help
     menu .m1.help -tearoff 0
@@ -486,10 +660,13 @@ test unixMenu-19.19 {TkpComputeMenubarGeometry - help menu in first position} un
     menu .m1.edit -tearoff 0
     . configure -menu .m1
     wm geometry . 100x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.20 {TkpComputeMenubarGeometry - help menu in middle} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.20 {TkpComputeMenubarGeometry - help menu in middle} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label Edit -menu .m1.edit
     menu .m1.edit -tearoff 0
@@ -499,10 +676,13 @@ test unixMenu-19.20 {TkpComputeMenubarGeometry - help menu in middle} unix {
     menu .m1.file -tearoff 0
     . configure -menu .m1
     wm geometry . 100x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.21 {TkpComputeMenubarGeometry - help menu in first position} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.21 {TkpComputeMenubarGeometry - help menu in first position} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label File -menu .m1.file
     menu .m1.file -tearoff 0
@@ -512,10 +692,13 @@ test unixMenu-19.21 {TkpComputeMenubarGeometry - help menu in first position} un
     menu .m1.help -tearoff 0
     . configure -menu .m1
     wm geometry . 100x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.22 {TkpComputeMenubarGeometry - help item fits} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.22 {TkpComputeMenubarGeometry - help item fits} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label File -menu .m1.file
     menu .m1.file -tearoff 0
@@ -523,10 +706,13 @@ test unixMenu-19.22 {TkpComputeMenubarGeometry - help item fits} unix {
     menu .m1.help -tearoff 0
     . configure -menu .m1
     wm geometry . 100x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.23 {TkpComputeMenubarGeometry - help item does not fit} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.23 {TkpComputeMenubarGeometry - help item does not fit} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label File -menu .m1.file
     menu .m1.file -tearoff 0
@@ -534,215 +720,283 @@ test unixMenu-19.23 {TkpComputeMenubarGeometry - help item does not fit} unix {
     menu .m1.help -tearoff 0
     . configure -menu .m1
     wm geometry . 100x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-19.24 {TkpComputeMenubarGeometry - help item only one} unix {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-19.24 {TkpComputeMenubarGeometry - help item only one} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label Help -menu .m1.help
     menu .m1.help -tearoff 0
     . configure -menu .m1
     wm geometry . 100x10
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+
 
-test unixMenu-20.1 {DrawTearoffEntry - menubar} unix {
-    catch {destroy .m1}
+test unixMenu-20.1 {DrawTearoffEntry - menubar} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add cascade -label File
     . configure -menu .m1
-    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 {} {} {}}
-test unixMenu-20.2 {DrawTearoffEntry - non-menubar} {unix nonUnixUserInteraction} {
-    catch {destroy .m1}
+    list [update] [. configure -menu ""] [destroy .m1]
+} -result {{} {} {}}
+test unixMenu-20.2 {DrawTearoffEntry - non-menubar} -constraints {
+    unix nonUnixUserInteraction
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
     .m1 post 40 40
-     list [catch {update} msg] $msg [destroy .m1]
-} {0 {} {}}
+    list [update] [destroy .m1]
+} -result {{} {}}
 
-test unixMenu-21.1 {TkpInitializeMenuBindings - nothing to do} {} {}
 
-test unixMenu-22.1 {SetHelpMenu - no menubars} unix {
-    catch {destroy .m1}
+test unixMenu-21.1 {TkpInitializeMenuBindings - nothing to do} -constraints unix -body {}
+
+
+test unixMenu-22.1 {SetHelpMenu - no menubars} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add cascade -label test -menu .m1.test
-    list [catch {menu .m1.test} msg] $msg [destroy .m1]
-} {0 .m1.test {}}
+    list [menu .m1.test] [destroy .m1]
+} -result {.m1.test {}}
 # Don't know how to automate missing tkwins
-test unixMenu-22.2 {SetHelpMenu - menubar but no help menu} unix {
-    catch {destroy .m1}
+test unixMenu-22.2 {SetHelpMenu - menubar but no help menu} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     . configure -menu .m1
     .m1 add cascade -label .m1.file
-    list [catch {menu .m1.file} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 .m1.file {} {}}
-test unixMenu-22.3 {SetHelpMenu - menubar with help menu} unix {
-    catch {destroy .m1}
+    list [menu .m1.file] [. configure -menu ""] [destroy .m1]
+} -result {.m1.file {} {}}
+test unixMenu-22.3 {SetHelpMenu - menubar with help menu} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     . configure -menu .m1
     .m1 add cascade -label .m1.help
-    list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1]
-} {0 .m1.help {} {}}
-test unixMenu-22.4 {SetHelpMenu - multiple menubars with same help menu} unix {
-    catch {destroy .m1}
-    catch {destroy .t2}
+    list [menu .m1.help] [. configure -menu ""] [destroy .m1]
+} -result {.m1.help {} {}}
+test unixMenu-22.4 {SetHelpMenu - multiple menubars with same help menu} -constraints {
+    unix 
+} -setup {
+    destroy .m1 .t2
+} -body {
     toplevel .t2
     wm geometry .t2 +40+40
     menu .m1 -tearoff 0
     . configure -menu .m1
     .t2 configure -menu .m1
     .m1 add cascade -label .m1.help
-    list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .t2]
-} {0 .m1.help {} {} {}}
+    list [menu .m1.help] [. configure -menu ""] [destroy .m1] [destroy .t2]
+} -result {.m1.help {} {} {}}
+
 
-test unixMenu-23.1 {TkpDrawMenuEntry - gc for active and not strict motif} unix {
-    catch {destroy .m1}
+test unixMenu-23.1 {TkpDrawMenuEntry - gc for active and not strict motif} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo -activeforeground red
     set tearoff [tk::TearOffMenu .m1 40 40]
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.3 {TkpDrawMenuEntry - gc for active and strict motif} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.3 {TkpDrawMenuEntry - gc for active and strict motif} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     set tk_strictMotif 1
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1] [set tk_strictMotif 0]
-} {{} {} 0}
-test unixMenu-23.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} unix {
-    catch {destroy .m1}
+} -result {{} {} 0}
+test unixMenu-23.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -disabledforeground blue
     .m1 add command -label foo -state disabled -background red
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -disabledforeground blue
     .m1 add command -label foo -state disabled
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -disabledforeground ""
     .m1 add command -label foo -state disabled
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.7 {TkpDrawMenuEntry - gc for normal - custom entry} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.7 {TkpDrawMenuEntry - gc for normal - custom entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo -foreground red
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.8 {TkpDrawMenuEntry - gc for normal} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.8 {TkpDrawMenuEntry - gc for normal} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.9 {TkpDrawMenuEntry - gc for indicator - custom entry} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.9 {TkpDrawMenuEntry - gc for indicator - custom entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add checkbutton -label foo -selectcolor orange
     .m1 invoke 1
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.10 {TkpDrawMenuEntry - gc for indicator} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.10 {TkpDrawMenuEntry - gc for indicator} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add checkbutton -label foo
     .m1 invoke 1
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.11 {TkpDrawMenuEntry - border - custom entry} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.11 {TkpDrawMenuEntry - border - custom entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo -activebackground green
     set tearoff [tk::TearOffMenu .m1 40 40]
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.12 {TkpDrawMenuEntry - border} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.12 {TkpDrawMenuEntry - border} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.13 {TkpDrawMenuEntry - active border - strict motif} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.13 {TkpDrawMenuEntry - active border - strict motif} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     set tk_strictMotif 1
     menu .m1
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1] [set tk_strictMotif 0]
-} {{} {} 0}
-test unixMenu-23.14 {TkpDrawMenuEntry - active border - custom entry} unix {
-    catch {destroy .m1}
+} -result {{} {} 0}
+test unixMenu-23.14 {TkpDrawMenuEntry - active border - custom entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo -activeforeground yellow
     set tearoff [tk::TearOffMenu .m1 40 40]
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.15 {TkpDrawMenuEntry - active border} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.15 {TkpDrawMenuEntry - active border} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.16 {TkpDrawMenuEntry - font - custom entry} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.16 {TkpDrawMenuEntry - font - custom entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo -font "Helvectica 72"
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.17 {TkpDrawMenuEntry - font} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.17 {TkpDrawMenuEntry - font} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1 -font "Courier 72"
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.18 {TkpDrawMenuEntry - separator} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.18 {TkpDrawMenuEntry - separator} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add separator
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.19 {TkpDrawMenuEntry - standard} unix {
-    catch {destroy .mb}
+} -result {{} {}}
+test unixMenu-23.19 {TkpDrawMenuEntry - standard} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label foo
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.20 {TkpDrawMenuEntry - disabled cascade item} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.20 {TkpDrawMenuEntry - disabled cascade item} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add cascade -label File -menu .m1.file
     menu .m1.file
@@ -750,140 +1004,192 @@ test unixMenu-23.20 {TkpDrawMenuEntry - disabled cascade item} unix {
     .m1 entryconfigure File -state disabled
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.21 {TkpDrawMenuEntry - indicator} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.21 {TkpDrawMenuEntry - indicator} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add checkbutton -label Foo
     .m1 invoke Foo
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
-test unixMenu-23.22 {TkpDrawMenuEntry - hide margin} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-23.22 {TkpDrawMenuEntry - hide margin} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add checkbutton -label Foo -hidemargin 1
     .m1 invoke Foo
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}
+} -result {{} {}}
 
-test unixMenu-24.1 {GetMenuLabelGeometry - image} {testImageType unix} {
-    catch {destroy .m1}
+
+test unixMenu-24.1 {GetMenuLabelGeometry - image} -constraints {
+    testImageType unix
+} -setup {
+    destroy .m1
     catch {image delete image1}
+} -body {
     menu .m1
     image create test image1
     .m1 add command -image image1
     list [update idletasks] [destroy .m1] [image delete image1]
-} {{} {} {}}
-test unixMenu-24.2 {GetMenuLabelGeometry - bitmap} unix {
-    catch {destroy .m1}
+} -result {{} {} {}}
+test unixMenu-24.2 {GetMenuLabelGeometry - bitmap} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -bitmap questhead
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-24.3 {GetMenuLabelGeometry - no text} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-24.3 {GetMenuLabelGeometry - no text} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-24.4 {GetMenuLabelGeometry - text} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-24.4 {GetMenuLabelGeometry - text} -constraints unix -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label "This is a test."
     list [update idletasks] [destroy .m1]
-} {{} {}}
+} -result {{} {}}
+
 
-test unixMenu-25.1 {TkpComputeStandardMenuGeometry - no entries} unix {
-    catch {destroy .m1}
+test unixMenu-25.1 {TkpComputeStandardMenuGeometry - no entries} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.2 {TkpComputeStandardMenuGeometry - one entry} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.2 {TkpComputeStandardMenuGeometry - one entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label "one"
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.3 {TkpComputeStandardMenuGeometry - more than one entry} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.3 {TkpComputeStandardMenuGeometry - more than one entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label "one"
     .m1 add command -label "two"
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.4 {TkpComputeStandardMenuGeometry - separator} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.4 {TkpComputeStandardMenuGeometry - separator} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add separator
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unix nonUnixUserInteraction} {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} -constraints {
+    unix nonUnixUserInteraction
+} -setup {
+    destroy .mb
+} -body {
     menubutton .mb -text "test" -menu .mb.m
     menu .mb.m
     .mb.m add command -label test
     pack .mb
     catch {tk::MbPost .mb}
     list [update] [tk::MenuUnpost .mb.m] [destroy .mb]
-} {{} {} {}}
-test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} unix {
-    catch {destroy .m1}
+} -result {{} {} {}}
+test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label "test"
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.7 {TkpComputeStandardMenuGeometry - different font for entry} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.7 {TkpComputeStandardMenuGeometry - different font for entry} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -font "Helvetica 12"
     .m1 add command -label "test" -font "Courier 12"
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.8 {TkpComputeStandardMenuGeometry - second entry larger} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.8 {TkpComputeStandardMenuGeometry - second entry larger} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label "test"
     .m1 add command -label "test test"
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.9 {TkpComputeStandardMenuGeometry - first entry larger} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.9 {TkpComputeStandardMenuGeometry - first entry larger} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label "test test"
     .m1 add command -label "test"
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.10 {TkpComputeStandardMenuGeometry - accelerator} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.10 {TkpComputeStandardMenuGeometry - accelerator} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label "test" -accel "Ctrl+S"
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.11 {TkpComputeStandardMenuGeometry - second accel larger} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.11 {TkpComputeStandardMenuGeometry - second accel larger} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label "test" -accel "1"
     .m1 add command -label "test" -accel "1 1"
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.12 {TkpComputeStandardMenuGeometry - second accel smaller} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.12 {TkpComputeStandardMenuGeometry - second accel smaller} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label "test" -accel "1 1"
     .m1 add command -label "test" -accel "1"
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.13 {TkpComputeStandardMenuGeometry - indicator} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.13 {TkpComputeStandardMenuGeometry - indicator} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add checkbutton -label test
     .m1 invoke 1
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.14 {TkpComputeStandardMenuGeometry - second indicator less or equal } {unix testImageType} {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.14 {TkpComputeStandardMenuGeometry - second indicator less or equal } -constraints {
+    unix testImageType
+} -setup {
+    destroy .m1
     catch {image delete image1}
+} -body {
     image create test image1
     menu .m1
     .m1 add checkbutton -image image1
@@ -891,10 +1197,13 @@ test unixMenu-25.14 {TkpComputeStandardMenuGeometry - second indicator less or e
     .m1 add checkbutton -label test
     .m1 invoke 2
     list [update idletasks] [destroy .m1] [image delete image1]
-} {{} {} {}}
-test unixMenu-25.15 {TkpComputeStandardMenuGeometry - second indicator larger } {unix testImageType} {
-    catch {destroy .m1}
+} -result {{} {} {}}
+test unixMenu-25.15 {TkpComputeStandardMenuGeometry - second indicator larger } -constraints {
+    unix testImageType
+} -setup {
+    destroy .m1
     catch {image delete image1}
+} -body {
     image create test image1
     menu .m1
     .m1 add checkbutton -image image1
@@ -902,30 +1211,42 @@ test unixMenu-25.15 {TkpComputeStandardMenuGeometry - second indicator larger }
     .m1 add checkbutton -label test
     .m1 invoke 2
     list [update idletasks] [destroy .m1] [image delete image1]
-} {{} {} {}}
-test unixMenu-25.16 {TkpComputeStandardMenuGeometry - zero sized menus} unix {
-    catch {destroy .m1}
+} -result {{} {} {}}
+test unixMenu-25.16 {TkpComputeStandardMenuGeometry - zero sized menus} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.17 {TkpComputeStandardMenuGeometry - first column bigger} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.17 {TkpComputeStandardMenuGeometry - first column bigger} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1
     .m1 add command -label one
     .m1 add command -label two
     .m1 add command -label three -columnbreak 1
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.18 {TkpComputeStandardMenuGeometry - second column bigger} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.18 {TkpComputeStandardMenuGeometry - second column bigger} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add command -label one
     .m1 add command -label two -columnbreak 1
     .m1 add command -label three
     list [update idletasks] [destroy .m1]
-} {{} {}}
-test unixMenu-25.19 {TkpComputeStandardMenuGeometry - three columns} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.19 {TkpComputeStandardMenuGeometry - three columns} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add command -label one
     .m1 add command -label two -columnbreak 1
@@ -934,17 +1255,23 @@ test unixMenu-25.19 {TkpComputeStandardMenuGeometry - three columns} unix {
     .m1 add command -label five -columnbreak 1
     .m1 add command -label six
     list [update idletasks] [destroy .m1]    
-} {{} {}}
-test unixMenu-25.20 {TkpComputeStandardMenuGeometry - hide margin} unix {
-    catch {destroy .m1}
+} -result {{} {}}
+test unixMenu-25.20 {TkpComputeStandardMenuGeometry - hide margin} -constraints {
+    unix 
+} -setup {
+    destroy .m1
+} -body {
     menu .m1 -tearoff 0
     .m1 add checkbutton -label one -hidemargin 1
     list [update idletasks] [destroy .m1]
-} {{} {}}
+} -result {{} {}}
+
+
+test unixMenu-26.1 {TkpMenuInit - nothing to do} -constraints unix -body {}
+
 
-test unixMenu-26.1 {TkpMenuInit - nothing to do} {} {}
 
 # cleanup
 deleteWindows
 cleanupTests
-return
+return
\ No newline at end of file