testcase cleanup

7 files changed, 275 insertions, 237 deletions

diff --git a/tests/font.test b/tests/font.test
index c3f6413..fbd0a52 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -140,7 +140,7 @@ test font-4.3 {font command: actual: arguments} {
 } {1 {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}}
 test font-4.4 {font command: actual: displayof specified, so skip to next} {
     catch {font actual xyz -displayof . -size}
-} {0}
+} 0
 test font-4.5 {font command: actual: displayof specified, so skip to next} {
     lindex [font actual xyz -displayof .] 0
 } {-family}
@@ -148,7 +148,7 @@ test font-4.6 {font command: actual: arguments} {
     # (objc - skip > 4) when skip == 2
     list [catch {font actual xyz -displayof . abc def} msg] $msg
 } {1 {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}}
-test font-4.7 {font command: actual: arguments} {noExceed} {
+test font-4.7 {font command: actual: arguments} noExceed {
     # (tkfont == NULL)
     list [catch {font actual "\{xyz"} msg] $msg
 } [list 1 "font \"{xyz\" doesn't exist"]
@@ -159,7 +159,7 @@ test font-4.8 {font command: actual: all attributes} {
 test font-4.9 {font command: actual} {unix noExceed failsOnUbuntu} {
     # (objc > 3) so objPtr = objv[3 + skip]
     string tolower [font actual {-family times} -family]
-} {times}
+} times
 test font-4.10 {font command: actual} win {
     # (objc > 3) so objPtr = objv[3 + skip]
     font actual {-family times} -family
@@ -215,19 +215,19 @@ test font-6.1 {font command: create: make up name} {
     setup
     font create
     expr {"font1" in [font names]}
-} {1}
+} 1
 test font-6.2 {font command: create: name specified} {
     # not (objc < 3)
     setup
     font create xyz
     expr {"xyz" in [font names]}
-} {1}
+} 1
 test font-6.3 {font command: create: name not really specified} {
     # (name[0] == '-') so name = NULL
     setup
     font create -family xyz
     expr {"font1" in [font names]}
-} {1}
+} 1
 test font-6.4 {font command: create: generate name} {
     # (name == NULL)
     setup
@@ -237,7 +237,7 @@ test font-6.4 {font command: create: generate name} {
     font delete font2
     font create -family four
     font configure font2 -family
-} {four}
+} four
 test font-6.5 {font command: create: bad option creating new font} {
     # name was specified so skip = 3
     setup
@@ -305,7 +305,7 @@ test font-7.6 {font command: delete: actually delete} {
     font create xyz -underline 1
     font delete xyz
     catch {font config xyz}
-} {1}
+} 1
 setup
 
 test font-8.1 {font command: families: arguments} {
@@ -323,7 +323,7 @@ test font-8.3 {font command: families: arguments} {
 test font-8.4 {font command: families} failsOnUbuntu {
     # TkpGetFontFamilies()
     regexp -nocase times [font families]
-} {1}
+} 1
 
 test font-9.1 {font command: measure: arguments} {
     # (skip < 0)
@@ -337,14 +337,14 @@ test font-9.3 {font command: measure: arguments} {
     # (objc - skip != 4)
     list [catch {font measure xyz abc def} msg] $msg
 } {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
-test font-9.4 {font command: measure: arguments} {noExceed} {
+test font-9.4 {font command: measure: arguments} noExceed {
     # (tkfont == NULL)
     list [catch {font measure "\{xyz" abc} msg] $msg
 } [list 1 "font \"{xyz\" doesn't exist"]
 test font-9.5 {font command: measure} failsOnUbuntu {
     # Tk_TextWidth()
     expr [font measure $fixed "abcdefg"]==[font measure $fixed "a"]*7
-} {1}
+} 1
 test font-9.6 {font command: measure -d} {
      list [catch {expr {[font measure $fixed -d] > 0}} msg] $msg
 } {0 1}
@@ -374,7 +374,7 @@ test font-10.5 {font command: metrics: arguments} {
     # (objc - skip) > 4) when skip == 2
     list [catch {font metrics xyz -displayof . abc} msg] $msg
 } {1 {bad metric "abc": must be -ascent, -descent, -linespace, or -fixed}}
-test font-10.6 {font command: metrics: bad font} {noExceed} {
+test font-10.6 {font command: metrics: bad font} noExceed {
     # (tkfont == NULL)
     list [catch {font metrics "\{xyz"} msg] $msg
 } [list 1 "font \"{xyz\" doesn't exist"]
@@ -395,7 +395,7 @@ test font-10.9 {font command: metrics: get individual metrics} failsOnUbuntu {
     font metrics $fixed -descent
     font metrics $fixed -linespace
     font metrics $fixed -fixed
-} {1}
+} 1
 
 test font-11.1 {font command: names: arguments} {
     # (objc != 2)
@@ -409,7 +409,7 @@ test font-11.3 {font command: names: loop test: one pass} {
     setup
     font create
     getnondefaultfonts
-} {font1}
+} font1
 test font-11.4 {font command: names: loop test: multiple passes} {
     setup
     font create xyz
@@ -447,7 +447,7 @@ test font-12.2 {UpdateDependantFonts procedure: pings the widgets} {
     update
     set b2 [winfo reqwidth .b.f]
     expr {$a1==$b1 && $a2==$b2}
-} {1}
+} 1
 
 test font-13.1 {CreateNamedFont: new named font} {
     # not (new == 0)
@@ -477,7 +477,7 @@ test font-13.4 {CreateNamedFont: recreate "deleted" font} {
     font delete xyz
     font create xyz -family courier
     font configure xyz -family
-} {courier}
+} courier
 
 test font-14.1 {Tk_GetFont procedure} {
 } {}
@@ -541,7 +541,7 @@ test font-15.10 {Tk_AllocFontFromObj procedure: get attribute font} {
     # (fontPtr == NULL)
     list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg
 } {1 {expected integer but got "yyy"}}
-test font-15.11 {Tk_AllocFontFromObj procedure: no match} {noExceed} {
+test font-15.11 {Tk_AllocFontFromObj procedure: no match} noExceed {
     # (ParseFontNameObj() != TCL_OK)
     list [catch {font actual "\{xyz"} msg] $msg
 } [list 1 "font \"{xyz\" doesn't exist"]
@@ -608,7 +608,7 @@ test font-17.4 {Tk_FreeFont procedure: named font} {
     .b.f config -font xyz
     destroy .b.f
     expr {"xyz" in [font names]}
-} {1}
+} 1
 test font-17.5 {Tk_FreeFont procedure: named font} {
     # not (fontPtr->refCount == 0)
     setup
@@ -683,21 +683,21 @@ test font-21.1 {Tk_PostscriptFontName procedure: native} unix {
 } {AvantGarde-Book}
 test font-21.2 {Tk_PostscriptFontName procedure: native} win {
     psfontname "arial 10"
-} {Helvetica}
+} Helvetica
 test font-21.3 {Tk_PostscriptFontName procedure: native} win {
     psfontname "{times new roman} 10"
-} {Times-Roman}
+} Times-Roman
 test font-21.4 {Tk_PostscriptFontName procedure: native} win {
     psfontname "{courier new} 10"
-} {Courier}
+} Courier
 test font-21.8 {Tk_PostscriptFontName procedure: spaces} unix {
     set x [font actual {{lucida bright} 10} -family]
     if {[string match lucida*bright $x]} {
 	psfontname "{lucida bright} 10"
     } else {
-	set x {LucidaBright}
+	set x LucidaBright
     }
-} {LucidaBright}
+} LucidaBright
 test font-21.9 {Tk_PostscriptFontName procedure: spaces} {unix failsOnUbuntu} {
     psfontname "{new century schoolbook} 10"
 } {NewCenturySchlbk-Roman}
@@ -914,7 +914,7 @@ test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} {
 test font-28.1 {Tk_PointToChar procedure: above all lines} {
     csetup "000"
     .b.c index text @-1,0
-} {0}
+} 0
 test font-28.2 {Tk_PointToChar procedure: no chars} {
     # After fixing the following bug:
     #
@@ -926,44 +926,44 @@ test font-28.2 {Tk_PointToChar procedure: no chars} {
 
     csetup ""
     .b.c index text @100,100
-} {0}
+} 0
 test font-28.3 {Tk_PointToChar procedure: loop test} {
     csetup "000\n000\n000\n000"
     .b.c index text @10000,0
-} {3}
+} 3
 test font-28.4 {Tk_PointToChar procedure: intersect line} {
     csetup "000\n000\n000"
     .b.c index text @0,$ay
-} {4}
+} 4
 test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} {
     .b.c index text @-100,$ay
-} {4}
+} 4
 test font-28.6 {Tk_PointToChar procedure: past any possible chunk} {
     .b.c index text @100000,$ay
-} {7}
+} 7
 test font-28.7 {Tk_PointToChar procedure: which chunk on this line} {
     csetup "000\n000\t000\t000\n000"
     .b.c index text @[expr $ax*2],$ay
-} {6}
+} 6
 test font-28.8 {Tk_PointToChar procedure: which chunk on this line} {
     csetup "000\n000\t000\t000\n000"
     .b.c index text @[expr $ax*10],$ay
-} {10}
+} 10
 test font-28.9 {Tk_PointToChar procedure: in special chunk} {
     csetup "000\n000\t000\t000\n000"
     .b.c index text @[expr $ax*6],$ay
-} {7}
+} 7
 test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} {
     csetup "000 0000000"
     .b.c itemconfig text -width [expr $ax*5]
     set x [.b.c index text @[expr $ax*5],0]
     .b.c itemconfig text -width 0
     set x
-} {3}
+} 3
 test font-28.11 {Tk_PointToChar procedure: below all chunks} {
     csetup "000 0000000"
     .b.c index text @0,1000000
-} {11}
+} 11
 
 test font-29.1 {Tk_CharBBox procedure: index < 0} {
     .b.f config -text "000" -underline -1
@@ -994,14 +994,14 @@ test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} {
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x 0 -y 0
     set x
-} {0}
+} 0
 test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} {
     csetup "000\n000\n000"
     set x {}
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x $ax -y $ay
     set x
-} {5}
+} 5
 test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} {
     csetup "000\n0\n000"
     set x {}
@@ -1015,7 +1015,7 @@ test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} {
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x [expr $ax*6] -y 0
     set x
-} {3}
+} 3
 test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} {
     csetup "000\n0\n000"
     set x {}
@@ -1053,7 +1053,7 @@ test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} {
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x $ax -y 0
     set x
-} {0}
+} 0
 test font-30.10 {Tk_DistanceToTextLayout procedure: above line} {
     csetup "0\n000"
     set x {}
@@ -1074,7 +1074,7 @@ test font-30.12 {Tk_DistanceToTextLayout procedure: in line} {
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x $ax -y $ay
     set x
-} {3}
+} 3
 .b.c itemconfig text -justify left
 test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} {
     csetup "000"
@@ -1082,7 +1082,7 @@ test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} {
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x $ax -y 0
     set x
-} {1}
+} 1
 
 test font-31.1 {Tk_IntersectTextLayout procedure: loop once} {
     csetup "000\n000\n000"
@@ -1211,7 +1211,7 @@ test font-35.1 {GetAttributeInfoObj procedure: one attribute} {
     setup
     font create xyz -family xyz
     font config xyz -family
-} {xyz}
+} xyz
 
 test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} {
     # (Tcl_GetIndexFromObj() != TCL_OK)
@@ -1268,10 +1268,10 @@ test font-38.5 {ParseFontNameObj procedure: begins with *} {
 test font-38.6 {ParseFontNameObj procedure: begins with *} {
     font actual *-times-xyz -family
 } $times
-test font-38.7 {ParseFontNameObj procedure: arguments} {noExceed} {
+test font-38.7 {ParseFontNameObj procedure: arguments} noExceed {
     list [catch {font actual "\{xyz"} msg] $msg
 } [list 1 "font \"{xyz\" doesn't exist"]
-test font-38.8 {ParseFontNameObj procedure: arguments} {noExceed} {
+test font-38.8 {ParseFontNameObj procedure: arguments} noExceed {
     list [catch {font actual ""} msg] $msg
 } {1 {font "" doesn't exist}}
 test font-38.9 {ParseFontNameObj procedure: arguments} {
@@ -1280,7 +1280,7 @@ test font-38.9 {ParseFontNameObj procedure: arguments} {
 test font-38.10 {ParseFontNameObj procedure: arguments} {
     list [catch {font actual {times xyz xyz}} msg] $msg
 } {1 {expected integer but got "xyz"}}
-test font-38.12 {ParseFontNameObj procedure: stylelist loop} {unixOrPc} {
+test font-38.12 {ParseFontNameObj procedure: stylelist loop} unixOrPc {
     lrange [font actual {times 12 bold italic overstrike underline}] 4 end
 } {-weight bold -slant italic -underline 1 -overstrike 1}
 test font-38.13 {ParseFontNameObj procedure: stylelist error} {
@@ -1288,7 +1288,7 @@ test font-38.13 {ParseFontNameObj procedure: stylelist error} {
 } {1 {unknown font style "xyz"}}
 test font-38.14 "ParseFontNameObj: options with hyphenated family: bug #2791352" -body {
     font actual {-family sans-serif -size 12 -weight bold -slant roman -underline 0 -overstrike 0}
-} -returnCodes ok -result [font actual {sans-serif 12 bold}]
+} -result [font actual {sans-serif 12 bold}]
 test font-38.15 "ParseFontNameObj: bug #2791352" -body {
     font actual {-invalidfont 8 bold}
 } -returnCodes error -match glob -result {bad option "-invalidfont": *}
@@ -1350,10 +1350,10 @@ set oldscale [tk scaling]
 tk scaling 0.5
 test font-44.1 {TkFontGetPixels: size < 0} failsOnUbuntu {
     font actual {times -12} -size
-} {24}
-test font-44.2 {TkFontGetPoints: size >= 0} {noExceed} {
+} 24
+test font-44.2 {TkFontGetPoints: size >= 0} noExceed {
     font actual {times 12} -size
-} {12}
+} 12
 
 tk scaling $oldscale
 
diff --git a/tests/safe.test b/tests/safe.test
index d5488dc..914adaa 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -1,5 +1,5 @@
-# This file is a Tcl script to test the Safe Tk facility. It is organized
-# in the standard fashion for Tk tests.
+# This file is a Tcl script to test the Safe Tk facility. It is organized in
+# the standard fashion for Tk tests.
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
@@ -9,6 +9,7 @@
 package require tcltest 2.2
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
+namespace import -force tcltest::test
 
 ## NOTE: Any time tests fail here with an error like:
 
@@ -27,181 +28,200 @@ tcltest::loadTestedCommands
 # This probably means that tk wasn't installed properly.
 
 ## it indicates that something went wrong sourcing tk.tcl.
-## Ensure that any changes that occured to tk.tcl will work or
-## are properly prevented in a safe interpreter.  -- hobbs
+## Ensure that any changes that occurred to tk.tcl will work or are properly
+## prevented in a safe interpreter.  -- hobbs
 
 set saveAutoPath $::auto_path
 set auto_path [list [info library] $::tk_library]
 
-test safe-1.1 {Safe Tk loading into an interpreter} {
+test safe-1.1 {Safe Tk loading into an interpreter} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::loadTk [safe::interpCreate a]
     safe::interpDelete a
     set x {}
     set x
-} ""
-test safe-1.2 {Safe Tk loading into an interpreter} -body {
+} -result {}
+test safe-1.2 {Safe Tk loading into an interpreter} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
-    set l [lsort [interp hidden a]]
+    lsort [interp hidden a]
+} -cleanup {
     safe::interpDelete a
-    set l
 } -match glob -result {bell cd clipboard encoding exec exit fconfigure*glob grab load menu open pwd selection send socket source*toplevel unload wm}
-test safe-1.3 {Safe Tk loading into an interpreter} -body {
+test safe-1.3 {Safe Tk loading into an interpreter} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
-    set l [lsort [interp aliases a]]
+    lsort [interp aliases a]
+} -cleanup {
     safe::interpDelete a
-    set l
 } -match glob -result {*encoding*exit*load*source*}
 
-test safe-2.1 {Unsafe commands not available} {
+test safe-2.1 {Unsafe commands not available} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
     set status broken
     if {[catch {interp eval a {toplevel .t}} msg]} {
 	set status ok
     }
-    safe::interpDelete a
     set status
-} ok
-test safe-2.2 {Unsafe commands not available} {
+} -cleanup {
+    safe::interpDelete a
+} -result ok
+test safe-2.2 {Unsafe commands not available} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
     set status broken
     if {[catch {interp eval a {menu .m}} msg]} {
 	set status ok
     }
-    safe::interpDelete a
     set status
-} ok
-test safe-2.3 {Unsafe subcommands not available} {
+} -cleanup {
+    safe::interpDelete a
+} -result ok
+test safe-2.3 {Unsafe subcommands not available} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
     set status broken
     if {[catch {interp eval a {tk appname}} msg]} {
 	set status ok
     }
-    safe::interpDelete a
     list $status $msg
-} {ok {appname not accessible in a safe interpreter}}
-test safe-2.4 {Unsafe subcommands not available} {
+} -cleanup {
+    safe::interpDelete a
+} -result {ok {appname not accessible in a safe interpreter}}
+test safe-2.4 {Unsafe subcommands not available} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
     set status broken
     if {[catch {interp eval a {tk scaling}} msg]} {
 	set status ok
     }
-    safe::interpDelete a
     list $status $msg
-} {ok {scaling not accessible in a safe interpreter}}
+} -cleanup {
+    safe::interpDelete a
+} -result {ok {scaling not accessible in a safe interpreter}}
 
-test safe-3.1 {Unsafe commands are available hidden} {
+test safe-3.1 {Unsafe commands are available hidden} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
     set status ok
     if {[catch {interp invokehidden a toplevel .t} msg]} {
 	set status broken
     }
-    safe::interpDelete a
     set status
-} ok
-test safe-3.2 {Unsafe commands are available hidden} {
+} -cleanup {
+    safe::interpDelete a
+} -result ok
+test safe-3.2 {Unsafe commands are available hidden} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     safe::loadTk a
     set status ok
     if {[catch {interp invokehidden a menu .m} msg]} {
 	set status broken
     }
-    safe::interpDelete a
     set status
-} ok
+} -cleanup {
+    safe::interpDelete a
+} -result ok
 
-test safe-4.1 {testing loadTk} {
-    # no error shall occur, the user will
-    # eventually see a new toplevel
+test safe-4.1 {testing loadTk} -body {
+    # no error shall occur, the user will eventually see a new toplevel
     set i [safe::loadTk [safe::interpCreate]]
     interp eval $i {button .b -text "hello world!"; pack .b}
-    # lets don't update because it might imply that the user has
-    # to position the window (if the wm does not do it automatically)
-    # and thus make the test suite not runable non interactively
+    # lets don't update because it might imply that the user has to position
+    # the window (if the wm does not do it automatically) and thus make the
+    # test suite not runable non interactively
     safe::interpDelete $i
-} {}
-
-test safe-4.2 {testing loadTk -use} {
+} -result {}
+test safe-4.2 {testing loadTk -use} -setup {
+    destroy .safeTkFrame
+} -body {
     set w .safeTkFrame
-    catch {destroy $w}
     frame $w -container 1;
-    pack .safeTkFrame
+    pack $w
     set i [safe::loadTk [safe::interpCreate] -use [winfo id $w]]
     interp eval $i {button .b -text "hello world!"; pack .b}
     safe::interpDelete $i
     destroy $w
-} {}
+} -result {}
 
-test safe-5.1 {loading Tk in safe interps without master's clearance} {
+test safe-5.1 {loading Tk in safe interps without parent's clearance} -body {
     set i [safe::interpCreate]
-    catch {interp eval $i {load {} Tk}} msg
+    interp eval $i {load {} Tk}
+} -cleanup {
     safe::interpDelete $i
-    set msg
-} {not allowed to start Tk by master's safe::TkInit}
-
-test safe-5.2 {multi-level Tk loading with clearance} {
-    # No error shall occur in that test and no window
-    # shall remain at the end.
-    set i [safe::interpCreate]
-    set j [list $i x]
-    set j [safe::interpCreate $j]
-    safe::loadTk $j
-    interp eval $j {
+} -returnCodes error -match glob -result {*not allowed*}
+test safe-5.2 {multi-level Tk loading with clearance} -setup {
+    set safeParent [safe::interpCreate]
+} -body {
+    # No error shall occur in that test and no window shall remain at the end.
+    set i [safe::interpCreate [list $safeParent x]]
+    safe::loadTk $i
+    interp eval $i {
 	button .b -text Ok -command {destroy .}
 	pack .b
 #	tkwait window . ; # for interactive testing/debugging
     }
-    safe::interpDelete $j
-    safe::interpDelete $i
-} {}
-
-test safe-6.1 {loadTk -use windowPath} {
+} -cleanup {
+    catch {safe::interpDelete $i}
+    safe::interpDelete $safeParent
+} -result {}
+
+test safe-6.1 {loadTk -use windowPath} -setup {
+    destroy .safeTkFrame
+} -body {
     set w .safeTkFrame
-    catch {destroy $w}
     frame $w -container 1;
-    pack .safeTkFrame
+    pack $w
     set i [safe::loadTk [safe::interpCreate] -use $w]
     interp eval $i {button .b -text "hello world!"; pack .b}
     safe::interpDelete $i
     destroy $w
-} {}
-
-test safe-6.2 {loadTk -use windowPath, conflicting -display} {
+} -result {}
+test safe-6.2 {loadTk -use windowPath, conflicting -display} -setup {
+    destroy .safeTkFrame
+} -body {
     set w .safeTkFrame
-    catch {destroy $w}
     frame $w -container 1;
-    pack .safeTkFrame
+    pack $w
     set i     [safe::interpCreate]
     catch {safe::loadTk $i -use $w -display :23.56} msg
+    string range $msg 0 36
+} -cleanup {
     safe::interpDelete $i
     destroy $w
-    string range $msg 0 36
-} {conflicting -display :23.56 and -use }
-
+} -result {conflicting -display :23.56 and -use }
 
-test safe-7.1 {canvas printing} {
+test safe-7.1 {canvas printing} -body {
     set i [safe::loadTk [safe::interpCreate]]
-    set r [catch {interp eval $i {canvas .c; .c postscript}}]
+    interp eval $i {canvas .c; .c postscript}
+} -cleanup {
     safe::interpDelete $i
-    set r
-} 0
-
+} -match glob -result *
+
 # cleanup
 set ::auto_path $saveAutoPath
 cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/tk.test b/tests/tk.test
index 9673caa..76455d7 100644
--- a/tests/tk.test
+++ b/tests/tk.test
@@ -8,132 +8,144 @@
 package require tcltest 2.2
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
+namespace import -force tcltest::test
 
-test tk-1.1 {tk command: general} \
-    -body {tk} -returnCodes 1 \
-    -result {wrong # args: should be "tk option ?arg?"}
-test tk-1.2 {tk command: general} \
-    -body {tk xyz} -returnCodes 1 \
-    -result {bad option "xyz": must be appname, caret, scaling, useinputmethods, windowingsystem, or inactive}
+test tk-1.1 {tk command: general} -body {
+    tk
+} -returnCodes 1 -result {wrong # args: should be "tk option ?arg?"}
+test tk-1.2 {tk command: general} -body {
+    tk xyz
+} -returnCodes 1 -result {bad option "xyz": must be appname, caret, scaling, useinputmethods, windowingsystem, or inactive}
 
+# Value stored to restore default settings after 2.* tests
 set appname [tk appname]
-test tk-2.1 {tk command: appname} {
-    list [catch {tk appname xyz abc} msg] $msg
-} {1 {wrong # args: should be "tk appname ?newName?"}}
-test tk-2.2 {tk command: appname} {
+test tk-2.1 {tk command: appname} -body {
+    tk appname xyz abc
+} -returnCodes 1 -result {wrong # args: should be "tk appname ?newName?"}
+test tk-2.2 {tk command: appname} -body {
     tk appname foobazgarply
-} {foobazgarply}
-test tk-2.3 {tk command: appname} unix {
+} -result foobazgarply
+test tk-2.3 {tk command: appname} -constraints unix -body {
     tk appname bazfoogarply
     expr {[lsearch -exact [winfo interps] [tk appname]] >= 0}
-} {1}
-test tk-2.4 {tk command: appname} {
+} -result 1
+test tk-2.4 {tk command: appname} -body {
     tk appname $appname
-} $appname
+} -result $appname
 tk appname $appname
 
+# Value stored to restore default settings after 3.* tests
 set scaling [tk scaling]
-test tk-3.1 {tk command: scaling} {
-    list [catch {tk scaling -displayof} msg] $msg
-} {1 {value for "-displayof" missing}}
-test tk-3.2 {tk command: scaling: get current} {
+test tk-3.1 {tk command: scaling} -body {
+    tk scaling -displayof
+} -returnCodes 1 -result {value for "-displayof" missing}
+test tk-3.2 {tk command: scaling: get current} -body {
     tk scaling 1
     format %.2g [tk scaling]
-} 1
-test tk-3.3 {tk command: scaling: get current} {
+} -result 1
+test tk-3.3 {tk command: scaling: get current} -body {
     tk scaling -displayof . 1.25
     format %.3g [tk scaling]
-} 1.25
-test tk-3.4 {tk command: scaling: set new} {
-    list [catch {tk scaling xyz} msg] $msg
-} {1 {expected floating-point number but got "xyz"}}
-test tk-3.5 {tk command: scaling: set new} {
-    list [catch {tk scaling -displayof . xyz} msg] $msg
-} {1 {expected floating-point number but got "xyz"}}
-test tk-3.6 {tk command: scaling: set new} {
+} -result 1.25
+test tk-3.4 {tk command: scaling: set new} -body {
+    tk scaling xyz
+} -returnCodes 1 -result {expected floating-point number but got "xyz"}
+test tk-3.5 {tk command: scaling: set new} -body {
+    tk scaling -displayof . xyz
+} -returnCodes 1 -result {expected floating-point number but got "xyz"}
+test tk-3.6 {tk command: scaling: set new} -body {
     tk scaling 1
     format %.2g [tk scaling]
-} 1
-test tk-3.7 {tk command: scaling: set new} {
+} -result 1
+test tk-3.7 {tk command: scaling: set new} -body {
     tk scaling -displayof . 1.25
     format %.3g [tk scaling]
-} 1.25
-test tk-3.8 {tk command: scaling: negative} {
+} -result 1.25
+test tk-3.8 {tk command: scaling: negative} -body {
     tk scaling -1
     expr {[tk scaling] > 0}
-} {1}
-test tk-3.9 {tk command: scaling: too big} {
+} -result 1
+test tk-3.9 {tk command: scaling: too big} -body {
     tk scaling 1000000
     expr {[tk scaling] < 10000}
-} 1
-test tk-3.10 {tk command: scaling: widthmm} {
+} -result 1
+test tk-3.10 {tk command: scaling: widthmm} -body {
     tk scaling 1.25
-    expr {int((25.4*[winfo screenwidth .])/(72*1.25)+0.5)-[winfo screenmmwidth .]}
-} {0}
-test tk-3.11 {tk command: scaling: heightmm} {
+    expr {int((25.4*[winfo screenwidth .])/(72*1.25) + 0.5) \
+        - [winfo screenmmwidth .]}
+} -result 0
+test tk-3.11 {tk command: scaling: heightmm} -body {
     tk scaling 1.25
-    expr {int((25.4*[winfo screenheight .])/(72*1.25)+0.5)-[winfo screenmmheight .]}
-} {0}
+    expr {int((25.4*[winfo screenheight .])/(72*1.25) + 0.5) \
+        - [winfo screenmmheight .]}
+} -result 0
 tk scaling $scaling
 
+# Value stored to restore default settings after 4.* tests
 set useim [tk useinputmethods]
-test tk-4.1 {tk command: useinputmethods} {
-    list [catch {tk useinputmethods -displayof} msg] $msg
-} {1 {value for "-displayof" missing}}
-test tk-4.2 {tk command: useinputmethods: get current} {
+test tk-4.1 {tk command: useinputmethods} -body {
+    tk useinputmethods -displayof
+} -returnCodes 1 -result {value for "-displayof" missing}
+test tk-4.2 {tk command: useinputmethods: get current} -body {
+    tk useinputmethods no
+} -cleanup {
+    tk useinputmethods $useim
+} -result 0
+test tk-4.3 {tk command: useinputmethods: get current} -body {
     tk useinputmethods no
-} 0
-test tk-4.3 {tk command: useinputmethods: get current} {
     tk useinputmethods -displayof .
-} 0
-test tk-4.4 {tk command: useinputmethods: set new} {
-    list [catch {tk useinputmethods xyz} msg] $msg
-} {1 {expected boolean value but got "xyz"}}
-test tk-4.5 {tk command: useinputmethods: set new} {
-    list [catch {tk useinputmethods -displayof . xyz} msg] $msg
-} {1 {expected boolean value but got "xyz"}}
-test tk-4.6 {tk command: useinputmethods: set new} unix {
-    # This isn't really a test, but more of a check...
-    # The answer is what was given, because we may be on a Unix
-    # system that doesn't have the XIM stuff
+} -cleanup {
+    tk useinputmethods $useim
+} -result 0
+test tk-4.4 {tk command: useinputmethods: set new} -body {
+    tk useinputmethods xyz
+} -returnCodes 1 -result {expected boolean value but got "xyz"}
+test tk-4.5 {tk command: useinputmethods: set new} -body {
+    tk useinputmethods -displayof . xyz
+} -returnCodes 1 -result {expected boolean value but got "xyz"}
+test tk-4.6 {tk command: useinputmethods: set new} -constraints unix -body {
+    # This isn't really a test, but more of a check... The answer is what was
+    # given, because we may be on a Unix system that doesn't have the XIM
+    # stuff
     if {[tk useinputmethods 1] == 0} {
 	puts "this wish doesn't have XIM (X Input Methods) support"
     }
     set useim
-} $useim
-test tk-4.7 {tk command: useinputmethods: set new} win {
-    # Mac and Windows don't have X Input Methods, so this should
-    # always return 0
+} -result $useim
+test tk-4.7 {tk command: useinputmethods: set new} -constraints win -body {
+    # Mac and Windows don't have X Input Methods, so this should always return
+    # 0
     tk useinputmethods 1
-} 0
-tk useinputmethods $useim
+} -cleanup {
+    tk useinputmethods $useim
+} -result 0
 
-test tk-5.1 {tk caret} {
-    list [catch {tk caret} msg] $msg
-} {1 {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}}
-test tk-5.2 {tk caret} {
-    list [catch {tk caret bogus} msg] $msg
-} {1 {bad window path name "bogus"}}
-test tk-5.3 {tk caret} {
-    list [catch {tk caret . -foo} msg] $msg
-} {1 {bad caret option "-foo": must be -x, -y, or -height}}
-test tk-5.4 {tk caret} {
-    list [catch {tk caret . -x 0 -y} msg] $msg
-} {1 {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}}
-test tk-5.5 {tk caret} {
-    list [catch {tk caret . -x 10 -y 11 -h 12; tk caret .} msg] $msg
-} {0 {-height 12 -x 10 -y 11}}
-test tk-5.6 {tk caret} {
-    list [catch {tk caret . -x 20 -y 25 -h 30; tk caret . -hei} msg] $msg
-} {0 30}
+test tk-5.1 {tk caret} -body {
+    tk caret
+} -returnCodes 1 -result {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}
+test tk-5.2 {tk caret} -body {
+    tk caret bogus
+} -returnCodes 1 -result {bad window path name "bogus"}
+test tk-5.3 {tk caret} -body {
+    tk caret . -foo
+} -returnCodes 1 -result {bad caret option "-foo": must be -x, -y, or -height}
+test tk-5.4 {tk caret} -body {
+    tk caret . -x 0 -y
+} -returnCodes 1 -result {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}
+test tk-5.5 {tk caret} -body {
+    tk caret . -x 10 -y 11 -h 12; tk caret .
+} -result {-height 12 -x 10 -y 11}
+test tk-5.6 {tk caret} -body {
+    tk caret . -x 20 -y 25 -h 30; tk caret . -hei
+} -result 30
 
 # tk inactive
 test tk-6.1 {tk inactive} -body {
     string is integer [tk inactive]
 } -result 1
 test tk-6.2 {tk inactive reset} -body {
-    catch {tk inactive reset}
-} -result 0
+    tk inactive reset
+} -match glob -result *
 test tk-6.3 {tk inactive wrong argument} -body {
     tk inactive foo
 } -returnCodes 1 -result {bad option "foo": must be reset}
@@ -145,19 +157,25 @@ test tk-6.5 {tk inactive} -body {
     update
     after 100
     set i [tk inactive]
-    expr {$i == -1 || ( $i > 90 && $i < 200 )}
+    expr {$i < 0 || ( $i > 90 && $i < 200 )}
 } -result 1
 
-# tk inactive in safe interpreters
-safe::interpCreate foo
-safe::loadTk foo
 test tk-7.1 {tk inactive in a safe interpreter} -body {
+# tk inactive in safe interpreters
+    safe::interpCreate foo
+    safe::loadTk foo
     foo eval {tk inactive}
+} -cleanup {
+    ::safe::interpDelete foo
 } -result -1
 test tk-7.2 {tk inactive reset in a safe interpreter} -body {
+# tk inactive in safe interpreters
+    safe::interpCreate foo
+    safe::loadTk foo
     foo eval {tk inactive reset}
+} -cleanup {
+    ::safe::interpDelete foo
 } -returnCodes 1 -result {resetting the user inactivity timer is not allowed in a safe interpreter}
-::safe::interpDelete foo
 
 # cleanup
 cleanupTests
diff --git a/tests/unixWm.test b/tests/unixWm.test
index 7c427ec..e292d38 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -632,7 +632,7 @@ test unixWm-17.2 {Tk_WmCmd procedure, "focusmodel" option} unix {
     list [catch {wm focusmodel .t bogus} msg] $msg
 } {1 {bad argument "bogus": must be active or passive}}
 test unixWm-17.3 {Tk_WmCmd procedure, "focusmodel" option} unix {
-    set result {} 
+    set result {}
     lappend result [wm focusmodel .t]
     wm focusmodel .t active
     lappend result [wm focusmodel .t]
@@ -1328,7 +1328,7 @@ test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on gr
     destroy .t
     toplevel .t
     wm geometry .t 30x10+0+0
-    listbox .t.l -height 20 -width 20 -setgrid 1 
+    listbox .t.l -height 20 -width 20 -setgrid 1
     pack .t.l -fill both -expand 1
     update
     wm geometry .t
@@ -1337,7 +1337,7 @@ test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already
     destroy .t
     toplevel .t
     wm geometry .t 200x100+0+0
-    listbox .t.l -height 20 -width 20 
+    listbox .t.l -height 20 -width 20
     pack .t.l -fill both -expand 1
     update
     .t.l configure -setgrid 1
@@ -1750,7 +1750,7 @@ test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unix testmenubar} {
     testmenubar window .t .t.m
     update
     list [expr [winfo rootx .t.m.f] - $x] [expr [winfo rooty .t.m.f] - $y] \
-	    [expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y] 
+	    [expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y]
 } {52 7 12 62}
 
 deleteWindows
diff --git a/tests/winFont.test b/tests/winFont.test
index b4e8516..de16560 100644
--- a/tests/winFont.test
+++ b/tests/winFont.test
@@ -1,10 +1,10 @@
-# This file is a Tcl script to test out the procedures in tkWinFont.c. 
+# This file is a Tcl script to test out the procedures in tkWinFont.c.
 # It is organized in the standard fashion for Tcl tests.
 #
 # Many of these tests are visually oriented and cannot be checked
 # programmatically (such as "does an underlined font appear to be
 # underlined?"); these tests attempt to exercise the code in question,
-# but there are no results that can be checked.  
+# but there are no results that can be checked.
 #
 # Copyright (c) 1996-1997 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
@@ -54,22 +54,22 @@ test winfont-1.2 {TkpGetNativeFont procedure: native} win {
 
 test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} win {
     expr [font actual {-size -10} -size]>0
-} {1}
+} 1
 test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} win {
     expr [font actual {-family Arial} -size]>0
-} {1}
+} 1
 test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} win {
     font actual {-weight normal} -weight
-} {normal}
+} normal
 test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} win {
     font actual {-weight bold} -weight
-} {bold}
+} bold
 test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} win {
     catch {expr {[font actual {-size 10} -size]}}
 } 0
 test winfont-2.6 {TkpGetFontFromAttributes procedure: family} win {
     font actual {-family Arial} -family
-} {Arial}
+} Arial
 test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} win {
     set x {}
     lappend x [font actual {-family "Times"} -family]
@@ -122,7 +122,7 @@ test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} win {
     .b.c dchars $t 0 end
     .b.c insert $t 0 "0000"
     .b.c index $t @[expr int($cx*2.5)],1
-} {2}
+} 2
 test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} win {
     .b.l config -text "000000" -wrap 1
     getsize
@@ -173,10 +173,10 @@ test winfont-7.2 {AllocFont procedure: extract info from logfont} win {
 } {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1}
 test winfont-7.3 {AllocFont procedure: extract info from textmetric} win {
     font metric {arial 10 bold italic underline overstrike} -fixed
-} {0}
+} 0
 test winfont-7.4 {AllocFont procedure: extract info from textmetric} win {
     font metric systemfixed -fixed
-} {1}
+} 1
 
 # cleanup
 destroy .b
diff --git a/tests/winMenu.test b/tests/winMenu.test
index d3114bd..5b98c3b 100644
--- a/tests/winMenu.test
+++ b/tests/winMenu.test
@@ -579,7 +579,7 @@ test winMenu-22.1 {DrawMenuUnderline} win {
     .m1 add command -label foo -underline 0
     set tearoff [tk::TearOffMenu .m1 40 40]
     list [update] [destroy .m1]
-} {{} {}}   
+} {{} {}}
 
 test winMenu-23.1 {Don't know how to test MenuKeyBindProc} \
 	{win emptyTest} {} {}
@@ -997,7 +997,7 @@ test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} win {
     .m1 add command -label four
     .m1 add command -label five -columnbreak 1
     .m1 add command -label six
-    list [update idletasks] [destroy .m1]    
+    list [update idletasks] [destroy .m1]
 } {{} {}}
 
 test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} win {
diff --git a/tests/winWm.test b/tests/winWm.test
index 838af04..d195771 100644
--- a/tests/winWm.test
+++ b/tests/winWm.test
@@ -106,7 +106,7 @@ test winWm-2.2 {TkpWmSetState} win {
     update
     lappend result [wm state .t]
     wm deiconify .t
-    update 
+    update
     lappend result [wm state .t]
     destroy .t
     set result
@@ -123,7 +123,7 @@ test winWm-2.3 {TkpWmSetState} win {
     update
     lappend result [wm state .t]
     wm state .t normal
-    update 
+    update
     lappend result [wm state .t]
     destroy .t
     set result
@@ -205,7 +205,7 @@ test winWm-5.1 {UpdateGeometryInfo: menu resizing} win {
     update
     lappend result [winfo height .t]
     destroy .t
-    
+
     set result
 } {50 50 31}
 test winWm-5.2 {UpdateGeometryInfo: menu resizing} win {
@@ -238,7 +238,7 @@ test winWm-6.2 {wm attributes} win {
     destroy .t
     toplevel .t
     wm attributes .t -disabled
-} {0}
+} 0
 test winWm-6.3 {wm attributes} win {
     # This isn't quite the correct error message yet, but it works.
     destroy .t
@@ -400,7 +400,7 @@ test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constrai
     global winwm90done
     set winwm90done wait
     toplevel .t
-} -body {    
+} -body {
     pack [button .t.b -text "Show" -command {winwm90proc1 .tx}]
     bind .t.b <Map> {bind %W <Map> {}; after idle {winwm90click %W}}
     after 5000 {set winwm90done timeout}
@@ -411,7 +411,7 @@ test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constrai
         rename winwm90$cmd {}
     }
     destroy .tx .t .sd
-} -result {ok}
+} -result ok
 
 test winWm-9.1 "delayed activation of grabbed destroyed window" -constraints win -setup {
     proc winwm91click {w} {
@@ -445,7 +445,7 @@ test winWm-9.1 "delayed activation of grabbed destroyed window" -constraints win
     global winwm91done
     set winwm91done wait
     toplevel .t
-} -body {    
+} -body {
     pack [button .t.b -text "Show" -command {winwm91proc1 .tx}]
     bind .t.b <Map> {bind %W <Map> {}; after idle {winwm91click %W}}
     after 5000 {set winwm91done timeout}
@@ -456,7 +456,7 @@ test winWm-9.1 "delayed activation of grabbed destroyed window" -constraints win
         rename winwm91$cmd {}
     }
     destroy .tx .t .sd
-} -result {ok}
+} -result ok
 
 test winWm-9.2 "check wm forget for unmapped parent (#3205464,#2967911)" -setup {
     destroy .t