Update to tcltest2

5 files changed, 3439 insertions, 1652 deletions

diff --git a/ChangeLog b/ChangeLog
index 1a81e5e..d62abd8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2008-08-15  Ania Pawelczyk  <aniap@users.sourceforge.net>
+
+    * tests/clrpick.test: Update to tcltest2
+    * tests/frame.test:
+    * tests/font.test:
+    * tests/image.test:
+
 2008-08-14  Ania Pawelczyk  <aniap@users.sourceforge.net>
 
     * test/event.test: Update to tcltest2
diff --git a/tests/clrpick.test b/tests/clrpick.test
index 874a532..0502a69 100644
--- a/tests/clrpick.test
+++ b/tests/clrpick.test
@@ -5,12 +5,13 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: clrpick.test,v 1.13 2007/05/09 12:52:44 das Exp $
+# RCS: @(#) $Id: clrpick.test,v 1.14 2008/08/15 01:10:03 aniap Exp $
 #
 
-package require tcltest 2.1
+package require tcltest 2.2
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
+namespace import -force tcltest::test
 
 if {[testConstraint defaultPseudocolor8]} {
     # let's soak up a bunch of colors...so that
@@ -46,51 +47,54 @@ if {[testConstraint defaultPseudocolor8]} {
     testConstraint colorsLeftover 0
 }
 
-test clrpick-1.1 {tk_chooseColor command} {
-    list [catch {tk_chooseColor -foo} msg] $msg
-} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}
-
-catch {tk_chooseColor -foo 1} msg
-regsub -all ,      $msg "" options
-regsub \"-foo\" $options "" options
-
-foreach option $options {
-    if {[string index $option 0] eq "-"} {
-	test clrpick-1.2$option {tk_chooseColor command} -body {
-	    tk_chooseColor $option
-	} -returnCodes error -result "value for \"$option\" missing"
-    }
-}
-
-test clrpick-1.3 {tk_chooseColor command} {
-    list [catch {tk_chooseColor -foo bar} msg] $msg
-} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}
-test clrpick-1.4 {tk_chooseColor command} {
-    list [catch {tk_chooseColor -initialcolor} msg] $msg
-} {1 {value for "-initialcolor" missing}}
-test clrpick-1.5 {tk_chooseColor command} {
-    list [catch {tk_chooseColor -parent foo.bar} msg] $msg
-} {1 {bad window path name "foo.bar"}}
-test clrpick-1.6 {tk_chooseColor command} {
-    list [catch {tk_chooseColor -initialcolor badbadbaadcolor} msg] $msg
-} {1 {unknown color name "badbadbaadcolor"}}
-test clrpick-1.7 {tk_chooseColor command} {
-    list [catch {tk_chooseColor -initialcolor ##badbadbaadcolor} msg] $msg
-} {1 {invalid color name "##badbadbaadcolor"}}
-
+test clrpick-1.1 {tk_chooseColor command} -body {
+    tk_chooseColor -foo
+} -returnCodes error -result {bad option "-foo": must be -initialcolor, -parent, or -title}
+
+test clrpick-1.2 {tk_chooseColor command } -body {
+    tk_chooseColor -initialcolor
+} -returnCodes error -result {value for "-initialcolor" missing}
+test clrpick-1.2 {tk_chooseColor command } -body {
+    tk_chooseColor -parent
+} -returnCodes error -result {value for "-parent" missing}
+test clrpick-1.2 {tk_chooseColor command } -body {
+    tk_chooseColor -title
+} -returnCodes error -result {value for "-title" missing}
+
+test clrpick-1.3 {tk_chooseColor command} -body {
+    tk_chooseColor -foo bar
+} -returnCodes error -result {bad option "-foo": must be -initialcolor, -parent, or -title}
+test clrpick-1.4 {tk_chooseColor command} -body {
+    tk_chooseColor -initialcolor
+} -returnCodes error -result {value for "-initialcolor" missing}
+test clrpick-1.5 {tk_chooseColor command} -body {
+    tk_chooseColor -parent foo.bar
+} -returnCodes error -result {bad window path name "foo.bar"}
+test clrpick-1.6 {tk_chooseColor command} -body {
+    tk_chooseColor -initialcolor badbadbaadcolor
+} -returnCodes error -result {unknown color name "badbadbaadcolor"}
+test clrpick-1.7 {tk_chooseColor command} -body {
+    tk_chooseColor -initialcolor ##badbadbaadcolor
+} -returnCodes error -result {invalid color name "##badbadbaadcolor"}
+
+
+# tests 3.1 and 3.2 fail when individually run
+# if there is no catch {tk_chooseColor -foo 1} msg
+# before settin isNative
+catch {tk_chooseColor -foo 1} msg 
 set isNative [expr {[info commands tk::dialog::color::] eq ""}]
 
 proc ToPressButton {parent btn} {
     global isNative
     if {!$isNative} {
-	after 200 "SendButtonPress $parent $btn mouse"
+	after 200 "SendButtonPress . $btn mouse"
     }
 }
 
 proc ToChooseColorByKey {parent r g b} {
     global isNative
     if {!$isNative} {
-	after 200 ChooseColorByKey $parent $r $g $b
+	after 200 ChooseColorByKey . $r $g $b
     }
 }
 
@@ -118,7 +122,7 @@ proc ChooseColorByKey {parent r g b} {
     # the values for us.
     tk::dialog::color::HandleRGBEntry $w
 
-    SendButtonPress $parent ok mouse
+    SendButtonPress . ok mouse
 }
 
 proc SendButtonPress {parent btn type} {
@@ -140,65 +144,76 @@ proc SendButtonPress {parent btn type} {
     }
 }
 
-set parent .
-
-set verylongstring longstring:
-set verylongstring $verylongstring$verylongstring
-set verylongstring $verylongstring$verylongstring
-set verylongstring $verylongstring$verylongstring
-set verylongstring $verylongstring$verylongstring
-#set verylongstring $verylongstring$verylongstring
-# Interesting thing...when this is too long, the
-# delay caused in processing it kills the automated testing,
-# and makes a lot of the test cases fail.
-#set verylongstring $verylongstring$verylongstring
-#set verylongstring $verylongstring$verylongstring
-#set verylongstring $verylongstring$verylongstring
-#set verylongstring $verylongstring$verylongstring
-
-set color #404040
-test clrpick-2.1 {tk_chooseColor command} \
-	{nonUnixUserInteraction colorsLeftover} {
-    ToPressButton $parent ok
-    tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color \
-	    -parent $parent
-} "$color"
-set color #808040
-test clrpick-2.2 {tk_chooseColor command} \
-	{nonUnixUserInteraction colorsLeftover} {
+
+
+test clrpick-2.1 {tk_chooseColor command} -constraints {
+    nonUnixUserInteraction colorsLeftover
+} -setup {
+    set verylongstring longstring:
+    set verylongstring $verylongstring$verylongstring
+    set verylongstring $verylongstring$verylongstring
+    set verylongstring $verylongstring$verylongstring
+    set verylongstring $verylongstring$verylongstring
+    #set verylongstring $verylongstring$verylongstring
+    # Interesting thing...when this is too long, the
+    # delay caused in processing it kills the automated testing,
+    # and makes a lot of the test cases fail.
+    #set verylongstring $verylongstring$verylongstring
+    #set verylongstring $verylongstring$verylongstring
+    #set verylongstring $verylongstring$verylongstring
+    #set verylongstring $verylongstring$verylongstring
+} -body {
+    ToPressButton . ok
+    tk_chooseColor -title "Press Ok $verylongstring" -initialcolor #404040 \
+        -parent .
+} -result {#404040}
+test clrpick-2.2 {tk_chooseColor command} -constraints {
+    nonUnixUserInteraction colorsLeftover
+} -body {
     set colors "128 128 64"
-    ToChooseColorByKey $parent 128 128 64
-    tk_chooseColor -parent $parent -title "choose $colors"
-} "$color"
-test clrpick-2.3 {tk_chooseColor command} \
-	{nonUnixUserInteraction colorsLeftover} {
-    ToPressButton $parent ok
-    tk_chooseColor -parent $parent -title "Press OK"
-} "$color"
-test clrpick-2.4 {tk_chooseColor command} {nonUnixUserInteraction} {
-    ToPressButton $parent cancel
-    tk_chooseColor -parent $parent -title "Press Cancel"
-} ""
-
-set color "#000000"
-test clrpick-3.1 {tk_chooseColor: background events} {nonUnixUserInteraction} {
+    ToChooseColorByKey . 128 128 64
+    tk_chooseColor -parent . -title "choose #808040"
+} -result {#808040}
+test clrpick-2.3 {tk_chooseColor command} -constraints {
+    nonUnixUserInteraction colorsLeftover
+} -body {
+    ToPressButton . ok
+    tk_chooseColor -parent . -title "Press OK"
+} -result {#808040}
+test clrpick-2.4 {tk_chooseColor command} -constraints {
+    nonUnixUserInteraction colorsLeftover
+} -body {
+    ToPressButton . cancel
+    tk_chooseColor -parent . -title "Press Cancel"
+} -result {}
+
+
+test clrpick-3.1 {tk_chooseColor: background events} -constraints {
+	nonUnixUserInteraction
+} -body {
     after 1 {set x 53}
-    ToPressButton $parent ok
-    tk_chooseColor -parent $parent -title "Press OK" -initialcolor $color
-} "#000000"
-test clrpick-3.2 {tk_chooseColor: background events} {nonUnixUserInteraction} {
+    ToPressButton . ok
+    tk_chooseColor -parent . -title "Press OK" -initialcolor #000000
+} -result {#000000}
+test clrpick-3.2 {tk_chooseColor: background events} -constraints {
+	nonUnixUserInteraction
+} -body {
     after 1 {set x 53}
-    ToPressButton $parent cancel
-    tk_chooseColor -parent $parent -title "Press Cancel"
-} ""
+    ToPressButton . cancel
+    tk_chooseColor -parent . -title "Press Cancel"
+} -result {}
 
-test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} {unix notAqua} {
+
+test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} -constraints {
+	unix notAqua
+} -body {
     after 50 {set ::scr [winfo screen .__tk__color]}
-    ToPressButton $parent cancel
-    tk_chooseColor -parent $parent
+    ToPressButton . cancel
+    tk_chooseColor -parent .
     set ::scr
-} [winfo screen $parent]
+} -result [winfo screen .]
 
 # cleanup
 cleanupTests
 return
+
diff --git a/tests/font.test b/tests/font.test
index b31bf5a..6cf820e 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -6,47 +6,20 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: font.test,v 1.18 2008/07/23 23:24:25 nijtmans Exp $
+# RCS: @(#) $Id: font.test,v 1.19 2008/08/15 01:10:03 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
-catch {destroy .b}
-toplevel .b
-wm geom .b +0+0
-update idletasks
-
-proc setup {} {
-    catch {destroy .b.f}
-    catch {eval font delete [font names]}
-    label .b.f 
-    pack .b.f
-    update
-}
-
-label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Courier -12"
-pack .b.l
-canvas .b.c -closeenough 0 
-.b.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
-pack .b.c
-update
-
-set ax [winfo reqwidth .b.l]
-set ay [winfo reqheight .b.l]
-proc getsize {} {
-    update
-    return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
-}
 
-proc csetup {{str ""}} {
-    focus -force .b.c
-    .b.c dchars text 0 end
-    .b.c insert text 0 $str
-    .b.c focus text
-}
-
-setup
+catch {eval font delete [font names]}
+deleteWindows
+# Toplevel used (in some tests) of the whole file
+toplevel .t
+wm geom .t +0+0
+update idletasks
 
 case [tk windowingsystem] {
     x11	 	{set fixed "fixed"}
@@ -56,195 +29,242 @@ case [tk windowingsystem] {
 }
 
 
-set times [font actual {times 0} -family]
+# Procedure used in tests: 24.15, 26.*, 28.*, 30.*, 31.*, 32.1
+proc csetup {{str ""}} {
+    focus -force .t.c
+    .t.c dchars text 0 end
+    .t.c insert text 0 $str
+    .t.c focus text
+}
 
-test font-1.1 {TkFontPkgInit} {
+
+test font-1.1 {TkFontPkgInit} -setup {
     catch {interp delete foo}
+} -body {
     interp create foo
     foo eval {
-	load {} Tk
-	wm geometry . +0+0
-	update
+		load {} Tk
+		wm geometry . +0+0
+		update
     }
     interp delete foo
-} {}
+} -result {}
 
-test font-2.1 {TkFontPkgFree} {
+
+test font-2.1 {TkFontPkgFree} -setup {
     catch {interp delete foo}
-    interp create foo
     set x {}
+} -body {
+    interp create foo
 
     # Makes sure that named font was visible only to child interp.
-
     foo eval {
-	load {} Tk
-	wm geometry . +0+0
-	button .b -font {times 16} -text "hi"
-	pack .b
-	font create wiggles -family courier -underline 1
-	update
+		load {} Tk
+		wm geometry . +0+0
+		button .b -font {times 16} -text "hi"
+		pack .b
+		font create wiggles -family courier -underline 1
+		update
     }
     lappend x [catch {font configure wiggles} msg; set msg]
 
     # Tests cancelling the idle handler for TheWorldHasChanged,
     # because app goes away before idle serviced.
-    
     foo eval {
-	.b config -font wiggles
-	font config wiggles -size 24
-	destroy .
+		.b config -font wiggles
+		font config wiggles -size 24
+		destroy .
     }
     lappend x [foo eval {catch {font families} msg; set msg}]
+} -cleanup {
+        interp delete foo
+} -result {{named font "wiggles" doesn't exist} {can't invoke "font" command:  application has been destroyed}}
 
-    interp delete foo
-    set x
-} {{named font "wiggles" doesn't exist} {can't invoke "font" command:  application has been destroyed}}
 
+test font-3.1 {font command: general} -body {
+    font
+} -returnCodes error -result {wrong # args: should be "font option ?arg?"}
+test font-3.2 {font command: general} -body {
+    font xyz
+} -returnCodes error -result {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}
 
-test font-3.1 {font command: general} {
-    list [catch {font} msg] $msg
-} {1 {wrong # args: should be "font option ?arg?"}}
-test font-3.2 {font command: general} {
-    list [catch {font xyz} msg] $msg
-} {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}}
 
-test font-4.1 {font command: actual: arguments} {
+test font-4.1 {font command: actual: arguments} -body {
     # (skip < 0)
-    list [catch {font actual xyz -displayof} msg] $msg
-} {1 {value for "-displayof" missing}}
-test font-4.2 {font command: actual: arguments} {
+    font actual xyz -displayof
+} -returnCodes error -result {value for "-displayof" missing}
+test font-4.2 {font command: actual: arguments} -body {
     # (objc < 3) 
-    list [catch {font actual} msg] $msg
-} {1 {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}}
-test font-4.3 {font command: actual: arguments} {
+    font actual
+} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}
+test font-4.3 {font command: actual: arguments} -body {
     # (objc - skip > 4) when skip == 0
-    list [catch {font actual xyz abc def} msg] $msg
-} {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} {
+    font actual xyz abc def
+} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}
+test font-4.4 {font command: actual: displayof specified, so skip to next} -body {
     catch {font actual xyz -displayof . -size}
-} {0}
-test font-4.5 {font command: actual: displayof specified, so skip to next} {
+} -result {0}
+test font-4.5 {font command: actual: displayof specified, so skip to next} -body {
     lindex [font actual xyz -displayof .] 0
-} {-family}
-test font-4.6 {font command: actual: arguments} {
+} -result {-family}
+test font-4.6 {font command: actual: arguments} -body {
     # (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} {
+    font actual xyz -displayof . abc def
+} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}
+test font-4.7 {font command: actual: arguments} -constraints noExceed -body {
     # (tkfont == NULL)
-    list [catch {font actual "\{xyz"} msg] $msg
-} [list 1 "font \"{xyz\" doesn't exist"]
-test font-4.8 {font command: actual: all attributes} {
+    font actual "\{xyz"
+} -returnCodes error -result "font \"{xyz\" doesn't exist"
+test font-4.8 {font command: actual: all attributes} -body {
     # not (objc > 3) so objPtr = NULL
     lindex [font actual {-family times}] 0
-} {-family}
-test font-4.9 {font command: actual} {unix noExceed} {
+} -result {-family}
+test font-4.9 {font command: actual} -constraints {unix noExceed} -body {
     # (objc > 3) so objPtr = objv[3 + skip]
     string tolower [font actual {-family times} -family]
-} {times}
-test font-4.10 {font command: actual} win {
+} -result {times}
+test font-4.10 {font command: actual} -constraints win -body {
     # (objc > 3) so objPtr = objv[3 + skip]
     font actual {-family times} -family
-} {Times New Roman}
-test font-4.11 {font command: bad option} {
-    list [catch {font actual xyz -style} msg] $msg
-} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+} -result {Times New Roman}
+test font-4.11 {font command: bad option} -body {
+    font actual xyz -style
+} -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}
 
-test font-5.1 {font command: configure} {
+
+test font-5.1 {font command: configure} -body {
     # (objc < 3) 
-    list [catch {font configure} msg] $msg
-} {1 {wrong # args: should be "font configure fontname ?-option value ...?"}}
-test font-5.2 {font command: configure: non-existent font} {
+    font configure
+} -returnCodes error -result {wrong # args: should be "font configure fontname ?-option value ...?"}
+test font-5.2 {font command: configure: non-existent font} -body {
     # (namedHashPtr == NULL)
-    list [catch {font configure xyz} msg] $msg
-} {1 {named font "xyz" doesn't exist}}
-test font-5.3 {font command: configure: "deleted" font} {
+    font configure xyz
+} -returnCodes error -result {named font "xyz" doesn't exist}
+test font-5.3 {font command: configure: "deleted" font} -setup {
+    destroy .t.f
+    catch {font delete xyz}
+    pack [label .t.f]
+    update
+} -body {
     # (nfPtr->deletePending != 0) 
-    setup
     font create xyz
-    .b.f configure -font xyz
+    .t.f configure -font xyz
     font delete xyz
-    list [catch {font configure xyz} msg] $msg
-} {1 {named font "xyz" doesn't exist}}
-test font-5.4 {font command: configure: get all options} {
+    font configure xyz
+} -cleanup {
+    destroy .t.f
+} -returnCodes error -result {named font "xyz" doesn't exist}
+test font-5.4 {font command: configure: get all options} -setup {
+    catch {font delete xyz}
+} -body {
     # (objc == 3) so objPtr = NULL
-    setup
     font create xyz -family xyz
     lindex [font configure xyz] 1
-} xyz
-test font-5.5 {font command: configure: get one option} {
+} -cleanup {
+	font delete xyz
+} -result xyz
+test font-5.5 {font command: configure: get one option} -setup {
+    catch {eval font delete [font names]}
+} -body {
     # (objc == 4) so objPtr = objv[3]
-    setup
     font create xyz -family xyz
     font configure xyz -family
-} xyz
-test font-5.6 {font command: configure: update existing font} {
+	font names
+} -cleanup {
+	font delete xyz
+} -result xyz
+test font-5.6 {font command: configure: update existing font} -setup {
+    catch {font delete xyz}
+} -body {
     # else result = ConfigAttributesObj()
-    setup
     font create xyz
     font configure xyz -family xyz
     update
     font configure xyz -family
-} xyz
-test font-5.7 {font command: configure: bad option} {
-    setup
+} -cleanup {
+	font delete xyz
+} -result xyz
+test font-5.7 {font command: configure: bad option} -setup {
+    catch {font delete xyz}
+} -body {
     font create xyz
-    list [catch {font configure xyz -style} msg] $msg
-} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+    font configure xyz -style
+} -cleanup {
+	font delete xyz
+} -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}
+
 
-test font-6.1 {font command: create: make up name} {
+test font-6.1 {font command: create: make up name} -setup {
+    catch {eval font delete [font names]}
+} -body {
     # (objc < 3) so name = NULL
-    setup
     font create
     font names
-} {font1}
-test font-6.2 {font command: create: name specified} {
+} -cleanup {
+    font delete font1
+} -result {font1}
+test font-6.2 {font command: create: name specified} -setup {
+    catch {eval font delete [font names]}
+} -body {
     # not (objc < 3)
-    setup
     font create xyz
     font names
-} {xyz}
-test font-6.3 {font command: create: name not really specified} {
+} -cleanup {
+	font delete xyz
+} -result {xyz}
+test font-6.3 {font command: create: name not really specified} -setup {
+    catch {eval font delete [font names]}
+} -body {
     # (name[0] == '-') so name = NULL
-    setup
     font create -family xyz
     font names
-} {font1}
-test font-6.4 {font command: create: generate name} {
+} -cleanup {
+    font delete font1
+} -result {font1}
+test font-6.4 {font command: create: generate name} -setup {
+    catch {eval font delete [font names]}
+} -body {
     # (name == NULL)
-    setup
     font create -family one
     font create -family two
     font create -family three
     font delete font2
     font create -family four
     font configure font2 -family
-} {four}
-test font-6.5 {font command: create: bad option creating new font} {
+} -cleanup {
+    catch {eval font delete [font names]}
+} -result {four}
+test font-6.5 {font command: create: bad option creating new font} -setup {
+    catch {font delete xyz}
+} -body {
     # name was specified so skip = 3 
-    setup
-    list [catch {font create xyz -xyz times} msg] $msg
-} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
-test font-6.6 {font command: create: bad option creating new font} {
+    font create xyz -xyz times
+} -returnCodes error -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}
+test font-6.6 {font command: create: bad option creating new font} -setup {
+    catch {eval font delete [font names]}
+} -body {
     # name was not specified so skip = 2 
-    setup
-    list [catch {font create -xyz times} msg] $msg
-} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
-test font-6.7 {font command: create: already exists} {
+    font create -xyz times
+} -returnCodes error -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}
+test font-6.7 {font command: create: already exists} -setup {
+    catch {font delete xyz}
+} -body {
     # (CreateNamedFont() != TCL_OK)
-    setup
     font create xyz
-    list [catch {font create xyz} msg] $msg
-} {1 {named font "xyz" already exists}}
+    font create xyz
+} -cleanup {
+	font delete xyz
+} -returnCodes error -result {named font "xyz" already exists}
 
-test font-7.1 {font command: delete: arguments} {
+test font-7.1 {font command: delete: arguments} -body {
     # (objc < 3) 
-    list [catch {font delete} msg] $msg
-} {1 {wrong # args: should be "font delete fontname ?fontname ...?"}}
-test font-7.2 {font command: delete: loop test} {
+    font delete
+} -returnCodes error -result {wrong # args: should be "font delete fontname ?fontname ...?"}
+test font-7.2 {font command: delete: loop test} -setup {
+    catch {eval font delete [font names]}
+	set x {}
+} -body {
     # for (i = 2; i < objc; i++) 
-    setup
-    set x {}
     font create a -underline 1
     font create b -underline 1
     font create c -underline 1
@@ -253,11 +273,14 @@ test font-7.2 {font command: delete: loop test} {
     lappend x [lsort [font names]]
     font delete a e c b
     lappend x [lsort [font names]]
-} {{a b c d e} d}
-test font-7.3 {font command: delete: loop test} {
+} -cleanup {
+    catch {eval font delete [font names]}
+} -result {{a b c d e} d}
+test font-7.3 {font command: delete: loop test} -setup {
+    catch {eval font delete [font names]}
+	set x {}
+} -body {
     # (namedHashPtr == NULL) in middle of loop
-    setup
-    set x {}
     font create a -underline 1
     font create b -underline 1
     font create c -underline 1
@@ -266,299 +289,440 @@ test font-7.3 {font command: delete: loop test} {
     lappend x [lsort [font names]]
     catch {font delete a d q c e b}
     lappend x [lsort [font names]]
-} {{a b c d e} {b c e}}
-test font-7.4 {font command: delete: non-existent} {
+} -cleanup {
+    catch {eval font delete [font names]}
+} -result {{a b c d e} {b c e}}
+test font-7.4 {font command: delete: non-existent} -setup {
+    catch {font delete xyz}
+} -body {
     # (namedHashPtr == NULL) 
-    setup
-    list [catch {font delete xyz} msg] $msg
-} {1 {named font "xyz" doesn't exist}}
-test font-7.5 {font command: delete: mark for later deletion} {
+    font delete xyz
+} -returnCodes error -result {named font "xyz" doesn't exist}
+test font-7.5 {font command: delete: mark for later deletion} -setup {
+    destroy .t.f
+    catch {font delete xyz}
+    pack [label .t.f]
+    update
+} -body {
     # (nfPtr->refCount != 0)
-    setup
     font create xyz
-    .b.f configure -font xyz
+    .t.f configure -font xyz
     font delete xyz
     font actual xyz
-    list [catch {font configure xyz} msg] $msg [.b.f cget -font]
-} {1 {named font "xyz" doesn't exist} xyz}
-test font-7.6 {font command: delete: actually delete} {
+    font configure xyz
+} -cleanup {
+	destroy .t.f
+} -returnCodes error -result {named font "xyz" doesn't exist}
+test font-7.6 {font command: delete: mark for later deletion} -setup {
+    destroy .t.f
+    catch {font delete xyz}
+    pack [label .t.f]
+    update
+} -body {
+    # (nfPtr->refCount != 0)
+    font create xyz
+    .t.f configure -font xyz
+    font delete xyz
+    font actual xyz
+    catch {font configure xyz}
+	.t.f cget -font
+} -cleanup {
+	destroy .t.f
+} -result xyz
+test font-7.7 {font command: delete: actually delete} -setup {
+    catch {font delete xyz}
+} -body {
     # not (nfPtr->refCount != 0)
-    setup
     font create xyz -underline 1
     font delete xyz
-    catch {font config xyz}
-} {1}
-setup
+    font config xyz
+} -returnCodes error -match glob -result {*}
 
-test font-8.1 {font command: families: arguments} {
+
+test font-8.1 {font command: families: arguments} -body {
     # (skip < 0)
-    list [catch {font families -displayof} msg] $msg
-} {1 {value for "-displayof" missing}}
-test font-8.2 {font command: families: arguments} {
+    font families -displayof
+} -returnCodes error -result {value for "-displayof" missing}
+test font-8.2 {font command: families: arguments} -body {
     # (objc - skip != 2) when skip == 0
-    list [catch {font families xyz} msg] $msg
-} {1 {wrong # args: should be "font families ?-displayof window?"}}
-test font-8.3 {font command: families: arguments} {
+    font families xyz
+} -returnCodes error -result {wrong # args: should be "font families ?-displayof window?"}
+test font-8.3 {font command: families: arguments} -body {
     # (objc - skip != 2) when skip == 2
-    list [catch {font families -displayof . xyz} msg] $msg
-} {1 {wrong # args: should be "font families ?-displayof window?"}}
-test font-8.4 {font command: families} {
+    font families -displayof . xyz
+} -returnCodes error -result {wrong # args: should be "font families ?-displayof window?"}
+test font-8.4 {font command: families} -body {
     # TkpGetFontFamilies()
     regexp -nocase times [font families]
-} {1}
+} -result 1
+
 
-test font-9.1 {font command: measure: arguments} {
+test font-9.1 {font command: measure: arguments} -body {
     # (skip < 0)
-    list [catch {expr {[font measure xyz -displayof]>0}} msg] $msg
-} {0 1}
-test font-9.2 {font command: measure: arguments} {
+    expr {[font measure xyz -displayof] > 0}
+} -returnCodes ok -result 1
+test font-9.2 {font command: measure: arguments} -body {
     # (objc - skip != 4) 
-    list [catch {font measure} msg] $msg
-} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
-test font-9.3 {font command: measure: arguments} {
+    font measure
+} -returnCodes error -result {wrong # args: should be "font measure font ?-displayof window? text"}
+test font-9.3 {font command: measure: arguments} -body {
     # (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} {
+    font measure xyz abc def
+} -returnCodes error -result {wrong # args: should be "font measure font ?-displayof window? text"}
+test font-9.4 {font command: measure: arguments} -constraints noExceed -body {
     # (tkfont == NULL)
-    list [catch {font measure "\{xyz" abc} msg] $msg
-} [list 1 "font \"{xyz\" doesn't exist"]
-test font-9.5 {font command: measure} {
+    font measure "\{xyz" abc
+} -returnCodes error -result "font \"{xyz\" doesn't exist"
+test font-9.5 {font command: measure} -body {
     # Tk_TextWidth()
-    expr [font measure $fixed "abcdefg"]==[font measure $fixed "a"]*7
-} {1}
-test font-9.6 {font command: measure -d} {
-     list [catch {expr {[font measure $fixed -d] > 0}} msg] $msg
-} {0 1}
-test font-9.7 {font command: measure -d with -displayof} {
-     list [catch {expr {[font measure $fixed -displayof . -d] > 0}} msg] $msg
-} {0 1}
-test font-9.8 {font command: measure: arguments} {
-    list [catch {font measure $fixed -displayof .} msg] $msg
-} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
-
-test font-10.1 {font command: metrics: arguments} {
-    list [catch {font metrics xyz -displayof} msg] $msg
-} {1 {value for "-displayof" missing}}
-test font-10.2 {font command: metrics: arguments} {
+    expr {[font measure $fixed "abcdefg"] == [font measure $fixed "a"]*7 }
+} -result 1
+test font-9.6 {font command: measure -d} -body {
+     expr {[font measure $fixed -d] > 0}
+} -returnCodes ok -result 1
+test font-9.7 {font command: measure -d with -displayof} -body {
+     expr {[font measure $fixed -displayof . -d] > 0}
+} -returnCodes ok -result 1
+test font-9.8 {font command: measure: arguments} -body {
+    font measure $fixed -displayof .
+} -returnCodes error -result {wrong # args: should be "font measure font ?-displayof window? text"}
+
+
+test font-10.1 {font command: metrics: arguments} -body {
+    font metrics xyz -displayof
+} -returnCodes error -result {value for "-displayof" missing}
+test font-10.2 {font command: metrics: arguments} -body {
     # (skip < 0)
-    list [catch {font metrics xyz -displayof} msg] $msg
-} {1 {value for "-displayof" missing}}
-test font-10.3 {font command: metrics: arguments} {
+    font metrics xyz -displayof
+} -returnCodes error -result {value for "-displayof" missing}
+test font-10.3 {font command: metrics: arguments} -body {
     # (objc < 3) 
-    list [catch {font metrics} msg] $msg
-} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
-test font-10.4 {font command: metrics: arguments} {
+    font metrics
+} -returnCodes error -result {wrong # args: should be "font metrics font ?-displayof window? ?option?"}
+test font-10.4 {font command: metrics: arguments} -body {
     # (objc - skip) > 4) when skip == 0
-    list [catch {font metrics xyz abc def} msg] $msg
-} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
-test font-10.5 {font command: metrics: arguments} {
+    font metrics xyz abc def
+} -returnCodes error -result {wrong # args: should be "font metrics font ?-displayof window? ?option?"}
+test font-10.5 {font command: metrics: arguments} -body {
     # (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} {
+    font metrics xyz -displayof . abc
+} -returnCodes error -result {bad metric "abc": must be -ascent, -descent, -linespace, or -fixed}
+test font-10.6 {font command: metrics: bad font} -constraints noExceed -body {
     # (tkfont == NULL)
-    list [catch {font metrics "\{xyz"} msg] $msg
-} [list 1 "font \"{xyz\" doesn't exist"]
-test font-10.7 {font command: metrics: get all metrics} {
-    # (objc == 3)
+    font metrics "\{xyz"
+} -returnCodes error -result "font \"{xyz\" doesn't exist"
+test font-10.7 {font command: metrics: get all metrics} -setup {
     catch {unset a}
+} -body {
+    # (objc == 3)
     array set a [font metrics {-family xyz}]
-    set x [lsort [array names a]]
+    lsort [array names a]
+} -cleanup {
     unset a
-    set x    
-} {-ascent -descent -fixed -linespace}
-test font-10.8 {font command: metrics: bad metric} {
+} -result {-ascent -descent -fixed -linespace}
+test font-10.8 {font command: metrics: bad metric} -body {
     # (Tcl_GetIndexFromObj() != TCL_OK)
-    list [catch {font metrics $fixed -xyz} msg] $msg
-} {1 {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed}}
-test font-10.9 {font command: metrics: get individual metrics} {
+    font metrics $fixed -xyz
+} -returnCodes error -result {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed}
+test font-10.9 {font command: metrics: get individual metrics} -body {
     font metrics $fixed -ascent
     font metrics $fixed -descent
     font metrics $fixed -linespace
     font metrics $fixed -fixed
-} {1}
+} -result 1
+
 
-test font-11.1 {font command: names: arguments} {
+test font-11.1 {font command: names: arguments} -body {
     # (objc != 2)
-    list [catch {font names xyz} msg] $msg
-} {1 {wrong # args: should be "font names"}}
-test font-11.2 {font command: names: loop test: no passes} {
-    setup
+    font names xyz
+} -returnCodes error -result {wrong # args: should be "font names"}
+test font-11.2 {font command: names: loop test: no passes} -setup {
+    catch {eval font delete [font names]}
+} -body {
     font names
-} {}
-test font-11.3 {font command: names: loop test: one pass} {
-    setup
+} -result {}
+test font-11.3 {font command: names: loop test: one pass} -setup {
+    catch {eval font delete [font names]}
+} -body {
     font create
     font names
-} {font1}
-test font-11.4 {font command: names: loop test: multiple passes} {
-    setup
+} -result {font1}
+test font-11.4 {font command: names: loop test: multiple passes} -setup {
+    catch {eval font delete [font names]}
+} -body {
     font create xyz
     font create abc
     font create def
     lsort [font names]
-} {abc def xyz}
-test font-11.5 {font command: names: skip deletePending fonts} {
-    # (nfPtr->deletePending == 0)
-    setup
+} -cleanup {
+    catch {eval font delete [font names]}
+} -result {abc def xyz}
+test font-11.5 {font command: names: skip deletePending fonts} -setup {
+    destroy .t.f
+    catch {eval font delete [font names]}
+    pack [label .t.f]
+    update
     set x {}
+} -body {
+    # (nfPtr->deletePending == 0)
     font create xyz
     font create abc
     lappend x [lsort [font names]]
-    .b.f config -font xyz
+    .t.f config -font xyz
     font delete xyz
     lappend x [font names]
-} {{abc xyz} abc}
+} -cleanup {
+    catch {eval font delete [font names]}
+} -result {{abc xyz} abc}
 
-test font-12.1 {UpdateDependantFonts procedure: no users} {
+
+test font-12.1 {UpdateDependantFonts procedure: no users} -setup {
+    catch {font delete xyz}
+} -body {
     # (nfPtr->refCount == 0)
-    setup
     font create xyz
     font configure xyz -family times
-} {}
-test font-12.2 {UpdateDependantFonts procedure: pings the widgets} {
-    setup
+} -cleanup {
+	font delete xyz
+} -result {}
+test font-12.2 {UpdateDependantFonts procedure: pings the widgets} -setup {
+    destroy .t.f
+    catch {font delete xyz}
+    pack [label .t.f]
+    update
+} -body {
     font create xyz -family times -size 20
-    .b.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0
+    .t.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0
     set a1 [font measure xyz "abcd"]
     update
-    set b1 [winfo reqwidth .b.f]
+    set b1 [winfo reqwidth .t.f]
     font configure xyz -family helvetica -size 20
     set a2 [font measure xyz "abcd"]
     update
-    set b2 [winfo reqwidth .b.f]
+    set b2 [winfo reqwidth .t.f]
     expr {$a1==$b1 && $a2==$b2}
-} {1}
+} -cleanup {
+	destroy .t.f
+    font delete xyz
+} -result {1}
+
 
-test font-13.1 {CreateNamedFont: new named font} {
+test font-13.1 {CreateNamedFont: new named font} -setup {
+    catch {font delete xyz}
+	set x {}
+} -body {
     # not (new == 0)
-    setup
-    set x {}
     lappend x [font names]
     font create xyz
     lappend x [font names]
-} {{} xyz}
-test font-13.2 {CreateNamedFont: named font already exists} {
+} -cleanup {
+	font delete xyz
+} -result {{} xyz}
+test font-13.2 {CreateNamedFont: named font already exists} -setup {
+    catch {font delete xyz}
+} -body {
     # (new == 0)
-    setup
     font create xyz
-    list [catch {font create xyz} msg] $msg
-} {1 {named font "xyz" already exists}}
-test font-13.3 {CreateNamedFont: named font already exists} {
+    font create xyz
+} -cleanup {
+	font delete xyz
+} -returnCodes error -result {named font "xyz" already exists}
+test font-13.3 {CreateNamedFont: named font already exists} -setup {
+    catch {font delete xyz}
+} -body {
     # (nfPtr->deletePending == 0)
-    setup
     font create xyz
-    list [catch {font create xyz} msg] $msg
-} {1 {named font "xyz" already exists}}
-test font-13.4 {CreateNamedFont: recreate "deleted" font} {
+    font create xyz
+} -cleanup {
+	font delete xyz
+} -returnCodes error -result {named font "xyz" already exists}
+test font-13.4 {CreateNamedFont: recreate "deleted" font} -setup {
+    destroy .t.f
+    catch {font delete xyz}
+    pack [label .t.f]
+    update
+} -body {
     # not (nfPtr->deletePending == 0)
-    setup
     font create xyz -family times
-    .b.f configure -font xyz
+    .t.f configure -font xyz
     font delete xyz
     font create xyz -family courier
     font configure xyz -family
-} {courier}
+} -cleanup {
+	font delete xyz
+	destroy .t.f
+} -result {courier}
+
+
+test font-14.1 {Tk_GetFont procedure} -body {
+} -result {}
 
-test font-14.1 {Tk_GetFont procedure} {
-} {}
 
-test font-15.1 {Tk_AllocFontFromObj - converting internal reps} testfont {
+test font-15.1 {Tk_AllocFontFromObj - converting internal reps} -constraints {
+	testfont 
+} -setup {
+    destroy .b1 .b2
+} -body {
     set x {Times 16}
     lindex $x 0
-    destroy .b1 .b2
     button .b1 -font $x
     lindex $x 0
     testfont counts {Times 16}
-} {{1 0}}
-test font-15.2 {Tk_AllocFontFromObj - discard stale font} testfont {
-    set x {Times 16}
+} -cleanup {
+    destroy .b1 .b2
+} -result {{1 0}}
+test font-15.2 {Tk_AllocFontFromObj - discard stale font} -constraints {
+	testfont 
+} -setup {
     destroy .b1 .b2
+    set result {}
+} -body {
+    set x {Times 16}
     button .b1 -font $x
     destroy .b1
-    set result {}
     lappend result [testfont counts {Times 16}]
     button .b2 -font $x
     lappend result [testfont counts {Times 16}]
-} {{} {{1 1}}}
-test font-15.3 {Tk_AllocFontFromObj - reuse existing font} testfont {
-    set x {Times 16}
+} -cleanup {
+    destroy .b2
+} -result {{} {{1 1}}}
+test font-15.3 {Tk_AllocFontFromObj - reuse existing font} -constraints {
+	testfont 
+} -setup {
     destroy .b1 .b2
-    button .b1 -font $x
     set result {}
+} -body {
+    set x {Times 16}
+    button .b1 -font $x
     lappend result [testfont counts {Times 16}]
     button .b2 -font $x
     pack .b1 .b2 -side top
     lappend result [testfont counts {Times 16}]
-} {{{1 1}} {{2 1}}}
-test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} {
+} -cleanup {
+    destroy .b1 .b2
+} -result {{{1 1}} {{2 1}}}
+test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} -setup {
+    destroy .t.f
+    pack [label .t.f]
+    update
+} -body {
     # (new == 0)
-    setup
-    .b.f config -font {-family fixed}
+    .t.f config -font {-family fixed}
     lindex [font actual {-family fixed}] 0
-} {-family}
-test font-15.5 {Tk_AllocFontFromObj procedure: get named font} {
+} -cleanup {
+	destroy .t.f
+} -result {-family}
+test font-15.5 {Tk_AllocFontFromObj procedure: get named font} -setup {
+    destroy .t.f
+    catch {font delete xyz}
+    pack [label .t.f]
+    update
+} -body {
     # (namedHashPtr != NULL) 
-    setup
     font create xyz 
-    .b.f config -font xyz 
-} {}
-test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} {
+    .t.f config -font xyz 
+} -cleanup {
+	destroy .t.f
+    font delete xyz
+} -result {}
+test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} -setup {
+    destroy .t.f
+    pack [label .t.f]
+    update
+} -body {
     # not (namedHashPtr != NULL)
-    setup
-    .b.f config -font {times 20}
-} {}
-test font-15.7 {Tk_AllocFontFromObj procedure: get native font} unix {
+    .t.f config -font {times 20}
+} -cleanup {
+	destroy .t.f
+} -result {-family} -result {}
+test font-15.7 {Tk_AllocFontFromObj procedure: get native font} -constraints {
+	unix 
+} -setup {
+    destroy .t.f
+    pack [label .t.f]
+    update
+} -body {
     # not (fontPtr == NULL) 
-    setup
-    .b.f config -font fixed
-} {}
-test font-15.8 {Tk_AllocFontFromObj procedure: get native font} win {
+    .t.f config -font fixed
+} -result {}
+test font-15.8 {Tk_AllocFontFromObj procedure: get native font} -constraints {
+	win 
+} -setup {
+    destroy .t.f
+	catch {eval font delete [font names]}
+    pack [label .t.f]
+    update
+} -body {
     # not (fontPtr == NULL) 
-    setup
-    .b.f config -font oemfixed
-} {}
-test font-15.10 {Tk_AllocFontFromObj procedure: get attribute font} {
+    .t.f config -font oemfixed
+} -cleanup {
+	destroy .t.f
+} -result {}
+test font-15.9 {Tk_AllocFontFromObj procedure: get attribute font} -setup {
+    destroy .t.f
+    pack [label .t.f]
+    update
+} -body {
     # (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} {
+    .t.f config -font {xxx yyy zzz}
+} -cleanup {
+	destroy .t.f
+} -returnCodes error -result {expected integer but got "yyy"}
+test font-15.10 {Tk_AllocFontFromObj procedure: no match} -constraints noExceed -body {
     # (ParseFontNameObj() != TCL_OK)
-    list [catch {font actual "\{xyz"} msg] $msg
-} [list 1 "font \"{xyz\" doesn't exist"]
-test font-15.12 {Tk_AllocFontFromObj procedure: get attribute font} {
+    font actual "\{xyz"
+} -returnCodes error -result "font \"{xyz\" doesn't exist"
+test font-15.11 {Tk_AllocFontFromObj procedure: get attribute font} -body {
     # not (ParseFontNameObj() != TCL_OK)
     lindex [font actual {plan 9}] 0
-} {-family}
-test font-15.13 {Tk_AllocFontFromObj procedure: setup tab width} {
+} -result {-family}
+test font-15.12 {Tk_AllocFontFromObj procedure: setup tab width} -setup {
+	destroy .l
+} -body {
     # Tk_MeasureChars(fontPtr, "0", ...)
     label .l -bd 0 -padx 0  -highlightthickness 0 -font $fixed -text "a\tb"
     update
-    set x [winfo reqwidth .l]
-    destroy .l
-    set x
-} [expr [font measure $fixed "0"]*9]
-test font-15.14 {Tk_AllocFontFromObj procedure: underline position} {
+    set res1 [winfo reqwidth .l]
+	set res2 [expr [font measure $fixed "0"]*9]
+	expr {$res1 eq $res2}
+} -cleanup {
+	destroy .l
+} -result 1
+test font-15.13 {Tk_AllocFontFromObj procedure: underline position} -setup {
+    destroy .t.f
+    pack [label .t.f]
+    update
+} -body {
     # (fontPtr->underlineHeight == 0) because size was < 10
-    setup
-    .b.f config -text "underline" -font "times -8 underline"
+    .t.f config -text "underline" -font "times -8 underline"
     update
-} {}    
+} -cleanup {
+	destroy .t.f
+} -result {}    
 
-test font-16.1 {Tk_NameOfFont procedure} {
-    setup
-    .b.f config -font -family\ fixed
-    .b.f cget -font
-} {-family fixed}
 
-test font-17.1 {Tk_FreeFontFromObj - reference counts} testfont {
-    set x {Courier 12}
+test font-16.1 {Tk_NameOfFont procedure} -setup {
+    destroy .t.f
+    pack [label .t.f]
+    update
+} -body {
+    .t.f config -font -family\ fixed
+    .t.f cget -font
+} -cleanup {
+	destroy .t.f
+} -result {-family fixed}
+
+
+test font-17.1 {Tk_FreeFontFromObj - reference counts} -constraints {
+	testfont 
+} -setup {
     destroy .b1 .b2 .b3
+    set result {}
+} -body {
+    set x {Courier 12}
     button .b1 -font $x
     button .b3 -font $x
     button .b2 -font $x
-    set result {}
     lappend result [testfont counts {Courier 12}]
     destroy .b1
     lappend result [testfont counts {Courier 12}]
@@ -566,61 +730,83 @@ test font-17.1 {Tk_FreeFontFromObj - reference counts} testfont {
     lappend result [testfont counts {Courier 12}]
     destroy .b3
     lappend result [testfont counts {Courier 12}]
-} {{{3 1}} {{2 1}} {{1 1}} {}}
-test font-17.2 {Tk_FreeFont procedure: one ref} {
+} -result {{{3 1}} {{2 1}} {{1 1}} {}}
+test font-17.2 {Tk_FreeFont procedure: one ref} -setup {
+    destroy .t.f
+    pack [label .t.f]
+    update
+} -body {
     # (fontPtr->refCount == 0)
-    setup
-    .b.f config -font {-family fixed}
-    destroy .b.f
-} {}
-test font-17.3 {Tk_FreeFont procedure: multiple ref} {
+    .t.f config -font {-family fixed}
+    destroy .t.f
+} -result {}
+test font-17.3 {Tk_FreeFont procedure: multiple ref} -setup {
+    destroy .t.f .t.b
+    pack [label .t.f]
+    update
+} -body {
     # not (fontPtr->refCount == 0)
-    setup
-    .b.f config -font {-family fixed}
-    button .b.b -font {-family fixed}
-    destroy .b.f
-    set x [.b.b cget -font]
-    destroy .b.b
-    set x
-} {-family fixed}
-test font-17.4 {Tk_FreeFont procedure: named font} {
+    .t.f config -font {-family fixed}
+    button .t.b -font {-family fixed}
+    destroy .t.f
+    .t.b cget -font
+} -cleanup {
+    destroy .t.b
+} -result {-family fixed}
+test font-17.4 {Tk_FreeFont procedure: named font} -setup {
+    destroy .t.f
+    catch {eval font delete [font names]}
+    pack [label .t.f]
+    update
+} -body {
     # (fontPtr->namedHashPtr != NULL) 
-    setup
     font create xyz
-    .b.f config -font xyz
-    destroy .b.f
+    .t.f config -font xyz
+    destroy .t.f
     font names
-} {xyz}
-test font-17.5 {Tk_FreeFont procedure: named font} {
+} -result {xyz}
+test font-17.5 {Tk_FreeFont procedure: named font} -setup {
+    destroy .t.f
+    catch {font delete xyz}
+    pack [label .t.f]
+    update
+} -body {
     # not (fontPtr->refCount == 0) 
-    setup
     font create xyz -underline 1
-    .b.f config -font xyz
+    .t.f config -font xyz
     font delete xyz
     set x [font actual xyz -underline]
-    destroy .b.f
+    destroy .t.f
     list [font actual xyz -underline] $x
-} {0 1}
-test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} {
-    setup
+} -result {0 1}
+test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} -setup {
+    destroy .t.f .t.b
+    catch {font delete xyz}
+    pack [label .t.f]
+    update
+} -body {
     font create xyz 
-    .b.f config -font xyz
-    button .b.b -font xyz
+    .t.f config -font xyz
+    button .t.b -font xyz
     font delete xyz
     set x [font actual xyz]
-    destroy .b.b
+    destroy .t.b
     list [lindex [font actual xyz] 0] [lindex $x 0]
-} {-family -family}
+} -cleanup {
+    destroy .t.f
+} -result {-family -family}
 
-test font-18.1 {FreeFontObjProc} testfont {
+
+test font-18.1 {FreeFontObjProc} -constraints testfont -setup {
     destroy .b1
+    set result {}
+} -body {
     set x [format {Courier 12}]
     button .b1 -font $x
     set y [format {Courier 12}]
     .b1 configure -font $y
     set z [format {Courier 12}]
     .b1 configure -font $z
-    set result {}
     lappend result [testfont counts {Courier 12}]
     set x red
     lappend result [testfont counts {Courier 12}]
@@ -629,275 +815,864 @@ test font-18.1 {FreeFontObjProc} testfont {
     destroy .b1
     lappend result [testfont counts {Courier 12}]
     set y bogus
-    set result
-} {{{1 3}} {{1 2}} {{1 1}} {}}
+    return $result
+} -result {{{1 3}} {{1 2}} {{1 1}} {}}
+
 
-test font-19.1 {Tk_FontId} {
-    .b.f config -font "times 20"
+test font-19.1 {Tk_FontId} -setup {
+    destroy .t.f
+    pack [label .t.f]
     update
-} {}
+} -body {
+    .t.f config -font "times 20"
+    update
+} -cleanup {
+	destroy .t.f
+} -result {}
+
 
-test font-20.1 {Tk_GetFontMetrics procedure} {
-    button .b.w1 -text abc
-    entry .b.w2 -text abcd
+test font-20.1 {Tk_GetFontMetrics procedure} -setup {
+	destroy .t.w1 .t.w2
+} -body {
+    button .t.w1 -text abc
+    entry .t.w2 -text abcd
     update
-    destroy .b.w1 .b.w2
-} {}
+    destroy .t.w1 .t.w2
+} -result {}
 
+
+# Procedure used in 21.* tests
 proc psfontname {name} {
-    set a [.b.c itemcget text -font]
-    .b.c itemconfig text -text "We need text" -font $name
-    set post [.b.c postscript]
-    .b.c itemconfig text -font $a
+	destroy .t.c
+	canvas .t.c -closeenough 0 
+	.t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
+	pack .t.c
+	update
+    set a [.t.c itemcget text -font]
+    .t.c itemconfig text -text "We need text" -font $name
+    set post [.t.c postscript]
+    .t.c itemconfig text -font $a
     set end [string first "findfont" $post]
     incr end -2
     set post [string range $post [expr $end-70] $end]
     set start [string first "gsave" $post]
+	destroy .t.c
     return [string range $post [expr $start+7] end]
 }
-test font-21.1 {Tk_PostscriptFontName procedure: native} unix {
+test font-21.1 {Tk_PostscriptFontName procedure: native} -constraints {
+	unix
+} -body {
     set x [font actual {{itc avant garde} 10} -family]
     if {[string match *avant*garde $x]} {
-	psfontname "{itc avant garde} 10"
+		psfontname "{itc avant garde} 10"
     } else {
-	set x {AvantGarde-Book}
+		set x {AvantGarde-Book}
     }
-} {AvantGarde-Book}
-test font-21.2 {Tk_PostscriptFontName procedure: native} win {
+} -result {AvantGarde-Book}
+test font-21.2 {Tk_PostscriptFontName procedure: native} -constraints {
+	win 
+} -body {
     psfontname "arial 10"
-} {Helvetica}
-test font-21.3 {Tk_PostscriptFontName procedure: native} win {
+} -result {Helvetica}
+test font-21.3 {Tk_PostscriptFontName procedure: native} -constraints {
+	win 
+} -body {
     psfontname "{times new roman} 10"
-} {Times-Roman}
-test font-21.4 {Tk_PostscriptFontName procedure: native} win {
+} -result {Times-Roman}
+test font-21.4 {Tk_PostscriptFontName procedure: native} -constraints {
+	win 
+} -body {
     psfontname "{courier new} 10"
-} {Courier}
-test font-21.8 {Tk_PostscriptFontName procedure: spaces} unix {
+} -result {Courier}
+test font-21.5 {Tk_PostscriptFontName procedure: spaces} -constraints {
+	unix 
+} -body {
     set x [font actual {{lucida bright} 10} -family]
     if {[string match lucida*bright $x]} {
-	psfontname "{lucida bright} 10"
+		psfontname "{lucida bright} 10"
     } else {
-	set x {LucidaBright}
+		set x {LucidaBright}
     }
-} {LucidaBright}
-test font-21.9 {Tk_PostscriptFontName procedure: spaces} unix {
+} -result {LucidaBright}
+test font-21.6 {Tk_PostscriptFontName procedure: spaces} -constraints {
+	unix 
+} -body {
     psfontname "{new century schoolbook} 10"
-} {NewCenturySchlbk-Roman}
-set i 10
-foreach p {
-    {font-21.10 "avantgarde"
-	    AvantGarde-Book AvantGarde-Demi
-	    AvantGarde-BookOblique AvantGarde-DemiOblique}
-    {font-21.11 "bookman"
-	    Bookman-Light Bookman-Demi Bookman-LightItalic Bookman-DemiItalic}
-    {font-21.12 "courier"
-	    Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
-    {font-21.13 "helvetica"
-	    Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
-    {font-21.14 "new century schoolbook"
-	    NewCenturySchlbk-Roman NewCenturySchlbk-Bold
-	    NewCenturySchlbk-Italic NewCenturySchlbk-BoldItalic}
-    {font-21.15 "palatino"
-	    Palatino-Roman Palatino-Bold Palatino-Italic Palatino-BoldItalic}
-    {font-21.16 "symbol"
-	    Symbol Symbol Symbol Symbol}
-    {font-21.17 "times"
-	    Times-Roman Times-Bold Times-Italic Times-BoldItalic}
-    {font-21.18 "zapfchancery"
-	    ZapfChancery-MediumItalic ZapfChancery-MediumItalic
-	    ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
-    {font-21.19 "zapfdingbats"
-	    ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
-} {
-    set values [lassign $p testName family]
-    test $testName {Tk_PostscriptFontName procedure: exhaustive} unix {
-	set x {}
-	set j 0
-	foreach slant {roman italic} {
-	    foreach weight {normal bold} {
-		set name [list $family 12 $slant $weight]
-		if {[font actual $name -family] == $family} {
-		    lappend x [psfontname $name]
-		} else {
-		    lappend x [lindex $values $j]
-		}
-		incr j
-	    }
-	}
-	set x
-    } $values
-}
-foreach p {
-    {font-21.20 "arial"
-	    Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
-    {font-21.21 "courier new"
-	    Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
-    {font-21.22 "helvetica"
-	    Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
-    {font-21.23 "symbol"
-	    Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
-    {font-21.24 "times new roman"
-	    Times-Roman Times-Bold Times-Italic Times-BoldItalic}
-} {
-    set values [lassign $p testName family]
-    test $testName {Tk_PostscriptFontName procedure: exhaustive} win {
-	set x {}
-	foreach slant {roman italic} {
-	    foreach weight {normal bold} {
-		lappend x [psfontname [list $family 12 "$slant $weight"]]
-	    }
-	}
-	set x
-    } $values
-}
+} -result {NewCenturySchlbk-Roman}
+
+test font-21.7 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {avantgarde 12 roman normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "avantgarde"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x AvantGarde-Book
+    }
+} -result {AvantGarde-Book}
+test font-21.8 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {avantgarde 12 roman bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "avantgarde"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x AvantGarde-Demi
+    }
+} -result {AvantGarde-Demi}
+test font-21.9 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {avantgarde 12 italic normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "avantgarde"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x AvantGarde-BookOblique
+    }
+} -result {AvantGarde-BookOblique}
+test font-21.10 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {avantgarde 12 italic bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "avantgarde"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x AvantGarde-DemiOblique
+    }
+} -result {AvantGarde-DemiOblique}
+
+test font-21.11 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {bookman 12 roman normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "bookman"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Bookman-Light
+    }
+} -result {Bookman-Light}
+test font-21.12 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {bookman 12 roman bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "bookman"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Bookman-Demi
+    }
+} -result {Bookman-Demi}
+test font-21.13 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {bookman 12 italic normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "bookman"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Bookman-LightItalic
+    }
+} -result {Bookman-LightItalic}
+test font-21.14 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {bookman 12 italic bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "bookman"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Bookman-DemiItalic
+    }
+} -result {Bookman-DemiItalic}
+
+test font-21.15 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {courier 12 roman normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "courier"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Courier
+    }
+} -result {Courier}
+test font-21.16 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {courier 12 roman bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "courier"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Courier-Bold
+    }
+} -result {Courier-Bold}
+test font-21.17 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {courier 12 italic normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "courier"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Courier-Oblique
+    }
+} -result {Courier-Oblique}
+test font-21.18 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {courier 12 italic bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "courier"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Courier-BoldOblique
+    }
+} -result {Courier-BoldOblique}
+
+test font-21.19 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {helvetica 12 roman normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "helvetica"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Helvetica
+    }
+} -result {Helvetica}
+test font-21.20 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {helvetica 12 roman bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "helvetica"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Helvetica-Bold
+    }
+} -result {Helvetica-Bold}
+test font-21.21 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {helvetica 12 italic normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "helvetica"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Helvetica-Oblique
+    }
+} -result {Helvetica-Oblique}
+test font-21.22 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {helvetica 12 italic bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "helvetica"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Helvetica-BoldOblique
+    }
+} -result {Helvetica-BoldOblique}
+
+test font-21.23 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {{new century schoolbook} 12 roman normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "new century schoolbook"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x NewCenturySchlbk-Roman
+    }
+} -result {NewCenturySchlbk-Roman}
+test font-21.24 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {{new century schoolbook} 12 roman bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "new century schoolbook"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x NewCenturySchlbk-Bold
+    }
+} -result {NewCenturySchlbk-Bold}
+test font-21.25 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {{new century schoolbook} 12 italic normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "new century schoolbook"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x NewCenturySchlbk-Italic
+    }
+} -result {NewCenturySchlbk-Italic}
+test font-21.26 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {{new century schoolbook} 12 italic bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "new century schoolbook"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x NewCenturySchlbk-BoldItalic
+    }
+} -result {NewCenturySchlbk-BoldItalic}
+
+test font-21.27 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {palatino 12 roman normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "palatino"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Palatino-Roman
+    }
+} -result {Palatino-Roman}
+test font-21.28 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {palatino 12 roman bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "palatino"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Palatino-Bold
+    }
+} -result {Palatino-Bold}
+test font-21.29 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {palatino 12 italic normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "palatino"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Palatino-Italic
+    }
+} -result {Palatino-Italic}
+test font-21.30 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {palatino 12 italic bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "palatino"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Palatino-BoldItalic
+    }
+} -result {Palatino-BoldItalic}
+
+test font-21.31 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {symbol 12 roman normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "symbol"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Symbol
+    }
+} -result {Symbol}
+test font-21.32 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {symbol 12 roman bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "symbol"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Symbol
+    }
+} -result {Symbol}
+test font-21.33 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {symbol 12 italic normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "symbol"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Symbol
+    }
+} -result {Symbol}
+test font-21.34 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {symbol 12 italic bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "symbol"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Symbol
+    }
+} -result {Symbol}
+
+test font-21.35 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {times 12 roman normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "times"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Times-Roman
+    }
+} -result {Times-Roman}
+test font-21.36 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {times 12 roman bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "times"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Times-Bold
+    }
+} -result {Times-Bold}
+test font-21.37 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {times 12 italic normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "times"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Times-Italic
+    }
+} -result {Times-Italic}
+test font-21.38 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {times 12 italic bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "times"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x Times-BoldItalic
+    }
+} -result {Times-BoldItalic}
+
+test font-21.39 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {zapfchancery 12 roman normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "zapfchancery"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x ZapfChancery-MediumItalic
+    }
+} -result {ZapfChancery-MediumItalic}
+test font-21.40 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {zapfchancery 12 roman bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "zapfchancery"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x ZapfChancery-MediumItalic
+    }
+} -result {ZapfChancery-MediumItalic}
+test font-21.41 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {zapfchancery 12 italic normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "zapfchancery"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x ZapfChancery-MediumItalic
+    }
+} -result {ZapfChancery-MediumItalic}
+test font-21.42 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {zapfchancery 12 italic bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "zapfchancery"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x ZapfChancery-MediumItalic
+    }
+} -result {ZapfChancery-MediumItalic}
+
+test font-21.43 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {zapfdingbats 12 roman normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "zapfdingbats"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x ZapfDingbats
+    }
+} -result {ZapfDingbats}
+test font-21.44 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {zapfdingbats 12 roman bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "zapfdingbats"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x ZapfDingbats
+    }
+} -result {ZapfDingbats}
+test font-21.45 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {zapfdingbats 12 italic normal}
+    if {[font actual {avantgarde 12 roman normal} -family] == "zapfdingbats"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x ZapfDingbats
+    }
+} -result {ZapfDingbats}
+test font-21.46 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    unix 
+} -body {
+    set name {zapfdingbats 12 italic bold}
+    if {[font actual {avantgarde 12 roman normal} -family] == "zapfdingbats"} {
+        set x [psfontname avantgarde 12 roman normal]
+    } else {
+        set x ZapfDingbats
+    }
+} -result {ZapfDingbats}
+
+test font-21.47 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {arial 12 roman normal}]
+} -result {Helvetica}
+test font-21.48 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {arial 12 roman bold}]
+} -result {Helvetica-Bold}
+test font-21.49 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {arial 12 italic normal}]
+} -result {Helvetica-Oblique}
+test font-21.50 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {arial 12 italic bold}]
+} -result {Helvetica-BoldOblique}
+
+test font-21.51 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {{courier new} 12 roman normal}]
+} -result {Courier}
+test font-21.52 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {{courier new} 12 roman bold}]
+} -result {Courier-Bold}
+test font-21.53 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {{courier new} 12 italic normal}]
+} -result {Courier-Oblique}
+test font-21.54 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {{courier new} 12 italic bold}]
+} -result {Courier-BoldOblique}
+
+test font-21.55 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {helvetica 12 roman normal}]
+} -result {Helvetica}
+test font-21.56 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {helvetica 12 roman bold}]
+} -result {Helvetica-Bold}
+test font-21.57 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {helvetica 12 italic normal}]
+} -result {Helvetica-Oblique}
+test font-21.58 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {helvetica 12 italic bold}]
+} -result {Helvetica-BoldOblique}
+
+test font-21.59 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {symbol 12 roman normal}]
+} -result {Symbol}
+test font-21.60 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {symbol 12 roman bold}]
+} -result {Symbol-Bold}
+test font-21.61 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {symbol 12 italic normal}]
+} -result {Symbol-Italic}
+test font-21.62 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {symbol 12 italic bold}]
+} -result {Symbol-BoldItalic}
+
+test font-21.63 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {{times new roman} 12 roman normal}]
+} -result {Times-Roman}
+test font-21.64 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {{times new roman} 12 roman bold}]
+} -result {Times-Bold}
+test font-21.65 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {{times new roman} 12 italic normal}]
+} -result {Times-Italic}
+test font-21.66 {Tk_PostscriptFontName procedure: exhaustive} -constraints {
+    win
+} -body {
+    set x [psfontname {{times new roman} 12 italic bold}]
+} -result {Times-BoldItalic}
+
+
+test font-22.1 {Tk_TextWidth procedure} -setup {
+	destroy .t.l 
+} -body {
+	label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
+		-text "0" -font "Courier -12"
+	pack .t.l
+	set ax [winfo reqwidth .t.l]
+    expr {[font measure [.t.l cget -font] "000"] eq $ax*3}
+} -cleanup {
+	destroy .t.l
+} -result 1
+
+
+test font-23.1 {Tk_UnderlineChars procedure} -setup {
+	destroy .t.t
+} -body {
+    text .t.t
+    .t.t insert 1.0 abc\tdefg
+    .t.t tag config sel -underline 1
+    .t.t tag add sel 1.0 end
+    update
+} -cleanup {
+	destroy .t.t
+} -result {}
 
-test font-22.1 {Tk_TextWidth procedure} {
-    font measure [.b.l cget -font] "000"
-} [expr $ax*3]
 
-test font-23.1 {Tk_UnderlineChars procedure} {
-    text .b.t
-    .b.t insert 1.0 abc\tdefg
-    .b.t tag config sel -underline 1
-    .b.t tag add sel 1.0 end
-    update
-} {}
-
-setup
-test font-24.1 {Tk_ComputeTextLayout: empty string} {
-    .b.l config -text ""
-} {}
-test font-24.2 {Tk_ComputeTextLayout: simple string} {
-    .b.l config -text "000"
-    getsize
-} "[expr $ax*3] $ay"
-test font-24.3 {Tk_ComputeTextLayout: find special chars} {
-    .b.l config -text "000\n000"
-    getsize
-} "[expr $ax*3] [expr $ay*2]"
-test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} {
-    .b.l config -text "000\n000"
-    getsize
-} "[expr $ax*3] [expr $ay*2]"
-test font-24.5 {Tk_ComputeTextLayout: break line} {
-    .b.l config -text "000\t00000" -wrap [expr 9*$ax]
-    set x [getsize]
-    .b.l config -wrap 0
-    set x
-} "[expr 8*$ax] [expr 2*$ay]"
-test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} {
-    .b.l config -text "000\n000"
-} {}
-test font-24.7 {Tk_ComputeTextLayout: special char was \n} {
-    .b.l config -text "000\n0000"
-    getsize
-} "[expr $ax*4] [expr $ay*2]"
-test font-24.8 {Tk_ComputeTextLayout: special char was \t} {
-    .b.l config -text "000\t00"
-    getsize
-} "[expr $ax*10] $ay"
-test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} {
+# Data used in 24.* tests
+destroy .t.l 
+label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \
+	-text "0" -font "Courier -12"
+pack .t.l
+update
+set ax [winfo reqwidth .t.l]
+set ay [winfo reqheight .t.l]
+test font-24.1 {Tk_ComputeTextLayout: empty string} -body {
+    .t.l config -text ""
+} -result {}
+test font-24.2 {Tk_ComputeTextLayout: simple string} -body {
+    .t.l config -text "000"
+	update
+	list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \
+		[expr {[winfo reqheight .t.l] eq $ay}]
+} -result {1 1}
+test font-24.3 {Tk_ComputeTextLayout: find special chars} -body {
+    .t.l config -text "000\n000"
+	update
+	list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \
+		[expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}]
+} -result {1 1}
+test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} -body {
+    .t.l config -text "000\n000"
+	update
+	list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \
+		[expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}]
+} -result {1 1}
+test font-24.5 {Tk_ComputeTextLayout: break line} -body {
+    .t.l config -text "000\t00000" -wrap [expr 9 * $ax]
+	update
+	list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] \
+		[expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}]
+} -cleanup {
+    .t.l config -wrap 0
+} -result {1 1}
+test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} -body {
+    .t.l config -text "000\n000"
+} -result {}
+test font-24.7 {Tk_ComputeTextLayout: special char was \n} -body {
+    .t.l config -text "000\n0000"
+	update
+	list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] \
+		[expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}]
+} -result {1 1}
+test font-24.8 {Tk_ComputeTextLayout: special char was \t} -body {
+    .t.l config -text "000\t00"
+	update
+	list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 10}]}] \
+		[expr {[winfo reqheight .t.l] eq $ay}]
+} -result {1 1}
+test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} -body {
     set x {}
-    .b.l config -text "000\t000"
-    lappend x [getsize]
-    .b.l config -text "000\t000" -wrap [expr 100*$ax]
-    lappend x [getsize]
-    .b.l config -wrap 0
-    set x
-} "{[expr $ax*11] $ay} {[expr $ax*11] $ay}"
-test font-24.10 {Tk_ComputeTextLayout: tab caused break} {
+    .t.l config -text "000\t000"
+	update
+    lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 11}]}]
+	lappend x [expr {[winfo reqheight .t.l] eq $ay}]
+    .t.l config -text "000\t000" -wrap [expr 100 * $ax]
+	update
+    lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 11}]}]
+	lappend x [expr {[winfo reqheight .t.l] eq $ay}]
+    return $x
+} -cleanup {
+    .t.l config -wrap 0
+} -result {1 1 1 1}
+test font-24.10 {Tk_ComputeTextLayout: tab caused break} -body {
     set x {}
-    .b.l config -text "000\t"
-    lappend x [getsize]
-    .b.l config -text "000\t00" -wrap [expr $ax*6]
-    lappend x [getsize]
-    .b.l config -wrap 0
-    set x
-} "{[expr $ax*3] $ay} {[expr $ax*3] [expr $ay*2]}"
-test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
+    .t.l config -text "000\t"
+	update
+    lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}]
+	lappend x [expr {[winfo reqheight .t.l] eq $ay}]
+    .t.l config -text "000\t00" -wrap [expr $ax * 6]
+	update
+	lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}]
+	lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}]
+    return $x
+} -cleanup {
+    .t.l config -wrap 0
+} -result {1 1 1 1}
+test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} -body {
     set x {}
-    .b.l config -text "000            000" -wrap [expr $ax*5]
-    lappend x [getsize]
-    .b.l config -text "000            "
-    lappend x [getsize]
-    .b.l config -wrap 0
-    set x
-} "{[expr $ax*3] [expr $ay*2]} {[expr $ax*3] $ay}"
-test font-24.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
+    .t.l config -text "000            000" -wrap [expr {$ax * 5}]
+	update
+	lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}]
+	lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}]
+    .t.l config -text "000            "
+	update
+	lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}]
+	lappend x [expr {[winfo reqheight .t.l] eq $ay}]
+    return $x
+} -cleanup {
+    .t.l config -wrap 0
+} -result {1 1 1 1}
+test font-24.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} -body {
     set x {}
-    .b.l config -text "000            0000" -wrap [expr $ax*5]
-    lappend x [getsize]
-    .b.l config -text "000\t00            0000" -wrap [expr $ax*12]
-    lappend x [getsize]
-    .b.l config -wrap 0
-    set x
-} "{[expr $ax*4] [expr $ay*2]} {[expr $ax*10] [expr $ay*2]}"
-test font-24.13 {Tk_ComputeTextLayout: many lines -> realloc line array} {
-    .b.l config -text "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
-    getsize
-} "1 [expr $ay*129]"
-test font-24.14 {Tk_ComputeTextLayout: text ended with \n} {
-    list [.b.l config -text "0000"; getsize] [.b.l config -text "0000\n"; getsize]
-} "{[expr $ax*4] $ay} {[expr $ax*4] [expr $ay*2]}"
-test font-24.15 {Tk_ComputeTextLayout: justification} {
-    csetup "000\n00000"
+    .t.l config -text "000            0000" -wrap [expr {$ax * 5}]
+	update
+	lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}]
+	lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}]
+    .t.l config -text "000\t00            0000" -wrap [expr {$ax * 12}]
+	update
+	lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 10}]}]
+	lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}]
+    return $x
+} -cleanup {
+    .t.l config -wrap 0
+} -result {1 1 1 1}
+test font-24.13 {Tk_ComputeTextLayout: many lines -> realloc line array} -body {
+    .t.l config -text "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
+	update
+	list [expr {[winfo reqwidth .t.l] eq 1}] \
+		[expr {[winfo reqheight .t.l] eq [expr {$ay * 129}]}]
+} -result {1 1}
+test font-24.14 {Tk_ComputeTextLayout: text ended with \n} -body {
+    set x {}
+	.t.l config -text "0000"
+	update
+	lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}]
+	lappend x [expr {[winfo reqheight .t.l] eq $ay}]
+	.t.l config -text "0000\n"
+	update
+	lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}]
+	lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}]
+    return $x
+} -result {1 1 1 1}
+destroy .t.l 
+
+test font-24.15 {Tk_ComputeTextLayout: justification} -setup {
     set x {}
-    .b.c itemconfig text -just left
-    lappend x [.b.c index text @[expr $ax*2],0]
-    .b.c itemconfig text -just center
-    lappend x [.b.c index text @[expr $ax*2],0]
-    .b.c itemconfig text -just right
-    lappend x [.b.c index text @[expr $ax*2],0]
-    .b.c itemconfig text -just left
-    set x
-} {2 1 0}
-
-test font-25.1 {Tk_FreeTextLayout procedure} {
-    setup
-    .b.f config -text foo
-    .b.f config -text boo
-} {}
+	destroy .t.c
+	canvas .t.c -closeenough 0 
+	.t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
+	pack .t.c
+	update
+} -body {
+    csetup "000\n00000"
+    .t.c itemconfig text -just left
+    lappend x [.t.c index text @[expr $ax*2],0]
+    .t.c itemconfig text -just center
+    lappend x [.t.c index text @[expr $ax*2],0]
+    .t.c itemconfig text -just right
+    lappend x [.t.c index text @[expr $ax*2],0]
+    .t.c itemconfig text -just left
+    return $x
+} -cleanup {
+	destroy .t.c
+} -result {2 1 0}
+
+
+test font-25.1 {Tk_FreeTextLayout procedure} -setup {
+    destroy .t.f
+    pack [label .t.f]
+    update
+} -body {
+    .t.f config -text foo
+    .t.f config -text boo
+} -cleanup {
+	destroy .t.f
+} -result {}
     
-test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
-    .b.f config -text foo
-} {}
-test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} {
+
+# Canvas created for tests: 26.*
+destroy .t.c
+canvas .t.c -closeenough 0 
+.t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
+pack .t.c
+update
+test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} -setup {
+    destroy .t.f
+    pack [label .t.f]
+    update
+} -body {
+    .t.f config -text foo
+} -cleanup {
+	destroy .t.f
+} -result {}
+test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} -body {
     csetup "000\t00\n000"
-} {}
-test font-26.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} {
+} -result {}
+test font-26.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} -body {
     csetup "000\t00"
-    .b.c select from text 3
-    .b.c select to text 5
-} {}
-test font-26.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} {
-    .b.c select from text 3
-    .b.c select to text 5
-} {}
-test font-26.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} {
-    .b.c select from text 2
-    .b.c select to text 2
-} {}
-test font-26.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} {
-    .b.c select from text 4
-    .b.c select to text 4
-} {}
-
-test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
-    .b.f config -text "foo" -under -1
-} {}
-test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
-    .b.f config -text "000          00000" -wrap [expr $ax*7] -under 10
-} {}
-test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} {
-    .b.f config -text "000          00000" -wrap [expr $ax*7] -under 5
-    .b.f config -wrap -1 -under -1
-} {}
-    
-test font-28.1 {Tk_PointToChar procedure: above all lines} {
+    .t.c select from text 3
+    .t.c select to text 5
+} -result {}
+test font-26.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} -body {
+    csetup "000\t00"
+    .t.c select from text 3
+    .t.c select to text 5
+} -result {}
+test font-26.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} -body {
+    csetup "000\t00"
+    .t.c select from text 2
+    .t.c select to text 2
+} -result {}
+test font-26.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} -body {
+    csetup "000\t00"
+    .t.c select from text 4
+    .t.c select to text 4
+} -result {}
+destroy .t.c
+
+#  Label used in 27.* tests
+destroy .t.f
+pack [label .t.f]
+update
+test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} -body {
+    .t.f config -text "foo" -under -1
+} -result {}
+test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} -body {
+    .t.f config -text "000          00000" -wrap [expr $ax*7] -under 10
+} -result {}
+test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} -body {
+    .t.f config -text "000          00000" -wrap [expr $ax*7] -under 5
+    .t.f config -wrap -1 -under -1
+} -result {}
+destroy .t.f
+
+
+
+# Canvas created for tests: 28.*
+destroy .t.c
+canvas .t.c -closeenough 0 
+.t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
+pack .t.c
+update
+test font-28.1 {Tk_PointToChar procedure: above all lines} -body {
     csetup "000"
-    .b.c index text @-1,0
-} {0}
-test font-28.2 {Tk_PointToChar procedure: no chars} {
+    .t.c index text @-1,0
+} -result {0}
+test font-28.2 {Tk_PointToChar procedure: no chars} -body {
     # After fixing the following bug:
     #
     # In canvas text item, it was impossible to click to position the
@@ -907,206 +1682,277 @@ test font-28.2 {Tk_PointToChar procedure: no chars} {
     # index of 1 if TextLayout contained 0 characters.
 
     csetup ""
-    .b.c index text @100,100
-} {0}
-test font-28.3 {Tk_PointToChar procedure: loop test} {
+    .t.c index text @100,100
+} -result {0}
+test font-28.3 {Tk_PointToChar procedure: loop test} -body {
     csetup "000\n000\n000\n000"
-    .b.c index text @10000,0
-} {3}
-test font-28.4 {Tk_PointToChar procedure: intersect line} {
+    .t.c index text @10000,0
+} -result {3}
+test font-28.4 {Tk_PointToChar procedure: intersect line} -body {
     csetup "000\n000\n000"
-    .b.c index text @0,$ay
-} {4}
-test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} {
-    .b.c index text @-100,$ay
-} {4}
-test font-28.6 {Tk_PointToChar procedure: past any possible chunk} {
-    .b.c index text @100000,$ay
-} {7}
-test font-28.7 {Tk_PointToChar procedure: which chunk on this line} {
+    .t.c index text @0,$ay
+} -result {4}
+test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} -body {
+    csetup "000\n000\n000"
+    .t.c index text @-100,$ay
+} -result {4}
+test font-28.6 {Tk_PointToChar procedure: past any possible chunk} -body {
+    csetup "000\n000\n000"
+    .t.c index text @100000,$ay
+} -result {7}
+test font-28.7 {Tk_PointToChar procedure: which chunk on this line} -body {
     csetup "000\n000\t000\t000\n000"
-    .b.c index text @[expr $ax*2],$ay
-} {6}
-test font-28.8 {Tk_PointToChar procedure: which chunk on this line} {
+    .t.c index text @[expr $ax*2],$ay
+} -result {6}
+test font-28.8 {Tk_PointToChar procedure: which chunk on this line} -body {
     csetup "000\n000\t000\t000\n000"
-    .b.c index text @[expr $ax*10],$ay
-} {10}
-test font-28.9 {Tk_PointToChar procedure: in special chunk} {
+    .t.c index text @[expr $ax*10],$ay
+} -result {10}
+test font-28.9 {Tk_PointToChar procedure: in special chunk} -body {
     csetup "000\n000\t000\t000\n000"
-    .b.c index text @[expr $ax*6],$ay
-} {7}
-test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} {
+    .t.c index text @[expr $ax*6],$ay
+} -result {7}
+test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} -body {
     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}
-test font-28.11 {Tk_PointToChar procedure: below all chunks} {
+    .t.c itemconfig text -width [expr $ax*5]
+    set x [.t.c index text @[expr $ax*5],0]
+    .t.c itemconfig text -width 0
+    return $x
+} -result {3}
+test font-28.11 {Tk_PointToChar procedure: below all chunks} -body {
     csetup "000 0000000"
-    .b.c index text @0,1000000
-} {11}
-    
-test font-29.1 {Tk_CharBBox procedure: index < 0} {
-    .b.f config -text "000" -underline -1
-} {}
-test font-29.2 {Tk_CharBBox procedure: loop} {
-    .b.f config -text "000\t000\t000\t000" -underline 9
-} {}
-test font-29.3 {Tk_CharBBox procedure: special char} {
-    .b.f config -text "000\t000\t000" -underline 7
-} {}
-test font-29.4 {Tk_CharBBox procedure: normal char} {
-    .b.f config -text "000" -underline 1
-} {}
-test font-29.5 {Tk_CharBBox procedure: right edge of bbox truncated} {
-    .b.f config -text "0    0000" -wrap [expr $ax*4] -under 2
-    .b.f config -wrap 0
-} {}
-test font-29.6 {Tk_CharBBox procedure: bbox pegged to right edge} {
-    .b.f config -text "0    0000" -wrap [expr $ax*4] -under 3
-    .b.f config -wrap 0
-} {}
-
-.b.c bind all <Enter> {lappend x [.b.c index current @%x,%y]}
-
-test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} {
+    .t.c index text @0,1000000
+} -result {11}
+destroy .t.c
+
+
+#  Label used in 29.* tests
+destroy .t.f
+pack [label .t.f]
+update
+test font-29.1 {Tk_CharBBox procedure: index < 0} -body {
+    .t.f config -text "000" -underline -1
+} -result {}
+test font-29.2 {Tk_CharBBox procedure: loop} -body {
+    .t.f config -text "000\t000\t000\t000" -underline 9
+} -result {}
+test font-29.3 {Tk_CharBBox procedure: special char} -body {
+    .t.f config -text "000\t000\t000" -underline 7
+} -result {}
+test font-29.4 {Tk_CharBBox procedure: normal char} -body {
+    .t.f config -text "000" -underline 1
+} -result {}
+test font-29.5 {Tk_CharBBox procedure: right edge of bbox truncated} -body {
+    .t.f config -text "0    0000" -wrap [expr $ax*4] -under 2
+    .t.f config -wrap 0
+} -result {}
+test font-29.6 {Tk_CharBBox procedure: bbox pegged to right edge} -body {
+    .t.f config -text "0    0000" -wrap [expr $ax*4] -under 3
+    .t.f config -wrap 0
+} -result {}
+destroy .t.f
+
+
+
+# Canvas created for tests: 30.*
+destroy .t.c
+canvas .t.c -closeenough 0 
+.t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
+pack .t.c
+update
+test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} -body {
     csetup "000\n000\n000"
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x 0 -y 0
-    set x
-} {0}
-test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x 0 -y 0
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {0}
+test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} -body {
     csetup "000\n000\n000"
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x $ax -y $ay
-    set x
-} {5}
-test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x $ax -y $ay
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {5}
+test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} -body {
     csetup "000\n0\n000"
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x [expr $ax*2] -y $ay
-    set x
-} {}
-test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x [expr $ax*2] -y $ay
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {}
+test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} -body {
     csetup "000\t000\n000"
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x [expr $ax*6] -y 0
-    set x
-} {3}
-test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x [expr $ax*6] -y 0
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {3}
+test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} -body {
     csetup "000\n0\n000"
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x [expr $ax*2] -y $ay
-    set x
-} {}
-test font-30.6 {Tk_DistanceToTextLayout procedure: ignore spaces at eol} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x [expr $ax*2] -y $ay
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {}
+test font-30.6 {Tk_DistanceToTextLayout procedure: ignore spaces at eol} -body {
     csetup "000\n000      000000000"
-    .b.c itemconfig text -width [expr $ax*10]
+    .t.c itemconfig text -width [expr $ax*10]
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x [expr $ax*5] -y $ay
-    .b.c itemconfig text -width 0
-    set x
-} {}
-.b.c itemconfig text -justify center
-test font-30.7 {Tk_DistanceToTextLayout procedure: on left side} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x [expr $ax*5] -y $ay
+    .t.c itemconfig text -width 0
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {}
+.t.c itemconfig text -justify center
+test font-30.7 {Tk_DistanceToTextLayout procedure: on left side} -body {
     csetup "0\n000"
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x 0 -y 0
-    set x
-} {}
-test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x 0 -y 0
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {}
+test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} -body {
     csetup "0\n000"
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x [expr $ax*2] -y 0
-    set x
-} {}
-test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x [expr $ax*2] -y 0
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {}
+test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} -body {
     csetup "0\n000"
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x $ax -y 0
-    set x
-} {0}
-test font-30.10 {Tk_DistanceToTextLayout procedure: above line} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x $ax -y 0
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {0}
+test font-30.10 {Tk_DistanceToTextLayout procedure: above line} -body {
     csetup "0\n000"
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x 0 -y 0
-    set x
-} {}
-test font-30.11 {Tk_DistanceToTextLayout procedure: below line} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x 0 -y 0
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {}
+test font-30.11 {Tk_DistanceToTextLayout procedure: below line} -body {
     csetup "000\n0"
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x 0 -y $ay
-    set x
-} {}
-test font-30.12 {Tk_DistanceToTextLayout procedure: in line} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x 0 -y $ay
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {}
+test font-30.12 {Tk_DistanceToTextLayout procedure: in line} -body {
     csetup "0\n000"
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x $ax -y $ay
-    set x
-} {3}
-.b.c itemconfig text -justify left
-test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x $ax -y $ay
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {3}
+.t.c itemconfig text -justify left
+test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} -body {
     csetup "000"
+	.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
     set x {}
-    event generate .b.c <Leave>
-    event generate .b.c <Enter> -x $ax -y 0
-    set x
-} {1}
-
-test font-31.1 {Tk_IntersectTextLayout procedure: loop once} {
+    event generate .t.c <Leave>
+    event generate .t.c <Enter> -x $ax -y 0
+    return $x
+} -cleanup {
+	bind all <Enter> {}
+} -result {1}
+destroy .t.c
+
+
+# Canvas created for tests 31.*
+destroy .t.c
+canvas .t.c -closeenough 0 
+.t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
+pack .t.c
+update
+test font-31.1 {Tk_IntersectTextLayout procedure: loop once} -body {
     csetup "000\n000\n000"
-    .b.c find overlapping 0 0 0 0
-} [.b.c find withtag text]
-test font-31.2 {Tk_IntersectTextLayout procedure: loop multiple} {
+    .t.c find overlapping 0 0 0 0
+} -result [.t.c find withtag text]
+test font-31.2 {Tk_IntersectTextLayout procedure: loop multiple} -body {
     csetup "000\t000\t000"
-    .b.c find overlapping [expr $ax*10] 0 [expr $ax*10] 0
-} [.b.c find withtag text]
-test font-31.3 {Tk_IntersectTextLayout procedure: loop to end} {
+    .t.c find overlapping [expr $ax*10] 0 [expr $ax*10] 0
+} -result [.t.c find withtag text]
+test font-31.3 {Tk_IntersectTextLayout procedure: loop to end} -body {
     csetup "0\n000"
-    .b.c find overlapping [expr $ax*2] 0 [expr $ax*2] 0
-} {}
-test font-31.4 {Tk_IntersectTextLayout procedure: hit a special char (tab)} {
+    .t.c find overlapping [expr $ax*2] 0 [expr $ax*2] 0
+} -result {}
+test font-31.4 {Tk_IntersectTextLayout procedure: hit a special char (tab)} -body {
     csetup "000\t000"
-    .b.c find overlapping [expr $ax*6] 0 [expr $ax*6] 0
-} [.b.c find withtag text]
-test font-31.5 {Tk_IntersectTextLayout procedure: ignore newlines} {
+    .t.c find overlapping [expr $ax*6] 0 [expr $ax*6] 0
+} -result [.t.c find withtag text]
+test font-31.5 {Tk_IntersectTextLayout procedure: ignore newlines} -body {
     csetup "000\n0\n000"
-    .b.c find overlapping $ax $ay $ax $ay
-} {}
-test font-31.6 {Tk_IntersectTextLayout procedure: ignore spaces at eol} {
+    .t.c find overlapping $ax $ay $ax $ay
+} -result {}
+test font-31.6 {Tk_IntersectTextLayout procedure: ignore spaces at eol} -body {
     csetup "000\n000      000000000"
-    .b.c itemconfig text -width [expr $ax*10]
-    set x [.b.c find overlapping [expr $ax*5] $ay [expr $ax*5] $ay]
-    .b.c itemconfig text -width 0
-    set x
-} {}
-
-test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
+    .t.c itemconfig text -width [expr $ax*10]
+    set x [.t.c find overlapping [expr $ax*5] $ay [expr $ax*5] $ay]
+    .t.c itemconfig text -width 0
+    return $x
+} -result {}
+destroy .t.c
+
+
+test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} -setup {
+	destroy .t.c
+	canvas .t.c -closeenough 0 
+	.t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
+	pack .t.c
+	update
+} -body {
     # If there were a whole bunch of returns or tabs in a row, then the
     # temporary buffer could overflow and write on the stack.
-    
     csetup "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n"
-    .b.c itemconfig text -width 800
-    .b.c insert text end "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n"
-    .b.c insert text end "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
-    .b.c insert text end "end"
-    set x [.b.c postscript]
+    .t.c itemconfig text -width 800
+    .t.c insert text end "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n"
+    .t.c insert text end "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
+    .t.c insert text end "end"
+    set x [.t.c postscript]
     set i [string first "(qwerty" $x] 
     string range $x $i [expr {$i + 278}]
-} {(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)]
+} -cleanup {
+	destroy .t.c
+} -result {(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)]
 [(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)]
 [()]
 [()]
@@ -1141,242 +1987,366 @@ test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
 [(end)]
 }
 
-test font-33.1 {Tk_TextWidth procedure} {
-} {}
 
-test font-34.1 {ConfigAttributesObj procedure: arguments} {
+test font-33.1 {Tk_TextWidth procedure} -body {
+} -result {}
+
+
+test font-34.1 {ConfigAttributesObj procedure: arguments} -setup {
+    catch {font delete xyz}
+} -body {
     # (Tcl_GetIndexFromObj() != TCL_OK)
-    setup
-    list [catch {font create xyz -xyz} msg] $msg
-} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
-test font-34.2 {ConfigAttributesObj procedure: arguments} {
+    font create xyz -xyz
+} -returnCodes {
+    error
+} -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}
+test font-34.2 {ConfigAttributesObj procedure: arguments} -setup {
+    catch {font delete xyz}
+} -body {
     # (objc & 1)
-    setup
-    list [catch {font create xyz -family} msg] $msg
-} {1 {value for "-family" option missing}}
-foreach p {
-    {font-34.3 family xyz times}
-    {font-34.4 size 20 40}
-    {font-34.5 weight normal bold}
-    {font-34.6 slant roman italic}
-    {font-34.7 underline 0 1}
-    {font-34.8 overstrike 0 1}
-} {
-    lassign $p testName opt val1 val2
-    test $testName "ConfigAttributesObj procedure: $opt" {
-	setup
-	set x {}
-	font create xyz -$opt $val1
-	lappend x [font config xyz -$opt]
-	font config xyz -$opt $val2
-	lappend x [font config xyz -$opt]
-    } [list $val1 $val2]
-}
-foreach p {
-    {font-34.9  size   xyz {expected integer but got "xyz"}}
-    {font-34.10 weight xyz {bad -weight value "xyz": must be normal, or bold}}
-    {font-34.11 slant  xyz {bad -slant value "xyz": must be roman, or italic}}
-    {font-34.12 underline  xyz {expected boolean value but got "xyz"}}
-    {font-34.13 overstrike xyz {expected boolean value but got "xyz"}}
-} {
-    lassign $p testName opt val result
-    test $testName "ConfigAttributesObj procedure: $opt" -setup {
-	setup
-    } -body {
-	font create xyz -$opt $val
-    } -returnCodes error -result $result
-}
+    font create xyz -family
+} -returnCodes error -result {value for "-family" option missing}
 
-test font-35.1 {GetAttributeInfoObj procedure: one attribute} {
+test font-34.3 {ConfigAttributesObj procedure: family} -setup {
+    catch {font delete xyz}
+	set x {}
+} -body {
+	font create xyz -family xyz
+	lappend x [font config xyz -family]
+	font config xyz -family times
+	lappend x [font config xyz -family]
+} -cleanup {
+	font delete xyz
+} -result {xyz times}
+test font-34.4 {ConfigAttributesObj procedure: size} -setup {
+    catch {font delete xyz}
+	set x {}
+} -body {
+	font create xyz -size 20
+	lappend x [font config xyz -size]
+	font config xyz -size 40
+	lappend x [font config xyz -size]
+} -cleanup {
+	font delete xyz
+} -result {20 40}
+test font-34.5 {ConfigAttributesObj procedure: weight} -setup {
+    catch {font delete xyz}
+	set x {}
+} -body {
+	font create xyz -weight normal
+	lappend x [font config xyz -weight]
+	font config xyz -weight bold
+	lappend x [font config xyz -weight]
+} -cleanup {
+	font delete xyz
+} -result {normal bold}
+test font-34.6 {ConfigAttributesObj procedure: slant} -setup {
+    catch {font delete xyz}
+	set x {}
+} -body {
+	font create xyz -slant roman
+	lappend x [font config xyz -slant]
+	font config xyz -slant italic
+	lappend x [font config xyz -slant]
+} -cleanup {
+	font delete xyz
+} -result {roman italic}
+test font-34.7 {ConfigAttributesObj procedure: underline} -setup {
+    catch {font delete xyz}
+	set x {}
+} -body {
+	font create xyz -underline 0
+	lappend x [font config xyz -underline]
+	font config xyz -underline 1
+	lappend x [font config xyz -underline]
+} -cleanup {
+	font delete xyz
+} -result {0 1}
+test font-34.8 {ConfigAttributesObj procedure: overstrike} -setup {
+    catch {font delete xyz}
+	set x {}
+} -body {
+	font create xyz -overstrike 0
+	lappend x [font config xyz -overstrike]
+	font config xyz -overstrike 1
+	lappend x [font config xyz -overstrike]
+} -cleanup {
+	font delete xyz
+} -result {0 1}
+
+test font-34.9 {ConfigAttributesObj procedure: size} -body {
+	font create xyz -size xyz
+} -returnCodes error -result {expected integer but got "xyz"}
+test font-34.10 {ConfigAttributesObj procedure: weight} -body {
+	font create xyz -weight xyz
+} -returnCodes error -result {bad -weight value "xyz": must be normal, or bold}
+test font-34.11 {ConfigAttributesObj procedure: slant} -body {
+	font create xyz -slant xyz
+} -returnCodes error -result {bad -slant value "xyz": must be roman, or italic}
+test font-34.12 {ConfigAttributesObj procedure: underline} -body {
+	font create xyz -underline xyz
+} -returnCodes error -result {expected boolean value but got "xyz"}
+test font-34.13 {ConfigAttributesObj procedure: overstrike} -body {
+	font create xyz -overstrike xyz
+} -returnCodes error -result {expected boolean value but got "xyz"}
+
+
+test font-35.1 {GetAttributeInfoObj procedure: one attribute} -setup {
+    catch {font delete xyz}
+} -body {
     # (objPtr != NULL)
-    setup
     font create xyz -family xyz
     font config xyz -family
-} {xyz}
+} -cleanup {
+	font delete xyz
+} -result {xyz}
+
 
-test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} {
+test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} -setup {
+    catch {font delete xyz}
+} -body {
     # (Tcl_GetIndexFromObj() != TCL_OK)
-    setup
     font create xyz
-    list [catch {font config xyz -xyz} msg] $msg
-} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
-
-test font-37.1 {GetAttributeInfoObj procedure: all attributes} {
-    # not (objPtr != NULL) 
-    setup
+    font config xyz -xyz
+} -cleanup {
+	font delete xyz
+} -returnCodes {
+    error
+} -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}
+
+
+test font-37.1 {GetAttributeInfoObj procedure: all attributes} -setup {
+    catch {font delete xyz}
+} -body {
+    # not (objPtr != NULL)
     font create xyz -family xyz
     font config xyz
-} {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
-set i 4
-foreach p {
-    {font-37.2 family     xyz    xyz}
-    {font-37.3 size       20     20}
-    {font-37.4 weight     normal normal}
-    {font-37.5 slant      italic italic}
-    {font-37.6 underline  yes    1}
-    {font-37.7 overstrike false  0}
-} {
-    lassign $p testName opt val expected
-    test $testName "GetAttributeInfo procedure: $opt" -setup {
-	setup
-    } -body {
-	font create xyz -$opt $val
-	font config xyz -$opt
-    } -result $expected
-}
+} -cleanup {
+	font delete xyz
+} -result {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
+test font-37.2 {GetAttributeInfo procedure: family} -setup {
+    catch {font delete xyz}
+} -body {
+	font create xyz -family xyz
+	font config xyz -family
+} -cleanup {
+	font delete xyz
+} -result {xyz}
+test font-37.3 {GetAttributeInfo procedure: size} -setup {
+    catch {font delete xyz}
+	set x {}
+} -body {
+	font create xyz -size 20
+	font config xyz -size
+} -cleanup {
+	font delete xyz
+} -result {20}
+test font-37.4 {GetAttributeInfo procedure: weight} -setup {
+    catch {font delete xyz}
+	set x {}
+} -body {
+	font create xyz -weight normal
+	font config xyz -weight
+} -cleanup {
+	font delete xyz
+} -result {normal}
+test font-37.5 {GetAttributeInfo procedure: slant} -setup {
+    catch {font delete xyz}
+	set x {}
+} -body {
+	font create xyz -slant italic
+	font config xyz -slant
+} -cleanup {
+	font delete xyz
+} -result {italic}
+test font-37.6 {GetAttributeInfo procedure: underline} -setup {
+    catch {font delete xyz}
+	set x {}
+} -body {
+	font create xyz -underline yes
+	font config xyz -underline 
+} -cleanup {
+	font delete xyz
+} -result {1}
+test font-37.7 {GetAttributeInfo procedure: overstrike} -setup {
+    catch {font delete xyz}
+	set x {}
+} -body {
+	font create xyz -overstrike no
+	font config xyz -overstrike 
+} -cleanup {
+	font delete xyz
+} -result {0}
+
 
 # In tests below, one field is set to "xyz" so that font name doesn't
 # look like a native X font, so that ParseFontNameObj or TkParseXLFD will
 # be called.
 
-setup
-
-test font-38.1 {ParseFontNameObj procedure: begins with -} {
+test font-38.1 {ParseFontNameObj procedure: begins with -} -body {
     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
-} $times
-test font-38.2 {ParseFontNameObj procedure: begins with -*} {
+} -result [font actual {times 0} -family]
+test font-38.2 {ParseFontNameObj procedure: begins with -*} -body {
     lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
-} $times
-test font-38.3 {ParseFontNameObj procedure: begins with -, doesn't look like list} {
+} -result [font actual {times 0} -family]
+test font-38.3 {ParseFontNameObj procedure: begins with -, doesn't look like list} -body {
     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
-} $times
-test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} {
+} -result [font actual {times 0} -family]
+test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} -body {
     lindex [font actual {-family times}] 1
-} $times
-test font-38.5 {ParseFontNameObj procedure: begins with *} {
+} -result [font actual {times 0} -family]
+test font-38.5 {ParseFontNameObj procedure: begins with *} -body {
     lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
-} $times
-test font-38.6 {ParseFontNameObj procedure: begins with *} {
+} -result [font actual {times 0} -family]
+test font-38.6 {ParseFontNameObj procedure: begins with *} -body {
     font actual *-times-xyz -family
-} $times
-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} {
-    list [catch {font actual ""} msg] $msg
-} {1 {font "" doesn't exist}}
-test font-38.9 {ParseFontNameObj procedure: arguments} {
-    list [catch {font actual {times 20 xyz xyz}} msg] $msg
-} {1 {unknown font style "xyz"}}
-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} {
+} -result [font actual {times 0} -family]
+test font-38.7 {ParseFontNameObj procedure: arguments} -constraints noExceed -body {
+    font actual "\{xyz"
+} -returnCodes error -result "font \"{xyz\" doesn't exist"
+test font-38.8 {ParseFontNameObj procedure: arguments} -constraints noExceed -body {
+    font actual ""
+} -returnCodes error -result {font "" doesn't exist}
+test font-38.9 {ParseFontNameObj procedure: arguments} -body {
+    font actual {times 20 xyz xyz}
+} -returnCodes error -result {unknown font style "xyz"}
+test font-38.10 {ParseFontNameObj procedure: arguments} -body {
+    font actual {times xyz xyz}
+} -returnCodes error -result {expected integer but got "xyz"}
+test font-38.11 {ParseFontNameObj procedure: stylelist loop} -constraints {
+	unixOrPc
+} -body {
     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} {
-    list [catch {font actual {times 12 bold xyz}} msg] $msg
-} {1 {unknown font style "xyz"}}
+} -result {-weight bold -slant italic -underline 1 -overstrike 1}
+test font-38.12 {ParseFontNameObj procedure: stylelist error} -body {
+    font actual {times 12 bold xyz}
+} -returnCodes error -result {unknown font style "xyz"}
+
+
+test font-39.1 {NewChunk procedure: test realloc} -setup {
+    destroy .t.f
+    pack [label .t.f]
+    update
+} -body {
+    .t.f config -text "xxx\nxxx\txxx\nxxx\t\t\t"
+} -cleanup {
+	destroy .t.f
+} -result {}
 
-test font-39.1 {NewChunk procedure: test realloc} {
-    .b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t"
-} {}
 
-test font-40.1 {TkFontParseXLFD procedure: initial dash} {
+test font-40.1 {TkFontParseXLFD procedure: initial dash} -body {
     font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-* -family
-} $times
-test font-40.2 {TkFontParseXLFD procedure: no initial dash} {
+} -result [font actual {times 0} -family]
+test font-40.2 {TkFontParseXLFD procedure: no initial dash} -body {
     font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family
-} $times
-test font-40.3 {TkFontParseXLFD procedure: not enough fields} {
+} -result [font actual {times 0} -family]
+test font-40.3 {TkFontParseXLFD procedure: not enough fields} -body {
     font actual -xyz-times-*-*-* -family
-} $times
-test font-40.4 {TkFontParseXLFD procedure: all fields unspecified} {
+} -result [font actual {times 0} -family]
+test font-40.4 {TkFontParseXLFD procedure: all fields unspecified} -body {
     lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0
-} {-family}
-test font-40.5 {TkFontParseXLFD procedure: all fields specified} {
-    lindex [font actual -foundry-times-weight-slant-setwidth-addstyle-10-10-10-10-spacing-avgwidth-registry-encoding] 1
-} $times
-test font-41.1 {TkParseXLFD procedure: arguments} {
+} -result {-family}
+test font-40.5 {TkFontParseXLFD procedure: all fields specified} -body {
+    lindex [font actual \
+        -foundry-times-weight-slant-setwidth-addstyle-10-10-10-10-spacing-avgwidth-registry-encoding] 1
+} -result [font actual {times 0} -family]
+
+
+test font-41.1 {TkParseXLFD procedure: arguments} -body {
     # XLFD with bad pointsize: fallback to some system font.
     font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-*
     set x {}
-} {}
-test font-42.1 {TkFontParseXLFD procedure: arguments} {
+} -result {}
+
+
+test font-42.1 {TkFontParseXLFD procedure: arguments} -body {
     # XLFD with bad pixelsize: fallback to some system font.
     font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-*
     set x {}
-} {}
-test font-42.2 {TkFontParseXLFD procedure: pixelsize specified} {
+} -result {}
+test font-42.2 {TkFontParseXLFD procedure: pixelsize specified} -body {
     font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace
     set x {}
-} {}
-test font-42.3 {TkFontParseXLFD procedure: weird pixelsize specified} {
+} -result {}
+test font-42.3 {TkFontParseXLFD procedure: weird pixelsize specified} -body {
     font metrics {-xyz-times-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*-*} -linespace
     set x {}
-} {}
-test font-42.4 {TkFontParseXLFD procedure: pointsize specified} {
+} -result {}
+test font-42.4 {TkFontParseXLFD procedure: pointsize specified} -body {
     font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace
     set x {}
-} {}
-test font-42.5 {TkFontParseXLFD procedure: weird pointsize specified} {
+} -result {}
+test font-42.5 {TkFontParseXLFD procedure: weird pointsize specified} -body {
     font metrics {-xyz-times-*-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*} -linespace
     set x {}
-} {}
+} -result {}
 
-test font-43.1 {FieldSpecified procedure: specified vs. non-specified} {
+
+test font-43.1 {FieldSpecified procedure: specified vs. non-specified} -body {
     font actual -xyz--*-*-*-*-*-*-*-*-*-*-*-*
     font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*
     font actual -xyz-?-*-*-*-*-*-*-*-*-*-*-*-*
     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
-} $times
+} -result [font actual {times 0} -family]
+
 
-set oldscale [tk scaling]
-tk scaling 0.5
-test font-44.1 {TkFontGetPixels: size < 0} {
+test font-44.1 {TkFontGetPixels: size < 0} -setup {
+	set oldscale [tk scaling]
+} -body {
+	tk scaling 0.5
     font actual {times -12} -size
-} {24}
-test font-44.2 {TkFontGetPoints: size >= 0} {noExceed} {
+} -cleanup {
+	tk scaling $oldscale
+} -result {24}
+test font-44.2 {TkFontGetPoints: size >= 0} -constraints noExceed -setup {
+	set oldscale [tk scaling]
+} -body {
+	tk scaling 0.5
     font actual {times 12} -size
-} {12}
+} -cleanup {
+	tk scaling $oldscale
+} -result {12}
 
-tk scaling $oldscale
 
-test font-45.1 {TkFontGetAliasList: no match} {
+test font-45.1 {TkFontGetAliasList: no match} -body {
     font actual {snarky 10} -family
-} [font actual {-size 10} -family]
-test font-45.3 {TkFontGetAliasList: match} win {
+} -result [font actual {-size 10} -family]
+test font-45.2 {TkFontGetAliasList: match} -constraints win -body {
     font actual {times 10} -family
-} {Times New Roman}
-test font-45.4 {TkFontGetAliasList: match} {unix noExceed} {
+} -result {Times New Roman}
+test font-45.3 {TkFontGetAliasList: match} -constraints {unix noExceed} -body {
     # can fail on Unix systems that have a real "times new roman" font
     font actual {{times new roman} 10} -family
-} [font actual {times 10} -family]
+} -result [font actual {times 10} -family]
 
-test font-46.1 {font actual, with character, no option, no --} \
-    -body {
+
+test font-46.1 {font actual, with character, no option, no --} -body {
 	font actual {times 10} a
-    } \
-    -match glob \
-    -result [list -family [font actual {times 10} -family] -size *\
+} -match glob -result [list -family [font actual {times 10} -family] -size *\
 		 -slant roman -underline 0 -overstrike 0]
 
-test font-46.2 {font actual, with character introduced by --} \
-    -body {
+test font-46.2 {font actual, with character introduced by --} -body {
 	font actual {times 10} -- -
-    } \
-    -match glob \
-    -result [list -family [font actual {times 10} -family] -size *\
+} -match glob -result [list -family [font actual {times 10} -family] -size *\
 		 -slant roman -underline 0 -overstrike 0]
 
-test font-46.3 {font actual, with character and option} {
+test font-46.3 {font actual, with character and option} -body {
     font actual {times 10} -family a
-} [font actual {times 10} -family]
+} -result [font actual {times 10} -family]
 
-test font-46.4 {font actual, with character, option and --} {
+test font-46.4 {font actual, with character, option and --} -body {
     font actual {times 10} -family -- -
-} [font actual {times 10} -family]
-
-test font-46.5 {font actual, too many chars} {
-    list [catch {
-	font actual {times 10} 123456789012345678901234567890123456789012345678901
-    } result] $result
-} {1 {expected a single character but got "1234567890123456789012345678901234567..."}}
+} -result [font actual {times 10} -family]
 
-setup
+test font-46.5 {font actual, too many chars} -body {
+    font actual {times 10} 123456789012345678901234567890123456789012345678901
+} -returnCodes error -result {expected a single character but got "1234567890123456789012345678901234567..."}
 
-destroy .b
 
 # cleanup
 cleanupTests
 return
+
+
+
+
diff --git a/tests/frame.test b/tests/frame.test
index 6eaa356..577cac7 100644
--- a/tests/frame.test
+++ b/tests/frame.test
@@ -7,9 +7,10 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: frame.test,v 1.17 2008/07/23 23:24:25 nijtmans Exp $
+# RCS: @(#) $Id: frame.test,v 1.18 2008/08/15 01:10:03 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
@@ -53,40 +54,98 @@ proc colorsFree {w {red 31} {green 245} {blue 192}} {
 	    && ([lindex $vals 2]/256 == $blue)
 }
 
-test frame-1.1 {frame configuration options} {
+
+test frame-1.1 {frame configuration options} -setup {
+	deleteWindows
+} -body {
+    frame .f -class NewFrame
+    .f configure -class
+} -cleanup {
+    deleteWindows
+} -result {-class class Class Frame NewFrame} 
+test frame-1.2 {frame configuration options} -setup {
+    deleteWindows
+} -body {
     frame .f -class NewFrame
-    list [.f configure -class] [catch {.f configure -class Different} msg] $msg
-} {{-class class Class Frame NewFrame} 1 {can't modify -class option after widget is created}}
-catch {destroy .f}
-test frame-1.2 {frame configuration options} {
+    .f configure -class Different
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't modify -class option after widget is created}
+
+test frame-1.3 {frame configuration options} -setup {
+	deleteWindows
+} -body {
     frame .f -colormap new
-    list [.f configure -colormap] [catch {.f configure -colormap .} msg] $msg
-} {{-colormap colormap Colormap {} new} 1 {can't modify -colormap option after widget is created}}
-catch {destroy .f}
-test frame-1.3 {frame configuration options} {
+    .f configure -colormap
+} -cleanup {
+    deleteWindows
+} -result {-colormap colormap Colormap {} new}
+test frame-1.4 {frame configuration options} -setup {
+    deleteWindows
+} -body {
+    frame .f -colormap new
+    .f configure -colormap .
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't modify -colormap option after widget is created}
+
+test frame-1.5 {frame configuration options} -setup {
+	deleteWindows
+} -body {
     frame .f -visual default
-    list [.f configure -visual] [catch {.f configure -visual best} msg] $msg
-} {{-visual visual Visual {} default} 1 {can't modify -visual option after widget is created}}
-catch {destroy .f}
-test frame-1.4 {frame configuration options} {
-    list [catch {frame .f -screen bogus} msg] $msg
-} {1 {unknown option "-screen"}}
-test frame-1.5 {frame configuration options} {
-    set result [list [catch {frame .f -container true} msg] $msg \
-	    [.f configure -container]]
-    destroy .f
-    set result
-} {0 .f {-container container Container 0 1}}
-test frame-1.6 {frame configuration options} {
-    list [catch {frame .f -container bogus} msg] $msg
-} {1 {expected boolean value but got "bogus"}}
-test frame-1.7 {frame configuration options} {
+    .f configure -visual
+} -cleanup {
+    deleteWindows
+} -result {-visual visual Visual {} default}
+test frame-1.6 {frame configuration options} -setup {
+    deleteWindows
+} -body {
+    frame .f -visual default
+    .f configure -visual best
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't modify -visual option after widget is created}
+
+test frame-1.7 {frame configuration options} -setup {
+	deleteWindows
+} -body {
+    frame .f -screen bogus
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {unknown option "-screen"}
+test frame-1.8 {frame configuration options} -setup {
+	deleteWindows
+} -body {
+    frame .f -container true
+} -cleanup {
+    deleteWindows
+} -result {.f}
+test frame-1.9 {frame configuration options} -setup {
+    deleteWindows
+} -body {
+    frame .f -container true
+    .f configure -container
+} -cleanup {
+    deleteWindows
+} -result {-container container Container 0 1}
+test frame-1.10 {frame configuration options} -setup {
+	deleteWindows
+} -body {
+    frame .f -container bogus
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {expected boolean value but got "bogus"}
+test frame-1.11 {frame configuration options} -setup {
+	deleteWindows
+} -body {
     frame .f
-    set result [list [catch {.f configure -container 1} msg] $msg]
-    destroy .f
-    set result
-} {1 {can't modify -container option after widget is created}}
-test frame-1.8 {frame configuration options} {
+    .f configure -container 1
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't modify -container option after widget is created}
+test frame-1.12 {frame configuration options} -setup {
+	deleteWindows
+} -body {
     # Make sure all options can be set to the default value
     frame .f
     set opts {}
@@ -97,120 +156,327 @@ test frame-1.8 {frame configuration options} {
     }
     eval frame .g $opts
     destroy .f .g
-} {}
+} -cleanup {
+    deleteWindows
+} -result {}
 
+destroy .f
 frame .f
-set i 9
-foreach test {
-    {-background #ff0000 #ff0000 non-existent
-	    {unknown color name "non-existent"}}
-    {-bd 4 4 badValue {bad screen distance "badValue"}}
-    {-bg #00ff00 #00ff00 non-existent
-	    {unknown color name "non-existent"}}
-    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
-    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
-    {-height 100 100 not_a_number {bad screen distance "not_a_number"}}
-    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
-    {-highlightcolor #123456 #123456 non-existent
-	    {unknown color name "non-existent"}}
-    {-highlightthickness 6 6 badValue {bad screen distance "badValue"}}
-    {-padx 3 3 badValue {bad screen distance "badValue"}}
-    {-pady 4 4 badValue {bad screen distance "badValue"}}
-    {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
-    {-takefocus "any string" "any string" {} {}}
-    {-width 32 32 badValue {bad screen distance "badValue"}}
-} {
-    lassign $test opt goodValue goodResult badValue badResult
-    test frame-1.$i {frame configuration options} {
-	.f configure $opt $goodValue
-	lindex [.f configure $opt] 4
-    } $goodResult
-    incr i
-    if {$badValue ne ""} {
-	test frame-1.$i {frame configuration options} -body {
-	    .f configure $opt $badValue
-	} -returnCodes error -result $badResult
-    }
-    .f configure $opt [lindex [.f configure $opt] 3]
-    incr i
-}
+test frame-1.13 {frame configuration options} -body {
+    .f configure -background #ff0000
+    lindex [.f configure -background] 4
+} -cleanup {
+    .f configure -background [lindex [.f configure -background] 3]
+} -result {#ff0000}
+test frame-1.14 {frame configuration options} -body {
+    .f configure -background non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test frame-1.15 {frame configuration options} -body {
+    .f configure -bd 4
+    lindex [.f configure -bd] 4
+} -cleanup {
+    .f configure -bd [lindex [.f configure -bd] 3]
+} -result {4}
+test frame-1.16 {frame configuration options} -body {
+    .f configure -bd badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-1.17 {frame configuration options} -body {
+    .f configure -bg #00ff00
+    lindex [.f configure -bg] 4
+} -cleanup {
+    .f configure -bg [lindex [.f configure -bg] 3]
+} -result {#00ff00}
+test frame-1.18 {frame configuration options} -body {
+    .f configure -bg non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test frame-1.19 {frame configuration options} -body {
+    .f configure -borderwidth 1.3
+    lindex [.f configure -borderwidth] 4
+} -cleanup {
+    .f configure -borderwidth [lindex [.f configure -borderwidth] 3]
+} -result {1}
+test frame-1.20 {frame configuration options} -body {
+    .f configure -borderwidth badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-1.21 {frame configuration options} -body {
+    .f configure -cursor arrow
+    lindex [.f configure -cursor] 4
+} -cleanup {
+    .f configure -cursor [lindex [.f configure -cursor] 3]
+} -result {arrow}
+test frame-1.22 {frame configuration options} -body {
+    .f configure -cursor badValue
+} -returnCodes error -result {bad cursor spec "badValue"}
+test frame-1.23 {frame configuration options} -body {
+    .f configure -height 100
+    lindex [.f configure -height] 4
+} -cleanup {
+    .f configure -height [lindex [.f configure -height] 3]
+} -result {100}
+test frame-1.24 {frame configuration options} -body {
+    .f configure -height not_a_number
+} -returnCodes error -result {bad screen distance "not_a_number"}
+test frame-1.25 {frame configuration options} -body {
+    .f configure -highlightbackground #112233
+    lindex [.f configure -highlightbackground] 4
+} -cleanup {
+    .f configure -highlightbackground [lindex [.f configure -highlightbackground] 3]
+} -result {#112233}
+test frame-1.26 {frame configuration options} -body {
+    .f configure -highlightbackground ugly
+} -returnCodes error -result {unknown color name "ugly"}
+test frame-1.27 {frame configuration options} -body {
+    .f configure -highlightcolor #123456
+    lindex [.f configure -highlightcolor] 4
+} -cleanup {
+    .f configure -highlightcolor [lindex [.f configure -highlightcolor] 3]
+} -result {#123456}
+test frame-1.28 {frame configuration options} -body {
+    .f configure -highlightcolor non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test frame-1.29 {frame configuration options} -body {
+    .f configure -highlightthickness 6
+    lindex [.f configure -highlightthickness] 4
+} -cleanup {
+    .f configure -highlightthickness [lindex [.f configure -highlightthickness] 3]
+} -result {6}
+test frame-1.30 {frame configuration options} -body {
+    .f configure -highlightthickness badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-1.31 {frame configuration options} -body {
+    .f configure -padx 3
+    lindex [.f configure -padx] 4
+} -cleanup {
+    .f configure -padx [lindex [.f configure -padx] 3]
+} -result {3}
+test frame-1.32 {frame configuration options} -body {
+    .f configure -padx badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-1.33 {frame configuration options} -body {
+    .f configure -pady 4
+    lindex [.f configure -pady] 4
+} -cleanup {
+    .f configure -pady [lindex [.f configure -pady] 3]
+} -result {4}
+test frame-1.34 {frame configuration options} -body {
+    .f configure -pady badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-1.35 {frame configuration options} -body {
+    .f configure -relief ridge
+    lindex [.f configure -relief] 4
+} -cleanup {
+    .f configure -relief [lindex [.f configure -relief] 3]
+} -result {ridge}
+test frame-1.36 {frame configuration options} -body {
+    .f configure -relief badValue
+} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
+test frame-1.37 {frame configuration options} -body {
+    .f configure -takefocus {any string}
+    lindex [.f configure -takefocus] 4
+} -cleanup {
+    .f configure -takefocus [lindex [.f configure -takefocus] 3]
+} -result {any string}
+test frame-1.38 {frame configuration options} -body {
+    .f configure -width 32
+    lindex [.f configure -width] 4
+} -cleanup {
+    .f configure -width [lindex [.f configure -width] 3]
+} -result {32}
+test frame-1.39 {frame configuration options} -body {
+    .f configure -width badValue
+} -returnCodes error -result {bad screen distance "badValue"}
 destroy .f
 
-test frame-2.1 {toplevel configuration options} {
-    catch {destroy .t}
+
+test frame-2.1 {toplevel configuration options} -setup {
+	deleteWindows
+} -body {
     toplevel .t -width 200 -height 100 -class NewClass
     wm geometry .t +0+0
-    list [.t configure -class] [catch {.t configure -class Another} msg] $msg
-} {{-class class Class Toplevel NewClass} 1 {can't modify -class option after widget is created}}
-test frame-2.2 {toplevel configuration options} {
-    catch {destroy .t}
+    .t configure -class
+} -cleanup {
+    deleteWindows
+} -result {-class class Class Toplevel NewClass}
+test frame-2.2 {toplevel configuration options} -setup {
+    deleteWindows
+} -body {
+    toplevel .t -width 200 -height 100 -class NewClass
+    wm geometry .t +0+0
+    .t configure -class Another
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't modify -class option after widget is created}
+
+test frame-2.3 {toplevel configuration options} -setup {
+	deleteWindows
+} -body {
     toplevel .t -width 200 -height 100 -colormap new
     wm geometry .t +0+0
-    list [.t configure -colormap] [catch {.t configure -colormap .} msg] $msg
-} {{-colormap colormap Colormap {} new} 1 {can't modify -colormap option after widget is created}}
-test frame-2.3 {toplevel configuration options} {
+    .t configure -colormap
+} -cleanup {
+    deleteWindows
+} -result {-colormap colormap Colormap {} new}
+test frame-2.4 {toplevel configuration options} -setup {
+    deleteWindows
+} -body {
+    toplevel .t -width 200 -height 100 -colormap new
+    wm geometry .t +0+0
+    .t configure -colormap .
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't modify -colormap option after widget is created}
+
+test frame-2.5 {toplevel configuration options} -setup {
+	deleteWindows
+} -body {
+    toplevel .t -width 200 -height 100
+    wm geometry .t +0+0
+    .t configure -container 1
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't modify -container option after widget is created}
+test frame-2.6 {toplevel configuration options} -setup {
+    deleteWindows
+} -body {
     catch {destroy .t}
     toplevel .t -width 200 -height 100
     wm geometry .t +0+0
-    list [catch {.t configure -container 1} msg] $msg [.t configure -container]
-} {1 {can't modify -container option after widget is created} {-container container Container 0 0}}
-test frame-2.4 {toplevel configuration options} {
+    catch {.t configure -container 1}
+    .t configure -container
+} -cleanup {
+    deleteWindows
+} -result {-container container Container 0 0}
+
+test frame-2.7 {toplevel configuration options} -setup {
+	deleteWindows
+} -body {
+    toplevel .t -width 200 -height 100 -colormap bogus
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {bad window path name "bogus"}
+
+
+test frame-2.8 {toplevel configuration options} -constraints {
+    win
+} -setup {
+	deleteWindows
+} -body {
     catch {destroy .t}
-    list [catch {toplevel .t -width 200 -height 100 -colormap bogus} msg] $msg
-} {1 {bad window path name "bogus"}}
-set default "[winfo visual .] [winfo depth .]"
-if {$tcl_platform(platform) == "windows"} {
-test frame-2.5 {toplevel configuration options} {
+    toplevel .t -width 200 -height 100
+    wm geometry .t +0+0
+    .t configure -use 0x44022
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {window "0x44022" doesn't exist}
+test frame-2.9 {toplevel configuration options} -constraints {
+    win
+} -setup {
+    deleteWindows
+} -body {
     catch {destroy .t}
     toplevel .t -width 200 -height 100
     wm geometry .t +0+0
-    list [catch {.t configure -use 0x44022} msg] $msg [.t configure -use]
-} {1 {window "0x44022" doesn't exist} {-use use Use {} {}}}
-} else {
-test frame-2.5 {toplevel configuration options} {
+    catch {.t configure -use 0x44022}
+    .t configure -use
+} -cleanup {
+    deleteWindows
+} -result {-use use Use {} {}}
+
+test frame-2.10 {toplevel configuration options} -constraints {
+    nonwin
+} -setup {
+    deleteWindows
+} -body {
     catch {destroy .t}
     toplevel .t -width 200 -height 100
     wm geometry .t +0+0
-    list [catch {.t configure -use 0x44022} msg] $msg [.t configure -use]
-} {1 {can't modify -use option after widget is created} {-use use Use {} {}}}
-}
+    .t configure -use 0x44022
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't modify -use option after widget is created}
+test frame-2.11 {toplevel configuration options} -constraints {
+    nonwin
+} -setup {
+	deleteWindows
+} -body {
+    catch {destroy .t}
+    toplevel .t -width 200 -height 100
+    wm geometry .t +0+0
+    catch {.t configure -use 0x44022}
+    .t configure -use
+} -cleanup {
+    deleteWindows
+} -result {-use use Use {} {}}
 
-test frame-2.6 {toplevel configuration options} {
+test frame-2.12 {toplevel configuration options} -setup {
+	deleteWindows
+} -body {
     catch {destroy .t}
     toplevel .t -width 200 -height 100 -visual default
     wm geometry .t +0+0
-    list [.t configure -visual] [catch {.t configure -visual best} msg] $msg
-} {{-visual visual Visual {} default} 1 {can't modify -visual option after widget is created}}
-test frame-2.7 {toplevel configuration options} {
-    catch {destroy .t}
-    list [catch {toplevel .t -width 200 -height 100 -visual who_knows?} msg] $msg
-} {1 {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
-test frame-2.8 {toplevel configuration options} haveDISPLAY {
+    .t configure -visual
+} -cleanup {
+    deleteWindows
+} -result {-visual visual Visual {} default}
+test frame-2.13 {toplevel configuration options} -setup {
+    deleteWindows
+} -body {
     catch {destroy .t}
+    toplevel .t -width 200 -height 100 -visual default
+    wm geometry .t +0+0
+    .t configure -visual best
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't modify -visual option after widget is created}
+
+test frame-2.14 {toplevel configuration options} -setup {
+	deleteWindows
+} -body {
+    toplevel .t -width 200 -height 100 -visual who_knows?
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}
+test frame-2.15 {toplevel configuration options} -constraints haveDISPLAY -setup {
+	deleteWindows
+} -body {
     toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
     wm geometry .t +0+0
-    set cfg [string compare [.t configure -screen] \
-        "-screen screen Screen {} $env(DISPLAY)"]
-    list $cfg [catch {.t configure -screen another} msg] $msg
-} {0 1 {can't modify -screen option after widget is created}}
-test frame-2.9 {toplevel configuration options} {
-    catch {destroy .t}
-    list [catch {toplevel .t -width 200 -height 100 -screen bogus} msg] $msg
-} {1 {couldn't connect to display "bogus"}}
-test frame-2.10 {toplevel configuration options} {
-    catch {destroy .t}
-    catch {destroy .x}
+    string compare [.t configure -screen] "-screen screen Screen {} $env(DISPLAY)"
+} -cleanup {
+    deleteWindows
+} -result {0}
+test frame-2.16 {toplevel configuration options} -constraints haveDISPLAY -setup {
+    deleteWindows
+} -body {
+    toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
+    wm geometry .t +0+0
+    .t configure -screen another
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't modify -screen option after widget is created}
+
+test frame-2.17 {toplevel configuration options} -setup {
+	deleteWindows
+} -body {
+    toplevel .t -width 200 -height 100 -screen bogus
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {couldn't connect to display "bogus"}
+test frame-2.18 {toplevel configuration options} -setup {
+	deleteWindows
+} -body {
     toplevel .t -container 1 -width 300 -height 120
     wm geometry .t +0+0
-    set result [list \
-            [catch {toplevel .x -container 1 -use [winfo id .t]} msg] $msg]
-    destroy .t .x
-    set result
-} {1 {A window cannot have both the -use and the -container option set.}}
-test frame-2.11 {toplevel configuration options} {
+    toplevel .x -container 1 -use [winfo id .t]
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {A window cannot have both the -use and the -container option set.}
+test frame-2.19 {toplevel configuration options} -setup {
+	deleteWindows
+    set opts {}
+} -body {
     # Make sure all options can be set to the default value
     toplevel .f
-    set opts {}
     foreach opt [.f configure] {
         if {[llength $opt] == 5} {
             lappend opts [lindex $opt 0] [lindex $opt 4]
@@ -218,112 +484,184 @@ test frame-2.11 {toplevel configuration options} {
     }
     eval toplevel .g $opts
     destroy .f .g
-} {}
+} -cleanup {
+    deleteWindows
+} -result {}
+
 
-catch {destroy .t}
+destroy .t
 toplevel .t -width 300 -height 150
 wm geometry .t +0+0
 update
-set i 12
-foreach test {
-    {-background #ff0000 #ff0000 non-existent
-	    {unknown color name "non-existent"}}
-    {-bd 4 4 badValue {bad screen distance "badValue"}}
-    {-bg #00ff00 #00ff00 non-existent
-	    {unknown color name "non-existent"}}
-    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
-    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
-    {-height 100 100 not_a_number {bad screen distance "not_a_number"}}
-    {-highlightcolor #123456 #123456 non-existent
-	    {unknown color name "non-existent"}}
-    {-highlightthickness 3 3 badValue {bad screen distance "badValue"}}
-    {-padx 3 3 badValue {bad screen distance "badValue"}}
-    {-pady 4 4 badValue {bad screen distance "badValue"}}
-    {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
-    {-width 32 32 badValue {bad screen distance "badValue"}}
-} {
-    lassign $test opt goodValue goodResult badValue badResult
-    test frame-2.$i {toplevel configuration options} {
-	.t configure $opt $goodValue
-	lindex [.t configure $opt] 4
-    } $goodResult
-    incr i
-    if {$badValue ne ""} {
-	test frame-2.$i {toplevel configuration options} -body {
-	    .t configure $opt $badValue
-	} -returnCodes error -result $badResult
-    }
-    .t configure $opt [lindex [.t configure $opt] 3]
-    incr i
-}
+test frame-2.20 {toplevel configuration options} -body {
+    .t configure -background #ff0000
+    lindex [.t configure -background] 4
+} -result {#ff0000}
+test frame-2.21 {toplevel configuration options} -body {
+    .t configure -background non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test frame-2.22 {toplevel configuration options} -body {
+    .t configure -bd 4
+    lindex [.t configure -bd] 4
+} -result {4}
+test frame-2.23 {toplevel configuration options} -body {
+    .t configure -bd badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-2.24 {toplevel configuration options} -body {
+    .t configure -bg #00ff00
+    lindex [.t configure -bg] 4
+} -result {#00ff00}
+test frame-2.25 {toplevel configuration options} -body {
+    .t configure -bg non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test frame-2.26 {toplevel configuration options} -body {
+    .t configure -borderwidth 1.3
+    lindex [.t configure -borderwidth] 4
+} -result {1}
+test frame-2.27 {toplevel configuration options} -body {
+    .t configure -borderwidth badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-2.28 {toplevel configuration options} -body {
+    .t configure -cursor arrow
+    lindex [.t configure -cursor] 4
+} -result {arrow}
+test frame-2.29 {toplevel configuration options} -body {
+    .t configure -cursor badValue
+} -returnCodes error -result {bad cursor spec "badValue"}
+test frame-2.30 {toplevel configuration options} -body {
+    .t configure -height 100
+    lindex [.t configure -height] 4
+} -result {100}
+test frame-2.31 {toplevel configuration options} -body {
+    .t configure -height not_a_number
+} -returnCodes error -result {bad screen distance "not_a_number"}
+test frame-2.32 {toplevel configuration options} -body {
+    .t configure -highlightcolor #123456
+    lindex [.t configure -highlightcolor] 4
+} -result {#123456}
+test frame-2.33 {toplevel configuration options} -body {
+    .t configure -highlightcolor non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test frame-2.34 {toplevel configuration options} -body {
+    .t configure -highlightthickness 3
+    lindex [.t configure -highlightthickness] 4
+} -result {3}
+test frame-2.35 {toplevel configuration options} -body {
+    .t configure -highlightthickness badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-2.36 {toplevel configuration options} -body {
+    .t configure -padx 3
+    lindex [.t configure -padx] 4
+} -result {3}
+test frame-2.37 {toplevel configuration options} -body {
+    .t configure -padx badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-2.38 {toplevel configuration options} -body {
+    .t configure -pady 4
+    lindex [.t configure -pady] 4
+} -result {4}
+test frame-2.39 {toplevel configuration options} -body {
+    .t configure -pady badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-2.40 {toplevel configuration options} -body {
+    .t configure -relief ridge
+    lindex [.t configure -relief] 4
+} -result {ridge}
+test frame-2.41 {toplevel configuration options} -body {
+    .t configure -relief badValue
+} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
+test frame-2.42 {toplevel configuration options} -body {
+    .t configure -width 32
+    lindex [.t configure -width] 4
+} -result {32}
+test frame-2.43 {toplevel configuration options} -body {
+    .t configure -width badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+destroy .t
+
 
 test frame-3.1 {TkCreateFrame procedure} -body {
     frame
 } -returnCodes error -result {wrong # args: should be "frame pathName ?-option value ...?"}
 test frame-3.2 {TkCreateFrame procedure} -setup {
-    catch {destroy .f}
+	deleteWindows
     frame .f
 } -body {
     .f configure -class
 } -cleanup {
-    destroy .f
+    deleteWindows
 } -result {-class class Class Frame Frame}
 test frame-3.3 {TkCreateFrame procedure} -setup {
-    catch {destroy .t}
+	deleteWindows
     toplevel .t
     wm geometry .t +0+0
 } -body {
     .t configure -class
 } -cleanup {
-    destroy .t
+    deleteWindows
 } -result {-class class Class Toplevel Toplevel}
-test frame-3.4 {TkCreateFrame procedure} {
-    catch {destroy .t}
+test frame-3.4 {TkCreateFrame procedure} -setup {
+	deleteWindows
+} -body {
     toplevel .t -width 350 -class NewClass -bg black -visual default -height 90
     wm geometry .t +0+0
     update
     list [lindex [.t configure -width] 4] \
 	    [lindex [.t configure -background] 4] \
 	    [lindex [.t configure -height] 4]
-} {350 black 90}
+} -cleanup {
+    deleteWindows
+} -result {350 black 90}
 
 # Be sure that the -class, -colormap, and -visual options are processed
 # before configuring the widget.
-
-test frame-3.5 {TkCreateFrame procedure} {
-    catch {destroy .f}
+test frame-3.5 {TkCreateFrame procedure} -setup {
+	deleteWindows
+} -body {
     option add *NewFrame.background #123456
     frame .f -class NewFrame
-    option clear
     lindex [.f configure -background] 4
-} {#123456}
-test frame-3.6 {TkCreateFrame procedure} {
-    catch {destroy .f}
+} -cleanup {
+    deleteWindows
+    option clear
+} -result {#123456}
+test frame-3.6 {TkCreateFrame procedure} -setup {
+	deleteWindows
+} -body {
     option add *NewFrame.background #123456
     frame .f -class NewFrame
-    option clear
     lindex [.f configure -background] 4
-} {#123456}
-test frame-3.7 {TkCreateFrame procedure} {
-    catch {destroy .f}
+} -cleanup {
+    deleteWindows
+    option clear
+} -result {#123456}
+test frame-3.7 {TkCreateFrame procedure} -setup {
+	deleteWindows
+} -body {
     option add *NewFrame.background #332211
     option add *f.class NewFrame
     frame .f
-    option clear
     list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]
-} {NewFrame #332211}
-test frame-3.8 {TkCreateFrame procedure} {
-    catch {destroy .f}
+} -cleanup {
+    deleteWindows
+    option clear
+} -result {NewFrame #332211}
+test frame-3.8 {TkCreateFrame procedure} -setup {
+	deleteWindows
+} -body {
     option add *Silly.background #122334
     option add *f.Class Silly
     frame .f
-    option clear
     list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]
-} {Silly #122334}
-test frame-3.9 {TkCreateFrame procedure, -use option} -setup {
-    catch {destroy .t}
-    catch {destroy .x}
-} -constraints unix -body {
+} -cleanup {
+    deleteWindows
+    option clear
+} -result {Silly #122334}
+test frame-3.9 {TkCreateFrame procedure, -use option} -constraints {
+    unix
+} -setup {
+	deleteWindows
+} -body {
     toplevel .t -container 1 -width 300 -height 120
     wm geometry .t +0+0
     toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green
@@ -332,12 +670,13 @@ test frame-3.9 {TkCreateFrame procedure, -use option} -setup {
 	    [expr {[winfo rooty .x] - [winfo rooty .t]}] \
 	    [winfo width .t] [winfo height .t]
 } -cleanup {
-    destroy .t
+    deleteWindows
 } -result {0 0 140 300}
-test frame-3.10 {TkCreateFrame procedure, -use option} -setup {
-    catch {destroy .t}
-    catch {destroy .x}
-} -constraints unix -body {
+test frame-3.10 {TkCreateFrame procedure, -use option} -constraints {
+    unix
+} -setup {
+    deleteWindows
+} -body {
     toplevel .t -container 1 -width 300 -height 120
     wm geometry .t +0+0
     option add *x.use [winfo id .t]
@@ -355,26 +694,38 @@ test frame-3.10 {TkCreateFrame procedure, -use option} -setup {
 # they are run on a pseudocolor display of depth 8).  Even so, they
 # are non-portable: some machines don't seem to ever run out of
 # colors.
-
 if {[testConstraint defaultPseudocolor8]} {
     eatColors .t1
 }
-test frame-3.11 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} {
-    catch {destroy .t}
+test frame-3.11 {TkCreateFrame procedure} -constraints {
+	defaultPseudocolor8 nonPortable
+} -setup {
+	deleteWindows
+} -body {
     toplevel .t -width 300 -height 200 -bg #475601
     wm geometry .t +0+0
     update
     colorsFree .t
-} {0}
-test frame-3.12 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} {
-    catch {destroy .t}
+} -cleanup {
+    deleteWindows
+} -result {0}
+test frame-3.12 {TkCreateFrame procedure} -constraints {
+	defaultPseudocolor8 nonPortable
+} -setup {
+	deleteWindows
+} -body {
     toplevel .t -width 300 -height 200 -bg #475601 -colormap new
     wm geometry .t +0+0
     update
     colorsFree .t
-} {1}
-test frame-3.13 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} {
-    catch {destroy .t}
+} -cleanup {
+    deleteWindows
+} -result {1}
+test frame-3.13 {TkCreateFrame procedure} -constraints {
+	defaultPseudocolor8 nonPortable
+} -setup {
+	deleteWindows
+} -body {
     option add *t.class Toplevel2
     option add *Toplevel2.colormap new
     toplevel .t -width 300 -height 200 -bg #475601
@@ -382,9 +733,14 @@ test frame-3.13 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} {
     update
     option clear
     colorsFree .t
-} {1}
-test frame-3.14 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} {
-    catch {destroy .t}
+} -cleanup {
+    deleteWindows
+} -result {1}
+test frame-3.14 {TkCreateFrame procedure} -constraints {
+	defaultPseudocolor8 nonPortable
+} -setup {
+	deleteWindows
+} -body {
     option add *t.class Toplevel3
     option add *Toplevel3.Colormap new
     toplevel .t -width 300 -height 200 -bg #475601 -colormap new
@@ -392,11 +748,14 @@ test frame-3.14 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} {
     update
     option clear
     colorsFree .t
-} {1}
-test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -setup {
-    catch {destroy .t}
-    catch {destroy .x}
-} -constraints {defaultPseudocolor8 unix nonPortable} -body {
+} -cleanup {
+    deleteWindows
+} -result {1}
+test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -constraints {
+    defaultPseudocolor8 unix nonPortable
+} -setup {
+    deleteWindows
+} -body {
     toplevel .t -container 1 -width 300 -height 120
     wm geometry .t +0+0
     toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new
@@ -405,30 +764,48 @@ test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -setup {
 } -cleanup {
     destroy .t
 } -result {0 1}
-test frame-3.16 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} {
-    catch {destroy .t}
+test frame-3.16 {TkCreateFrame procedure} -constraints {
+	defaultPseudocolor8 nonPortable
+} -setup {
+	deleteWindows
+} -body {
     toplevel .t -width 300 -height 200 -bg #475601 -visual default
     wm geometry .t +0+0
     update
     colorsFree .t
-} {0}
-test frame-3.17 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} {
-    catch {destroy .t}
+} -cleanup {
+    deleteWindows
+} -result {0}
+test frame-3.17 {TkCreateFrame procedure} -constraints {
+	defaultPseudocolor8 nonPortable
+} -setup {
+	deleteWindows
+} -body {
     toplevel .t -width 300 -height 200 -bg #475601 -visual default \
 	    -colormap new
     wm geometry .t +0+0
     update
     colorsFree .t
-} {1}
-test frame-3.18 {TkCreateFrame procedure} {defaultPseudocolor8 haveGrayscale8 nonPortable} {
-    catch {destroy .t}
+} -cleanup {
+    deleteWindows
+} -result {1}
+test frame-3.18 {TkCreateFrame procedure} -constraints {
+	defaultPseudocolor8 haveGrayscale8 nonPortable
+} -setup {
+	deleteWindows
+} -body {
     toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343 
     wm geometry .t +0+0
     update
     colorsFree .t 131 131 131
-} {1}
-test frame-3.19 {TkCreateFrame procedure} {defaultPseudocolor8 haveGrayscale8 nonPortable} {
-    catch {destroy .t}
+} -cleanup {
+    deleteWindows
+} -result {1}
+test frame-3.19 {TkCreateFrame procedure} -constraints {
+	defaultPseudocolor8 haveGrayscale8 nonPortable
+} -setup {
+	deleteWindows
+} -body {
     option add *t.class T4
     option add *T4.visual {grayscale 8}
     toplevel .t -width 300 -height 200 -bg #434343
@@ -436,9 +813,14 @@ test frame-3.19 {TkCreateFrame procedure} {defaultPseudocolor8 haveGrayscale8 no
     update
     option clear
     list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
-} {1 {grayscale 8}}
-test frame-3.20 {TkCreateFrame procedure} {defaultPseudocolor8 haveGrayscale8 nonPortable} {
-    catch {destroy .t}
+} -cleanup {
+    deleteWindows
+} -result {1 {grayscale 8}}
+test frame-3.20 {TkCreateFrame procedure} -constraints {
+	defaultPseudocolor8 haveGrayscale8 nonPortable
+} -setup {
+	deleteWindows
+} -body {
     set x ok
     option add *t.class T5
     option add *T5.Visual {grayscale 8}
@@ -447,20 +829,28 @@ test frame-3.20 {TkCreateFrame procedure} {defaultPseudocolor8 haveGrayscale8 no
     update
     option clear
     list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
-} {1 {grayscale 8}}
-test frame-3.21 {TkCreateFrame procedure} {defaultPseudocolor8 haveGrayscale8 nonPortable} {
-    catch {destroy .t}
+} -cleanup {
+    deleteWindows
+} -result {1 {grayscale 8}}
+test frame-3.21 {TkCreateFrame procedure} -constraints {
+	defaultPseudocolor8 haveGrayscale8 nonPortable
+} -setup {
+	deleteWindows
+} -body {
     set x ok
     toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343 
     wm geometry .t +0+0
     update
     colorsFree .t 131 131 131
-} {1}
+} -cleanup {
+    deleteWindows
+} -result {1}
 if {[testConstraint defaultPseudocolor8]} {
     destroy .t1
 }
+
 test frame-3.22 {TkCreateFrame procedure, default dimensions} -setup {
-    catch {destroy .t}
+	deleteWindows
 } -body {
     toplevel .t
     wm geometry .t +0+0
@@ -471,87 +861,103 @@ test frame-3.22 {TkCreateFrame procedure, default dimensions} -setup {
     update
     lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f]
 } -cleanup {
-    destroy .t
+    deleteWindows
 } -result {200 200 1 1}
 test frame-3.23 {TkCreateFrame procedure} -setup {
-    catch {destroy .f}
+    deleteWindows
 } -body {
     frame .f -gorp glob
 } -returnCodes error -result {unknown option "-gorp"}
 test frame-3.24 {TkCreateFrame procedure} -setup {
-    catch {destroy .t}
+    deleteWindows
 } -body {
     toplevel .t -width 300 -height 200 -colormap new -bogus option
     wm geometry .t +0+0
 } -returnCodes error -result {unknown option "-bogus"}
 
-test frame-4.1 {TkCreateFrame procedure} {
-    catch {destroy .f}
+
+test frame-4.1 {TkCreateFrame procedure} -setup {
+	deleteWindows
+} -body {
     catch {frame .f -gorp glob}
     winfo exists .f
-} 0
-test frame-4.2 {TkCreateFrame procedure} {
-    catch {destroy .f}
+} -result 0
+test frame-4.2 {TkCreateFrame procedure} -setup {
+	deleteWindows
+} -body {
     list [frame .f -width 200 -height 100] [winfo exists .f]
-} {.f 1}
+} -cleanup {
+    deleteWindows
+} -result {.f 1}
+
 
-catch {destroy .f}
 frame .f -highlightcolor black
-test frame-5.1 {FrameWidgetCommand procedure} {
-    list [catch .f msg] $msg
-} {1 {wrong # args: should be ".f option ?arg ...?"}}
-test frame-5.2 {FrameWidgetCommand procedure, cget option} {
-    list [catch {.f cget} msg] $msg
-} {1 {wrong # args: should be ".f cget option"}}
-test frame-5.3 {FrameWidgetCommand procedure, cget option} {
-    list [catch {.f cget a b} msg] $msg
-} {1 {wrong # args: should be ".f cget option"}}
-test frame-5.4 {FrameWidgetCommand procedure, cget option} {
-    list [catch {.f cget -gorp} msg] $msg
-} {1 {unknown option "-gorp"}}
-test frame-5.5 {FrameWidgetCommand procedure, cget option} {
+test frame-5.1 {FrameWidgetCommand procedure} -body {
+    .f
+} -returnCodes error -result {wrong # args: should be ".f option ?arg ...?"}
+test frame-5.2 {FrameWidgetCommand procedure, cget option} -body {
+    .f cget
+} -returnCodes error -result {wrong # args: should be ".f cget option"}
+test frame-5.3 {FrameWidgetCommand procedure, cget option} -body {
+    .f cget a b
+} -returnCodes error -result {wrong # args: should be ".f cget option"}
+test frame-5.4 {FrameWidgetCommand procedure, cget option} -body {
+    .f cget -gorp
+} -returnCodes error -result {unknown option "-gorp"}
+test frame-5.5 {FrameWidgetCommand procedure, cget option} -body {
     .f cget -highlightcolor
-} {black}
-test frame-5.6 {FrameWidgetCommand procedure, cget option} {
-    list [catch {.f cget -screen} msg] $msg
-} {1 {unknown option "-screen"}}
-test frame-5.7 {FrameWidgetCommand procedure, cget option} {
-    catch {destroy .t}
+} -result {black}
+test frame-5.6 {FrameWidgetCommand procedure, cget option} -body {
+    .f cget -screen
+} -returnCodes error -result {unknown option "-screen"}
+test frame-5.7 {FrameWidgetCommand procedure, cget option} -setup {
+    destroy .t
+} -body {
     toplevel .t
-    catch {.t cget -screen}
-} {0}
-catch {destroy .t}
-test frame-5.8 {FrameWidgetCommand procedure, configure option} {
+    .t cget -screen
+} -cleanup {
+    destroy .t
+} -returnCodes ok -match glob -result *
+
+test frame-5.8 {FrameWidgetCommand procedure, configure option} -body {
     llength [.f configure]
-} {18}
-test frame-5.9 {FrameWidgetCommand procedure, configure option} {
-    list [catch {.f configure -gorp} msg] $msg
-} {1 {unknown option "-gorp"}}
-test frame-5.10 {FrameWidgetCommand procedure, configure option} {
-    list [catch {.f configure -gorp bogus} msg] $msg
-} {1 {unknown option "-gorp"}}
-test frame-5.11 {FrameWidgetCommand procedure, configure option} {
-    list [catch {.f configure -width 200 -height} msg] $msg
-} {1 {value for "-height" missing}}
-test frame-5.12 {FrameWidgetCommand procedure} {
-    list [catch {.f swizzle} msg] $msg
-} {1 {bad option "swizzle": must be cget or configure}}
-test frame-5.13 {FrameWidgetCommand procedure, configure option} {
+} -result {18}
+test frame-5.9 {FrameWidgetCommand procedure, configure option} -body {
+    .f configure -gorp
+} -returnCodes error -result {unknown option "-gorp"}
+test frame-5.10 {FrameWidgetCommand procedure, configure option} -body {
+    .f configure -gorp bogus
+} -returnCodes error -result {unknown option "-gorp"}
+test frame-5.11 {FrameWidgetCommand procedure, configure option} -body {
+    .f configure -width 200 -height
+} -returnCodes error -result {value for "-height" missing}
+test frame-5.12 {FrameWidgetCommand procedure} -body {
+    .f swizzle
+} -returnCodes error -result {bad option "swizzle": must be cget or configure}
+test frame-5.13 {FrameWidgetCommand procedure, configure option} -body {
     llength [. configure]
-} {21}
+} -result {21}
+destroy .f
 
-test frame-6.1 {ConfigureFrame procedure} {
-    catch {destroy .f}
+test frame-6.1 {ConfigureFrame procedure} -setup {
+	deleteWindows
+} -body {
     frame .f -width 150
     list [winfo reqwidth .f] [winfo reqheight .f]
-} {150 1}
-test frame-6.2 {ConfigureFrame procedure} {
-    catch {destroy .f}
+} -cleanup {
+    deleteWindows
+} -result {150 1}
+test frame-6.2 {ConfigureFrame procedure} -setup {
+	deleteWindows
+} -body {
     frame .f -height 97
     list [winfo reqwidth .f] [winfo reqheight .f]
-} {1 97}
-test frame-6.3 {ConfigureFrame procedure} {
-    catch {destroy .f}
+} -cleanup {
+    deleteWindows
+} -result {1 97}
+test frame-6.3 {ConfigureFrame procedure} -setup {
+	deleteWindows
+} -body {
     frame .f
     set result {}
     lappend result [winfo reqwidth .f] [winfo reqheight .f]
@@ -559,77 +965,98 @@ test frame-6.3 {ConfigureFrame procedure} {
     lappend result [winfo reqwidth .f] [winfo reqheight .f]
     .f configure -width 0 -height 0
     lappend result [winfo reqwidth .f] [winfo reqheight .f]
-} {1 1 100 180 100 180}
+} -cleanup {
+    deleteWindows
+} -result {1 1 100 180 100 180}
 
-test frame-7.1 {FrameEventProc procedure} {
+test frame-7.1 {FrameEventProc procedure} -setup {
+	deleteWindows
+} -body {
     frame .frame2
     set result [info commands .frame2]
     destroy .frame2
     lappend result [info commands .frame2]
-} {.frame2 {}}
-test frame-7.2 {FrameEventProc procedure} {
-    deleteWindows
+} -result {.frame2 {}}
+test frame-7.2 {FrameEventProc procedure} -setup {
+	deleteWindows
+    set x {}
+} -body {
     frame .f1 -bg #543210
     rename .f1 .f2
-    set x {}
     lappend x [winfo children .]
     lappend x [.f2 cget -bg]
     destroy .f1
     lappend x [info command .f*] [winfo children .]
-} {.f1 #543210 {} {}}
-
-test frame-8.1 {FrameCmdDeletedProc procedure} {
+} -cleanup {
     deleteWindows
+} -result {.f1 #543210 {} {}}
+
+test frame-8.1 {FrameCmdDeletedProc procedure} -setup {
+	deleteWindows
+} -body {
     frame .f1
     rename .f1 {}
     list [info command .f*] [winfo children .]
-} {{} {}}
-test frame-8.2 {FrameCmdDeletedProc procedure} {
+} -cleanup {
     deleteWindows
+} -result {{} {}}
+test frame-8.2 {FrameCmdDeletedProc procedure} -setup {
+	deleteWindows
+} -body {
     toplevel .f1 -menu .m
     wm geometry .f1 +0+0
     update
     rename .f1 {}
     update
     list [info command .f*] [winfo children .]
-} {{} {}}
+} -cleanup {
+    deleteWindows
+} -result {{} {}}
 #
 # This one fails with the dash-patch!!!! Still don't know why  :-(
 #
-#test frame-8.3 {FrameCmdDeletedProc procedure} {
+#test frame-8.3 {FrameCmdDeletedProc procedure} -setup {
 #    eval destroy [winfo children .]
+#    deleteWindows
+#} -body {
 #    toplevel .f1 -menu .m
 #    wm geometry .f1 +0+0
 #    menu .m
 #    update
 #    rename .f1 {}
 #    update
-#    set result [list [info command .f*] [winfo children .]]
+#    list [info command .f*] [winfo children .]
+#} -cleanup {
 #    eval destroy [winfo children .]
-#    set result
-#} {{} .m}
+#    deleteWindows
+#} -result {{} .m}
 
-test frame-9.1 {MapFrame procedure} {
-    catch {destroy .t}
+test frame-9.1 {MapFrame procedure} -setup {
+	deleteWindows
+} -body {
     toplevel .t -width 100 -height 400
     wm geometry .t +0+0
     set result [winfo ismapped .t]
     update idletasks
     lappend result [winfo ismapped .t]
-} {0 1}
-test frame-9.2 {MapFrame procedure} {
-    catch {destroy .t}
+} -cleanup {
+    deleteWindows
+} -result {0 1}
+test frame-9.2 {MapFrame procedure} -setup {
+	deleteWindows
+} -body {
     toplevel .t -width 100 -height 400
     wm geometry .t +0+0
     destroy .t
     update
     winfo exists .t
-} {0}
-test frame-9.3 {MapFrame procedure, window deleted while mapping} {
+} -result {0}
+test frame-9.3 {MapFrame procedure, window deleted while mapping} -setup {
+	deleteWindows
+} -body {
     toplevel .t2 -width 200 -height 200
     wm geometry .t2 +0+0
     tkwait visibility .t2
-    catch {destroy .t}
     toplevel .t -width 100 -height 400
     wm geometry .t +0+0
     frame .t2.f -width 50 -height 50
@@ -637,53 +1064,66 @@ test frame-9.3 {MapFrame procedure, window deleted while mapping} {
     pack .t2.f -side top
     update idletasks
     winfo exists .t
-} {0}
+} -cleanup {
+    deleteWindows
+} -result {0}
 
-set l [interp hidden]
-deleteWindows
 
-test frame-10.1 {frame widget vs hidden commands} {
-    catch {destroy .t}
+test frame-10.1 {frame widget vs hidden commands} -setup {
+	deleteWindows
+} -body {
+    set l [interp hidden]
     frame .t
     interp hide {} .t
     destroy .t
-    list [winfo children .] [interp hidden]
-} [list {} $l]
+    set res1 [list [winfo children .] [interp hidden]]
+    set res2 [list {} $l]
+    expr {$res1 eq $res2}
+} -result 1
 
-test frame-11.1 {TkInstallFrameMenu} {
-    catch {destroy .t}
+
+test frame-11.1 {TkInstallFrameMenu} -setup {
+	deleteWindows
+} -body {
     menu .m1
     .m1 add cascade -menu .m1.system
     menu .m1.system -tearoff 0
     .m1.system add command -label foo
-    list [toplevel .t -menu .m1] [destroy .m1] [destroy .t]
-} {.t {} {}}
-test frame-11.2 {TkInstallFrameMenu - frame renamed} {
-    catch {destroy .t}
+    toplevel .t -menu .m1
+} -cleanup {
+    deleteWindows
+} -result {.t}
+test frame-11.2 {TkInstallFrameMenu - frame renamed} -setup {
+	deleteWindows
+} -body {
     catch {rename foo {}}
     menu .m1
     .m1 add cascade -menu .m1.system
     menu .m1.system -tearoff 0
     .m1.system add command -label foo
     toplevel .t
-    list [rename .t foo] [destroy .t] [destroy foo] [destroy .m1]
-} {{} {} {} {}}
+    rename .t foo
+} -cleanup {
+    deleteWindows
+} -result {}
+
 
-test frame-12.1 {FrameWorldChanged procedure} {
+test frame-12.1 {FrameWorldChanged procedure} -setup {
+	deleteWindows
+} -body {
     # Test -bd -padx and -pady
-    destroy .f
     frame .f -borderwidth 2 -padx 3 -pady 4
     place .f -x 0 -y 0 -width 40 -height 40
     pack [frame .f.f] -fill both -expand 1
     update
-    set result [list [winfo x .f.f] [winfo y .f.f] \
-            [winfo width .f.f] [winfo height .f.f]]
-    destroy .f
-    set result
-} {5 6 30 28}
-test frame-12.2 {FrameWorldChanged procedure} {
+    list [winfo x .f.f] [winfo y .f.f] [winfo width .f.f] [winfo height .f.f]
+} -cleanup {
+    deleteWindows
+} -result {5 6 30 28}
+test frame-12.2 {FrameWorldChanged procedure} -setup {
+	deleteWindows
+} -body {
     # Test all -labelanchor positions
-    destroy .f
     set font {helvetica 12}
     labelframe .f -highlightthickness 1 -bd 3 -padx 1 -pady 2 -font $font \
             -text "Mupp"
@@ -712,12 +1152,14 @@ test frame-12.2 {FrameWorldChanged procedure} {
                 [winfo x .f.f] == $expx && [winfo y .f.f] == $expy &&\
                 [winfo width .f.f] == $expw && [winfo height .f.f] == $exph}]
     }
-    destroy .f
-    set result
-} {1 1 1 1 1 1 1 1 1 1 1 1}
-test frame-12.3 {FrameWorldChanged procedure} {
+    return $result
+} -cleanup {
+    deleteWindows
+} -result {1 1 1 1 1 1 1 1 1 1 1 1}
+test frame-12.3 {FrameWorldChanged procedure} -setup {
+	deleteWindows
+} -body {
     # Check reaction on font change
-    destroy .f
     font create myfont -family courier -size 10
     labelframe .f -font myfont -text Mupp
     place .f -x 0 -y 0 -width 40 -height 40
@@ -729,103 +1171,267 @@ test frame-12.3 {FrameWorldChanged procedure} {
     update
     set h2 [font metrics myfont -linespace]
     set y2 [winfo y .f.f]
-    destroy .f
-    font delete myfont
     expr {($h2 - $h1) - ($y2 - $y1)}
-} {0}
+} -cleanup {
+    deleteWindows
+    font delete myfont
+} -result {0}
+
 
-test frame-13.1 {labelframe configuration options} {
+test frame-13.1 {labelframe configuration options} -setup {
+	deleteWindows
+} -body {
     labelframe .f -class NewFrame
-    list [.f configure -class] [catch {.f configure -class Different} msg] $msg
-} {{-class class Class Labelframe NewFrame} 1 {can't modify -class option after widget is created}}
-catch {destroy .f}
-test frame-13.2 {labelframe configuration options} {
-    list [catch {labelframe .f -colormap new} msg] $msg
-} {0 .f}
-catch {destroy .f}
-test frame-13.3 {labelframe configuration options} {
-    list [catch {labelframe .f -visual default} msg] $msg
-} {0 .f}
-catch {destroy .f}
-test frame-13.4 {labelframe configuration options} {
-    list [catch {labelframe .f -screen bogus} msg] $msg
-} {1 {unknown option "-screen"}}
-test frame-13.5 {labelframe configuration options} {
-    set result [list [catch {labelframe .f -container true} msg] $msg \
-	    [.f configure -container]]
-    destroy .f
-    set result
-} {0 .f {-container container Container 0 1}}
-test frame-13.6 {labelframe configuration options} {
-    list [catch {labelframe .f -container bogus} msg] $msg
-} {1 {expected boolean value but got "bogus"}}
-test frame-13.7 {labelframe configuration options} {
+    .f configure -class
+} -cleanup {
+    deleteWindows
+} -result {-class class Class Labelframe NewFrame}
+test frame-13.2 {labelframe configuration options} -setup {
+    deleteWindows
+} -body {
+    labelframe .f -class NewFrame
+    .f configure -class Different
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't modify -class option after widget is created}
+test frame-13.3 {labelframe configuration options} -setup {
+	deleteWindows
+} -body {
+    labelframe .f -colormap new
+} -cleanup {
+    deleteWindows
+} -result {.f}
+test frame-13.4 {labelframe configuration options} -setup {
+	deleteWindows
+} -body {
+    labelframe .f -visual default
+} -cleanup {
+    deleteWindows
+} -result {.f}
+test frame-13.5 {labelframe configuration options} -setup {
+	deleteWindows
+} -body {
+    labelframe .f -screen bogus
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {unknown option "-screen"}
+test frame-13.6 {labelframe configuration options} -setup {
+	deleteWindows
+} -body {
+    labelframe .f -container true
+} -cleanup {
+    deleteWindows
+} -result {.f}
+test frame-13.7 {labelframe configuration options} -setup {
+    deleteWindows
+} -body {
+    labelframe .f -container true
+    .f configure -container
+} -cleanup {
+    deleteWindows
+} -result {-container container Container 0 1}
+test frame-13.8 {labelframe configuration options} -setup {
+	deleteWindows
+} -body {
+     labelframe .f -container bogus
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {expected boolean value but got "bogus"}
+test frame-13.9 {labelframe configuration options} -setup {
+	deleteWindows
+} -body {
     labelframe .f
-    set result [list [catch {.f configure -container 1} msg] $msg]
-    destroy .f
-    set result
-} {1 {can't modify -container option after widget is created}}
+    .f configure -container 1
+} -cleanup {
+    deleteWindows
+} -returnCodes error -result {can't modify -container option after widget is created}
+
+destroy .f
 labelframe .f
-set i 8
-foreach test {
-    {-background #ff0000 #ff0000 non-existent
-	    {unknown color name "non-existent"}}
-    {-bd 4 4 badValue {bad screen distance "badValue"}}
-    {-bg #00ff00 #00ff00 non-existent
-	    {unknown color name "non-existent"}}
-    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
-    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
-    {-fg #0000ff #0000ff non-existent
-	    {unknown color name "non-existent"}}
-    {-font {courier 8} {courier 8} {} {}}
-    {-foreground #ff0000 #ff0000 non-existent
-	    {unknown color name "non-existent"}}
-    {-height 100 100 not_a_number {bad screen distance "not_a_number"}}
-    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
-    {-highlightcolor #123456 #123456 non-existent
-	    {unknown color name "non-existent"}}
-    {-highlightthickness 6 6 badValue {bad screen distance "badValue"}}
-    {-labelanchor se se badValue {bad labelanchor "badValue": must be e, en, es, n, ne, nw, s, se, sw, w, wn, or ws}}
-    {-padx 3 3 badValue {bad screen distance "badValue"}}
-    {-pady 4 4 badValue {bad screen distance "badValue"}}
-    {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
-    {-takefocus "any string" "any string" {} {}}
-    {-text "any string" "any string" {} {}}
-    {-width 32 32 badValue {bad screen distance "badValue"}}
-} {
-    lassign $test name goodValue goodResult badValue badResult
-    test frame-13.$i {labelframe configuration options} {
-	.f configure $name $goodValue
-	lindex [.f configure $name] 4
-    } $goodResult
-    incr i
-    if {$badValue ne ""} {
-	test frame-13.$i {labelframe configuration options} -body {
-	    .f configure $name $badValue
-	} -returnCodes error -result $badResult
-    }
-    .f configure $name [lindex [.f configure $name] 3]
-    incr i
-}
+test frame-13.10 {labelframe configuration options} -body {
+    .f configure -background #ff0000
+    lindex [.f configure -background] 4
+} -cleanup {
+    .f configure -background [lindex [.f configure -background] 3]
+} -result {#ff0000}
+test frame-13.11 {labelframe configuration options} -body {
+        .f configure -background non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test frame-13.12 {labelframe configuration options} -body {
+    .f configure -bd 4
+    lindex [.f configure -bd] 4
+} -cleanup {
+    .f configure -bd [lindex [.f configure -bd] 3]
+} -result {4}
+test frame-13.13 {labelframe configuration options} -body {
+        .f configure -bd badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-13.14 {labelframe configuration options} -body {
+    .f configure -bg #00ff00
+    lindex [.f configure -bg] 4
+} -cleanup {
+    .f configure -bg [lindex [.f configure -bg] 3]
+} -result {#00ff00}
+test frame-13.15 {labelframe configuration options} -body {
+        .f configure -bg non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test frame-13.16 {labelframe configuration options} -body {
+    .f configure -borderwidth 1.3
+    lindex [.f configure -borderwidth] 4
+} -cleanup {
+    .f configure -borderwidth [lindex [.f configure -borderwidth] 3]
+} -result {1}
+test frame-13.17 {labelframe configuration options} -body {
+        .f configure -borderwidth badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-13.18 {labelframe configuration options} -body {
+    .f configure -cursor arrow
+    lindex [.f configure -cursor] 4
+} -cleanup {
+    .f configure -cursor [lindex [.f configure -cursor] 3]
+} -result {arrow}
+test frame-13.19 {labelframe configuration options} -body {
+        .f configure -cursor badValue
+} -returnCodes error -result {bad cursor spec "badValue"}
+test frame-13.20 {labelframe configuration options} -body {
+    .f configure -fg #0000ff
+    lindex [.f configure -fg] 4
+} -cleanup {
+    .f configure -fg [lindex [.f configure -fg] 3]
+} -result {#0000ff}
+test frame-13.21 {labelframe configuration options} -body {
+        .f configure -fg non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test frame-13.22 {labelframe configuration options} -body {
+    .f configure -font {courier 8}
+    lindex [.f configure -font] 4
+} -cleanup {
+    .f configure -font [lindex [.f configure -font] 3]
+} -result {courier 8}
+test frame-13.23 {labelframe configuration options} -body {
+    .f configure -foreground #ff0000
+    lindex [.f configure -foreground] 4
+} -cleanup {
+    .f configure -foreground [lindex [.f configure -foreground] 3]
+} -result {#ff0000}
+test frame-13.24 {labelframe configuration options} -body {
+        .f configure -foreground non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test frame-13.25 {labelframe configuration options} -body {
+    .f configure -height 100
+    lindex [.f configure -height] 4
+} -cleanup {
+    .f configure -height [lindex [.f configure -height] 3]
+} -result {100}
+test frame-13.26 {labelframe configuration options} -body {
+        .f configure -height not_a_number
+} -returnCodes error -result {bad screen distance "not_a_number"}
+test frame-13.27 {labelframe configuration options} -body {
+    .f configure -highlightbackground #112233
+    lindex [.f configure -highlightbackground] 4
+} -cleanup {
+    .f configure -highlightbackground [lindex [.f configure -highlightbackground] 3]
+} -result {#112233}
+test frame-13.28 {labelframe configuration options} -body {
+        .f configure -highlightbackground ugly
+} -returnCodes error -result {unknown color name "ugly"}
+test frame-13.29 {labelframe configuration options} -body {
+    .f configure -highlightcolor #123456
+    lindex [.f configure -highlightcolor] 4
+} -cleanup {
+    .f configure -highlightcolor [lindex [.f configure -highlightcolor] 3]
+} -result {#123456}
+test frame-13.30 {labelframe configuration options} -body {
+        .f configure -highlightcolor non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+test frame-13.31 {labelframe configuration options} -body {
+    .f configure -highlightthickness 6
+    lindex [.f configure -highlightthickness] 4
+} -cleanup {
+    .f configure -highlightthickness [lindex [.f configure -highlightthickness] 3]
+} -result {6}
+test frame-13.32 {labelframe configuration options} -body {
+        .f configure -highlightthickness badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-13.33 {labelframe configuration options} -body {
+    .f configure -labelanchor se
+    lindex [.f configure -labelanchor] 4
+} -cleanup {
+    .f configure -labelanchor [lindex [.f configure -labelanchor] 3]
+} -result {se}
+test frame-13.34 {labelframe configuration options} -body {
+        .f configure -labelanchor badValue
+} -returnCodes error -result {bad labelanchor "badValue": must be e, en, es, n, ne, nw, s, se, sw, w, wn, or ws}
+test frame-13.35 {labelframe configuration options} -body {
+    .f configure -padx 3
+    lindex [.f configure -padx] 4
+} -cleanup {
+    .f configure -padx [lindex [.f configure -padx] 3]
+} -result {3}
+test frame-13.36 {labelframe configuration options} -body {
+        .f configure -padx badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-13.37 {labelframe configuration options} -body {
+    .f configure -pady 4
+    lindex [.f configure -pady] 4
+} -cleanup {
+    .f configure -pady [lindex [.f configure -pady] 3]
+} -result {4}
+test frame-13.38 {labelframe configuration options} -body {
+        .f configure -pady badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+test frame-13.39 {labelframe configuration options} -body {
+    .f configure -relief ridge
+    lindex [.f configure -relief] 4
+} -cleanup {
+    .f configure -relief [lindex [.f configure -relief] 3]
+} -result {ridge}
+test frame-13.40 {labelframe configuration options} -body {
+        .f configure -relief badValue
+} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
+test frame-13.41 {labelframe configuration options} -body {
+    .f configure -takefocus {any string}
+    lindex [.f configure -takefocus] 4
+} -cleanup {
+    .f configure -takefocus [lindex [.f configure -takefocus] 3]
+} -result {any string}
+test frame-13.42 {labelframe configuration options} -body {
+    .f configure -text {any string}
+    lindex [.f configure -text] 4
+} -cleanup {
+    .f configure -text [lindex [.f configure -text] 3]
+} -result {any string}
+test frame-13.43 {labelframe configuration options} -body {
+    .f configure -width 32
+    lindex [.f configure -width] 4
+} -cleanup {
+    .f configure -width [lindex [.f configure -width] 3]
+} -result {32}
+test frame-13.44 {labelframe configuration options} -body {
+        .f configure -width badValue
+} -returnCodes error -result {bad screen distance "badValue"}
 destroy .f
 
-test frame-14.1 {labelframe labelwidget option} {
+
+test frame-14.1 {labelframe labelwidget option} -setup {
+	deleteWindows
+} -body {
     # Test that label is moved in stacking order
-    destroy .f .l
     label .l -text Mupp -font {helvetica 8}
     labelframe .f -labelwidget .l
     pack .f
     frame .f.f -width 50 -height 50
     pack .f.f
     update
-    set res [list [winfo children .] [winfo width .f] \
-            [expr {[winfo height .f] - [winfo height .l]}]]
-    destroy .f .l
-    set res
-} {{.f .l} 54 52}
-test frame-14.2 {labelframe labelwidget option} {
+    list [winfo children .] [winfo width .f] \
+        [expr {[winfo height .f] - [winfo height .l]}]
+} -cleanup {
+    deleteWindows
+} -result {{.f .l} 54 52}
+test frame-14.2 {labelframe labelwidget option} -setup {
+	deleteWindows
+} -body {
     # Test the labelframe's reaction if the label is destroyed
-    destroy .f .l
     label .l -text Aratherlonglabel
     labelframe .f -labelwidget .l
     pack .f
@@ -838,12 +1444,13 @@ test frame-14.2 {labelframe labelwidget option} {
     lappend res [.f cget -labelwidget]
     update
     lappend res [expr {[winfo width .f] - [winfo width .f.l]}]
-    destroy .f
-    set res
-} {.l 12 {} 4}
-test frame-14.3 {labelframe labelwidget option} {
+} -cleanup {
+    deleteWindows
+} -result {.l 12 {} 4}
+test frame-14.3 {labelframe labelwidget option} -setup {
+	deleteWindows
+} -body {
     # Test the labelframe's reaction if the label is stolen
-    destroy .f .l
     label .l -text Aratherlonglabel
     labelframe .f -labelwidget .l
     pack .f
@@ -856,12 +1463,13 @@ test frame-14.3 {labelframe labelwidget option} {
     lappend res [.f cget -labelwidget]
     update
     lappend res [expr {[winfo width .f] - [winfo width .f.l]}]
-    destroy .f .l
-    set res
-} {.l 12 {} 4}
-test frame-14.4 {labelframe labelwidget option} {
+} -cleanup {
+    deleteWindows
+} -result {.l 12 {} 4}
+test frame-14.4 {labelframe labelwidget option} -setup {
+	deleteWindows
+} -body {
     # Test the label's reaction if the labelframe is destroyed
-    destroy .f .l
     label .l -text Mupp
     labelframe .f -labelwidget .l
     pack .f
@@ -869,12 +1477,13 @@ test frame-14.4 {labelframe labelwidget option} {
     set res [list [winfo manager .l]]
     destroy .f
     lappend res [winfo manager .l]
-    destroy .l
-    set res
-} {labelframe {}}
-test frame-14.5 {labelframe labelwidget option} {
+} -cleanup {
+    deleteWindows
+} -result {labelframe {}}
+test frame-14.5 {labelframe labelwidget option} -setup {
+	deleteWindows
+} -body {
     # Test that the labelframe reacts on changes in label
-    destroy .f .l
     label .l -text Aratherlonglabel
     labelframe .f -labelwidget .l
     pack .f
@@ -891,24 +1500,25 @@ test frame-14.5 {labelframe labelwidget option} {
     update
     lappend res [expr {[winfo width .f] - [winfo width .l]}]
     lappend res [expr {[winfo width .f] > $first}]
-    destroy .f .l
-    set res
-} {12 12 1 12 1}
-test frame-14.6 {labelframe labelwidget option} {
+} -cleanup {
+    deleteWindows
+} -result {12 12 1 12 1}
+test frame-14.6 {labelframe labelwidget option} -setup {
+	deleteWindows
+} -body {
     # Destroying a labelframe with a child label caused a crash
     # when not handling mapping of the label correctly.
     # This test does not test anything directly, it's just ment
     # to catch if the same mistake is made again.
-    destroy .f
     labelframe .f
     pack .f
     label .f.l -text Mupp
     .f configure -labelwidget .f.l
     update
-    destroy .f
-} {}
-
-catch {destroy .f}
+} -cleanup {
+    deleteWindows
+} -result {}
+deleteWindows
 rename eatColors {}
 rename colorsFree {}
 
@@ -916,3 +1526,6 @@ rename colorsFree {}
 cleanupTests
 return
 
+
+
+
diff --git a/tests/image.test b/tests/image.test
index b6f9ec7..5f2466d 100644
--- a/tests/image.test
+++ b/tests/image.test
@@ -7,40 +7,57 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: image.test,v 1.15 2008/07/23 23:24:25 nijtmans Exp $
+# RCS: @(#) $Id: image.test,v 1.16 2008/08/15 01:10:03 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
-namespace import -force ::tk::test::loadTkCommand
 
 eval image delete [image names]
+# Canvas used in some tests in the whole file
 canvas .c -highlightthickness 2
 pack .c
 update
-test image-1.1 {Tk_ImageCmd procedure, "create" option} {
-    list [catch image msg] $msg
-} {1 {wrong # args: should be "image option ?args?"}}
-test image-1.2 {Tk_ImageCmd procedure, "create" option} {
-    list [catch {image gorp} msg] $msg
-} {1 {bad option "gorp": must be create, delete, height, inuse, names, type, types, or width}}
-test image-1.3 {Tk_ImageCmd procedure, "create" option} {
-    list [catch {image create} msg] $msg
-} {1 {wrong # args: should be "image create type ?name? ?-option value ...?"}}
-test image-1.4 {Tk_ImageCmd procedure, "create" option} {
-    list [catch {image c bad_type} msg] $msg
-} {1 {image type "bad_type" doesn't exist}}
-test image-1.5 {Tk_ImageCmd procedure, "create" option} testImageType {
+
+
+test image-1.1 {Tk_ImageCmd procedure, "create" option} -body {
+    image
+} -returnCodes error -result {wrong # args: should be "image option ?args?"}
+test image-1.2 {Tk_ImageCmd procedure, "create" option} -body {
+    image gorp
+} -returnCodes error -result {bad option "gorp": must be create, delete, height, inuse, names, type, types, or width}
+test image-1.3 {Tk_ImageCmd procedure, "create" option} -body {
+    image create
+} -returnCodes error -result {wrong # args: should be "image create type ?name? ?-option value ...?"}
+test image-1.4 {Tk_ImageCmd procedure, "create" option} -body {
+    image c bad_type
+} -returnCodes error -result {image type "bad_type" doesn't exist}
+test image-1.5 {Tk_ImageCmd procedure, "create" option} -constraints {
+    testImageType 
+} -body {
     list [image create test myimage] [image names]
-} {myimage myimage}
-test image-1.6 {Tk_ImageCmd procedure, "create" option} testImageType {
+} -cleanup {
+    eval image delete [image names]
+} -result {myimage myimage}
+test image-1.6 {Tk_ImageCmd procedure, "create" option} -constraints {
+    testImageType 
+} -setup {
+    eval image delete [image names] 
+} -body {
     scan [image create test] image%d first
     image create test myimage
     scan [image create test -variable x] image%d second
     expr $second-$first
-} {1}
-test image-1.7 {Tk_ImageCmd procedure, "create" option} testImageType {
-    image delete myimage
+} -cleanup {
+    eval image delete [image names]
+} -result {1}
+
+test image-1.7 {Tk_ImageCmd procedure, "create" option} -constraints {
+	testImageType 
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test myimage -variable x
     .c create image 100 50 -image myimage
     .c create image 100 150 -image myimage
@@ -48,10 +65,16 @@ test image-1.7 {Tk_ImageCmd procedure, "create" option} testImageType {
     set x {}
     image create test myimage -variable x
     update
-    set x
-} {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}}
-test image-1.8 {Tk_ImageCmd procedure, "create" option} testImageType {
-    .c delete all
+    return $x
+} -cleanup {
+    eval image delete [image names] 
+} -result {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}}
+test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints {
+	testImageType 
+} -setup {
+	.c delete all
+    eval image delete [image names] 
+} -body {
     image create test myimage -variable x
     .c create image 100 50 -image myimage
     .c create image 100 150 -image myimage
@@ -60,185 +83,279 @@ test image-1.8 {Tk_ImageCmd procedure, "create" option} testImageType {
     set x {}
     image create test myimage -variable x
     update
-    set x
-} {{myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}}
-test image-1.9 {Tk_ImageCmd procedure, "create" option} testImageType {
+    return $x
+} -cleanup {
     .c delete all
-    eval image delete [image names]
-    list [catch {image create test -badName foo} msg] $msg [image names]
-} {1 {bad option name "-badName"} {}}
-test image-1.10 {Tk_ImageCmd procedure, "create" option with same name as main window} {
+    eval image delete [image names] 
+} -result {{myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}}
+test image-1.9 {Tk_ImageCmd procedure, "create" option} -constraints {
+	testImageType 
+} -body {
+    image create test -badName foo
+} -returnCodes error -result {bad option name "-badName"}
+test image-1.10 {Tk_ImageCmd procedure, "create" option} -constraints {
+    testImageType 
+} -body {
+    catch {image create test -badName foo}
+    image names
+} -result {}
+test image-1.11 {Tk_ImageCmd procedure, "create" option with same name as main window} -body {
     set code [loadTkCommand]
     append code {
-	update
-	puts [list [catch {image create photo .} msg] $msg]
-	exit
+	    update
+	    puts [list [catch {image create photo .} msg] $msg]
+	    exit
     }
     set script [makeFile $code script]
-    set x [list [catch {exec [interpreter] <$script} msg] $msg]
+    exec [interpreter] <$script
+} -cleanup {
     removeFile script
-    set x
-} {0 {1 {images may not be named the same as the main window}}}
-test image-1.11 {Tk_ImageCmd procedure, "create" option with same name as main window after renaming} {
+} -result {1 {images may not be named the same as the main window}}
+test image-1.12 {Tk_ImageCmd procedure, "create" option with same name as main window after renaming} -body {
     set code [loadTkCommand]
     append code {
-	update
-	puts [list [catch {rename . foo;image create photo foo} msg] $msg]
-	exit
+	    update
+	    puts [list [catch {rename . foo;image create photo foo} msg] $msg]
+	    exit
     }
     set script [makeFile $code script]
-    set x [list [catch {exec [interpreter] <$script} msg] $msg]
+    exec [interpreter] <$script
+} -cleanup {
     removeFile script
-    set x
-} {0 {1 {images may not be named the same as the main window}}}
-test image-1.12 {Tk_ImageCmd, "create" option: do not generated command name in use} -setup {
+} -result {1 {images may not be named the same as the main window}}
+test image-1.13 {Tk_ImageCmd, "create" option: do not generated command name in use} -setup {
+	.c delete all
+    eval image delete [image names] 
+} -body {
     set i [image create bitmap]
     regexp {^image(\d+)$} $i -> serial
     incr serial
     proc image$serial {} {return works}
     set j [image create bitmap]
-} -body {
+
     image$serial
 } -cleanup {
     rename image$serial {}
     image delete $i $j
 } -result works
 
-test image-2.1 {Tk_ImageCmd procedure, "delete" option} {
-    list [catch {image delete} msg] $msg
-} {0 {}}
-test image-2.2 {Tk_ImageCmd procedure, "delete" option} testImageType {
-    .c delete all
-    eval image delete [image names]
+test image-2.1 {Tk_ImageCmd procedure, "delete" option} -body {
+    image delete
+} -result {}
+test image-2.2 {Tk_ImageCmd procedure, "delete" option} -constraints {
+	testImageType 
+} -setup {
+    eval image delete [image names] 
+    set result {}
+} -body {
     image create test myimage
     image create test img2
-    set result {}
     lappend result [lsort [image names]]
     image d myimage img2
     lappend result [image names]
-} {{img2 myimage} {}}
-test image-2.3 {Tk_ImageCmd procedure, "delete" option} testImageType {
-    .c delete all
-    eval image delete [image names]
+} -cleanup {
+    eval image delete [image names] 
+} -result {{img2 myimage} {}}
+test image-2.3 {Tk_ImageCmd procedure, "delete" option} -constraints {
+	testImageType 
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test myimage
     image create test img2
-    list [catch {image delete myimage gorp img2} msg] $msg [image names]
-} {1 {image "gorp" doesn't exist} img2}
-
-test image-3.1 {Tk_ImageCmd procedure, "height" option} {
-    list [catch {image height} msg] $msg
-} {1 {wrong # args: should be "image height name"}}
-test image-3.2 {Tk_ImageCmd procedure, "height" option} {
-    list [catch {image height a b} msg] $msg
-} {1 {wrong # args: should be "image height name"}}
-test image-3.3 {Tk_ImageCmd procedure, "height" option} {
-    list [catch {image height foo} msg] $msg
-} {1 {image "foo" doesn't exist}}
-test image-3.4 {Tk_ImageCmd procedure, "height" option} testImageType {
+    image delete myimage gorp img2
+} -cleanup {
+    eval image delete [image names] 
+} -returnCodes error -result {image "gorp" doesn't exist}
+test image-2.4 {Tk_ImageCmd procedure, "delete" option} -constraints {
+    testImageType 
+} -setup {
+    eval image delete [image names] 
+} -body {
+    image create test myimage
+    image create test img2
+    catch {image delete myimage gorp img2}
+    image names
+} -cleanup {
+    eval image delete [image names] 
+} -result {img2}
+
+
+test image-3.1 {Tk_ImageCmd procedure, "height" option} -body {
+    image height
+} -returnCodes error -result {wrong # args: should be "image height name"}
+test image-3.2 {Tk_ImageCmd procedure, "height" option} -body {
+    image height a b
+} -returnCodes error -result {wrong # args: should be "image height name"}
+test image-3.3 {Tk_ImageCmd procedure, "height" option} -body {
+    image height foo
+} -returnCodes error -result {image "foo" doesn't exist}
+test image-3.4 {Tk_ImageCmd procedure, "height" option} -constraints {
+    testImageType 
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test myimage
     set x [image h myimage]
     myimage changed 0 0 0 0 60 50
     list $x [image height myimage]
-} {15 50}
+} -cleanup {
+    eval image delete [image names] 
+} -result {15 50}
 
-test image-4.1 {Tk_ImageCmd procedure, "names" option} {
-    list [catch {image names x} msg] $msg
-} {1 {wrong # args: should be "image names"}}
-test image-4.2 {Tk_ImageCmd procedure, "names" option} testImageType {
-    .c delete all
-    eval image delete [image names]
+
+test image-4.1 {Tk_ImageCmd procedure, "names" option} -body {
+    image names x
+} -returnCodes error -result {wrong # args: should be "image names"}
+test image-4.2 {Tk_ImageCmd procedure, "names" option} -constraints {
+	testImageType 
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test myimage
     image create test img2
     image create test 24613
     lsort [image names]
-} {24613 img2 myimage}
-test image-4.3 {Tk_ImageCmd procedure, "names" option} {
-    .c delete all
-    eval image delete [image names]
+} -cleanup {
+    eval image delete [image names] 
+} -result {24613 img2 myimage}
+test image-4.3 {Tk_ImageCmd procedure, "names" option} -setup {
+    eval image delete [image names] 
+} -body {
+    eval image delete [image names] [image names]
     lsort [image names]
-} {}
-
-test image-5.1 {Tk_ImageCmd procedure, "type" option} {
-    list [catch {image type} msg] $msg
-} {1 {wrong # args: should be "image type name"}}
-test image-5.2 {Tk_ImageCmd procedure, "type" option} {
-    list [catch {image type a b} msg] $msg
-} {1 {wrong # args: should be "image type name"}}
-test image-5.3 {Tk_ImageCmd procedure, "type" option} {
-    list [catch {image type foo} msg] $msg
-} {1 {image "foo" doesn't exist}}
-test image-5.4 {Tk_ImageCmd procedure, "type" option} testImageType {
+} -cleanup {
+    eval image delete [image names] 
+} -result {}
+
+
+test image-5.1 {Tk_ImageCmd procedure, "type" option} -body {
+    image type
+} -returnCodes error -result {wrong # args: should be "image type name"}
+test image-5.2 {Tk_ImageCmd procedure, "type" option} -body {
+    image type a b
+} -returnCodes error -result {wrong # args: should be "image type name"}
+test image-5.3 {Tk_ImageCmd procedure, "type" option} -body {
+    image type foo
+} -returnCodes error -result {image "foo" doesn't exist}
+
+test image-5.4 {Tk_ImageCmd procedure, "type" option} -constraints {
+	testImageType 
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test myimage
     image type myimage
-} {test}
-test image-5.5 {Tk_ImageCmd procedure, "type" option} testImageType {
+} -cleanup {
+    eval image delete [image names] 
+} -result {test}
+test image-5.5 {Tk_ImageCmd procedure, "type" option} -constraints {
+	testImageType 
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test myimage
     .c create image 50 50 -image myimage
     image delete myimage
-    list [catch {image type myimage} msg] $msg
-} {1 {image "myimage" doesn't exist}}
-test image-5.6 {Tk_ImageCmd procedure, "type" option} testOldImageType {
+    image type myimage
+} -cleanup {
+    eval image delete [image names] 
+} -returnCodes error -result {image "myimage" doesn't exist}
+test image-5.6 {Tk_ImageCmd procedure, "type" option} -constraints {
+	testOldImageType 
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create oldtest myimage
     image type myimage
-} {oldtest}
-test image-5.7 {Tk_ImageCmd procedure, "type" option} testOldImageType {
+} -cleanup {
+    eval image delete [image names] 
+} -result {oldtest}
+test image-5.7 {Tk_ImageCmd procedure, "type" option} -constraints {
+	testOldImageType 
+} -setup {
+	.c delete all
+    eval image delete [image names] 
+} -body {
     image create oldtest myimage
     .c create image 50 50 -image myimage
     image delete myimage
-    list [catch {image type myimage} msg] $msg
-} {1 {image "myimage" doesn't exist}}
+    image type myimage
+} -cleanup {
+    .c delete all
+    eval image delete [image names] 
+} -returnCodes error -result {image "myimage" doesn't exist}
+
 
-test image-6.1 {Tk_ImageCmd procedure, "types" option} {
-    list [catch {image types x} msg] $msg
-} {1 {wrong # args: should be "image types"}}
-test image-6.2 {Tk_ImageCmd procedure, "types" option} testImageType {
+test image-6.1 {Tk_ImageCmd procedure, "types" option} -body {
+    image types x
+} -returnCodes error -result {wrong # args: should be "image types"}
+test image-6.2 {Tk_ImageCmd procedure, "types" option} -constraints {
+    testImageType 
+} -body {
     lsort [image types]
-} {bitmap oldtest photo test}
-
-test image-7.1 {Tk_ImageCmd procedure, "width" option} {
-    list [catch {image width} msg] $msg
-} {1 {wrong # args: should be "image width name"}}
-test image-7.2 {Tk_ImageCmd procedure, "width" option} {
-    list [catch {image width a b} msg] $msg
-} {1 {wrong # args: should be "image width name"}}
-test image-7.3 {Tk_ImageCmd procedure, "width" option} {
-    list [catch {image width foo} msg] $msg
-} {1 {image "foo" doesn't exist}}
-test image-7.4 {Tk_ImageCmd procedure, "width" option} testImageType {
+} -result {bitmap oldtest photo test}
+
+
+test image-7.1 {Tk_ImageCmd procedure, "width" option} -body {
+    image width
+} -returnCodes error -result {wrong # args: should be "image width name"}
+test image-7.2 {Tk_ImageCmd procedure, "width" option} -body {
+    image width a b
+} -returnCodes error -result {wrong # args: should be "image width name"}
+test image-7.3 {Tk_ImageCmd procedure, "width" option} -body {
+    image width foo
+} -returnCodes error -result {image "foo" doesn't exist}
+test image-7.4 {Tk_ImageCmd procedure, "width" option} -constraints {
+	testImageType 
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test myimage
     set x [image w myimage]
     myimage changed 0 0 0 0 60 50
     list $x [image width myimage]
-} {30 60}
+} -cleanup {
+    eval image delete [image names] 
+} -result {30 60}
 
-test image-8.1 {Tk_ImageCmd procedure, "inuse" option} testImageType {
-    catch {image delete myimage2}
-    image create test myimage2
+
+test image-8.1 {Tk_ImageCmd procedure, "inuse" option} -constraints {
+	testImageType 
+} -setup {
+    eval image delete [image names] 
     set res {}
+    destroy .b
+} -body {
+    image create test myimage2
     lappend res [image inuse myimage2]
-    catch {destroy .b}
     button .b -image myimage2
     lappend res [image inuse myimage2]
+} -cleanup {
+    eval image delete [image names] 
     catch {destroy .b}
-    image delete myimage2
-    set res
-} [list 0 1]
+} -result [list 0 1]
     
 
-test image-9.1 {Tk_ImageChanged procedure} testImageType {
-    .c delete all
-    eval image delete [image names]
+test image-9.1 {Tk_ImageChanged procedure} -constraints testImageType -setup {
+	.c delete all
+    eval image delete [image names] 
+} -body {
     image create test foo -variable x
     .c create image 50 50 -image foo
     update
     set x {}
     foo changed 5 6 7 8 30 15
     update
-    set x
-} {{foo display 5 6 7 8 30 30}}
-test image-9.2 {Tk_ImageChanged procedure} testImageType {
+    return $x
+} -cleanup {
     .c delete all
-    eval image delete [image names]
+    eval image delete [image names] 
+} -result {{foo display 5 6 7 8 30 30}}
+test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup {
+	.c delete all
+    eval image delete [image names] 
+} -body {
     image create test foo -variable x
     .c create image 50 50 -image foo
     .c create image 90 100 -image foo
@@ -246,25 +363,38 @@ test image-9.2 {Tk_ImageChanged procedure} testImageType {
     set x {}
     foo changed 5 6 7 8 30 15
     update
-    set x
-} {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}}
+    return $x
+} -cleanup {
+    .c delete all
+    eval image delete [image names] 
+} -result {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}}
 
-test image-10.1 {Tk_GetImage procedure} {
-    list [catch {.c create image 100 10 -image bad_name} msg] $msg
-} {1 {image "bad_name" doesn't exist}}
-test image-10.2 {Tk_GetImage procedure} testImageType {
+
+test image-10.1 {Tk_GetImage procedure} -setup {
+    eval image delete [image names] 
+} -body {
+    .c create image 100 10 -image bad_name
+} -cleanup {
+    eval image delete [image names] 
+} -returnCodes error -result {image "bad_name" doesn't exist}
+test image-10.2 {Tk_GetImage procedure} -constraints testImageType -setup {
+	destroy .l
+    eval image delete [image names] 
+} -body {
     image create test mytest
-    catch {destroy .l}
     label .l -image mytest
     image delete  mytest
-    set result [list [catch {label .l2 -image mytest} msg] $msg]
+    label .l2 -image mytest
+} -cleanup {
     destroy .l
-    set result
-} {1 {image "mytest" doesn't exist}}
+    eval image delete [image names] 
+} -returnCodes error -result {image "mytest" doesn't exist}
 
-test image-11.1 {Tk_FreeImage procedure} testImageType {
-    .c delete all
-    eval image delete [image names]
+
+test image-11.1 {Tk_FreeImage procedure} -constraints testImageType -setup {
+	.c delete all
+    eval image delete [image names] 
+} -body {
     image create test foo -variable x
     .c create image 50 50 -image foo -tags i1
     .c create image 90 100 -image foo -tags i2
@@ -275,10 +405,14 @@ test image-11.1 {Tk_FreeImage procedure} testImageType {
     pack .c
     update
     list [image names] $x
-} {foo {{foo free} {foo display 0 0 30 15 103 121}}}
-test image-11.2 {Tk_FreeImage procedure} testImageType {
+} -cleanup {
     .c delete all
-    eval image delete [image names]
+    eval image delete [image names] 
+} -result {foo {{foo free} {foo display 0 0 30 15 103 121}}}
+test image-11.2 {Tk_FreeImage procedure} -constraints testImageType -setup {
+	.c delete all
+    eval image delete [image names] 
+} -body {
     image create test foo -variable x
     .c create image 50 50 -image foo -tags i1
     set names [image names]
@@ -291,137 +425,179 @@ test image-11.2 {Tk_FreeImage procedure} testImageType {
     pack .c
     update
     list $names $names2 [image names] $x
-} {foo {} {} {}}
+} -cleanup {
+    .c delete all
+    eval image delete [image names] 
+} -result {foo {} {} {}}
 
-# Non-portable, apparently due to differences in rounding:
 
-test image-12.1 {Tk_RedrawImage procedure, redisplay area clipping} \
-	{testImageType nonPortable} {
-    .c delete all
-    eval image delete [image names]
+# Non-portable, apparently due to differences in rounding:
+test image-12.1 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
+    testImageType nonPortable
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test foo -variable x
     .c create image 50 60 -image foo -tags i1 -anchor nw
     update
     .c create rectangle 30 40 55 65 -width 0 -fill black -outline {}
     set x {}
     update
-    set x
-} {{foo display 0 0 5 5 50 50}}
-test image-12.2 {Tk_RedrawImage procedure, redisplay area clipping} \
-	{testImageType nonPortable} {
-    .c delete all
-    eval image delete [image names]
+    return $x
+} -cleanup {
+    eval image delete [image names] 
+} -result {{foo display 0 0 5 5 50 50}}
+test image-12.2 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
+    testImageType nonPortable
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test foo -variable x
     .c create image 50 60 -image foo -tags i1 -anchor nw
     update
     .c create rectangle 60 40 100 65 -width 0 -fill black -outline {}
     set x {}
     update
-    set x
-} {{foo display 10 0 20 5 30 50}}
-test image-12.3 {Tk_RedrawImage procedure, redisplay area clipping} \
-	{testImageType nonPortable} {
-    .c delete all
-    eval image delete [image names]
+    return $x
+} -cleanup {
+    eval image delete [image names] 
+} -result {{foo display 10 0 20 5 30 50}}
+test image-12.3 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
+    testImageType nonPortable
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test foo -variable x
     .c create image 50 60 -image foo -tags i1 -anchor nw
     update
     .c create rectangle 60 70 100 200 -width 0 -fill black -outline {}
     set x {}
     update
-    set x
-} {{foo display 10 10 20 5 30 30}}
-test image-12.4 {Tk_RedrawImage procedure, redisplay area clipping} \
-	{testImageType nonPortable} {
-    .c delete all
-    eval image delete [image names]
+    return $x
+} -cleanup {
+    eval image delete [image names] 
+} -result {{foo display 10 10 20 5 30 30}}
+test image-12.4 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
+    testImageType nonPortable
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test foo -variable x
     .c create image 50 60 -image foo -tags i1 -anchor nw
     update
     .c create rectangle 30 70 55 200 -width 0 -fill black -outline {}
     set x {}
     update
-    set x
-} {{foo display 0 10 5 5 50 30}}
-test image-12.5 {Tk_RedrawImage procedure, redisplay area clipping} \
-	{testImageType nonPortable} {
-    .c delete all
-    eval image delete [image names]
+    return $x
+} -cleanup {
+    eval image delete [image names] 
+} -result {{foo display 0 10 5 5 50 30}}
+test image-12.5 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
+    testImageType nonPortable
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test foo -variable x
     .c create image 50 60 -image foo -tags i1 -anchor nw
     update
     .c create rectangle 10 20 120 130 -width 0 -fill black -outline {}
     set x {}
     update
-    set x
-} {{foo display 0 0 30 15 70 70}}
-test image-12.6 {Tk_RedrawImage procedure, redisplay area clipping} \
-	{testImageType nonPortable} {
-    .c delete all
-    eval image delete [image names]
+    return $x
+} -cleanup {
+    eval image delete [image names] 
+} -result {{foo display 0 0 30 15 70 70}}
+test image-12.6 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
+    testImageType nonPortable
+} -setup {
+    eval image delete [image names] 
+} -body {
     image create test foo -variable x
     .c create image 50 60 -image foo -tags i1 -anchor nw
     update
     .c create rectangle 55 65 75 70 -width 0 -fill black -outline {}
     set x {}
     update
-    set x
-} {{foo display 5 5 20 5 30 30}}
+    return $x
+} -cleanup {
+    eval image delete [image names] 
+} -result {{foo display 5 5 20 5 30 30}}
 
-test image-13.1 {Tk_SizeOfImage procedure} testImageType {
-    eval image delete [image names]
+
+test image-13.1 {Tk_SizeOfImage procedure} -constraints testImageType -setup {
+    eval image delete [image names] 
+} -body {
     image create test foo -variable x
     set result [list [image width foo] [image height foo]]
     foo changed 0 0 0 0 85 60
     lappend result [image width foo] [image height foo]
-} {30 15 85 60}
+} -cleanup {
+    eval image delete [image names] 
+} -result {30 15 85 60}
 
-test image-13.2 {DeleteImage procedure} testImageType {
-    .c delete all
-    eval image delete [image names]
+test image-13.2 {DeleteImage procedure} -constraints testImageType -setup {
+	.c delete all
+    eval image delete [image names] 
+} -body {
+    eval image delete [image names] [image names]
     image create test foo -variable x
     .c create image 50 50 -image foo -tags i1
     .c create image 90 100 -image foo -tags i2
     set x {}
     image delete foo
     lappend x | [image names] | [catch {image delete foo} msg] | $msg | [image names] |
-} {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |}
+} -cleanup {
+    eval image delete [image names] 
+} -result {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |}
 
-test image-13.3 {Tk_SizeOfImage procedure} testOldImageType {
-    eval image delete [image names]
+test image-13.3 {Tk_SizeOfImage procedure} -constraints testOldImageType -setup {
+    eval image delete [image names] 
+} -body {
+    eval image delete [image names] [image names]
     image create oldtest foo -variable x
     set result [list [image width foo] [image height foo]]
     foo changed 0 0 0 0 85 60
     lappend result [image width foo] [image height foo]
-} {30 15 85 60}
+} -cleanup {
+    eval image delete [image names] 
+} -result {30 15 85 60}
 
-test image-13.4 {DeleteImage procedure} testOldImageType {
+test image-13.4 {DeleteImage procedure} -constraints testOldImageType -setup {
+	.c delete all
+    eval image delete [image names] 
+} -body {
     .c delete all
-    eval image delete [image names]
+    eval image delete [image names] [image names]
     image create oldtest foo -variable x
     .c create image 50 50 -image foo -tags i1
     .c create image 90 100 -image foo -tags i2
     set x {}
     image delete foo
     lappend x | [image names] | [catch {image delete foo} msg] | $msg | [image names] |
-} {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |}
-
+} -cleanup {
+    .c delete all
+    eval image delete [image names] 
+} -result {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |}
 
-catch {image delete hidden}
-set l [image names]
-set h [interp hidden]
 
-test image-14.1 {image command vs hidden commands} {
+test image-14.1 {image command vs hidden commands} -body {
     catch {image delete hidden}
+    set l [image names]
+    set h [interp hidden]
     image create photo hidden
     interp hide {} hidden
     image delete hidden
-    list [image names] [interp hidden]
-} [list $l $h]
+    set res1 [list [image names] [interp hidden]]
+    set res2 [list $l $h]
+    expr {$res1 eq $res2}
+} -result 1
+
 
 eval image delete [image names]
-test image-15.1 {deleting image does not make widgets forget about it} {
-    .c delete all
+test image-15.1 {deleting image does not make widgets forget about it} -setup {
+	.c delete all
+    eval image delete [image names] 
+} -body {
     image create photo foo -width 10 -height 10
     .c create image 10 10 -image foo -tags i1 -anchor nw
     update
@@ -431,7 +607,10 @@ test image-15.1 {deleting image does not make widgets forget about it} {
     lappend x [image names]
     image create photo foo -width 20 -height 20
     lappend x [.c bbox i1] [image names]
-} {10 10 20 20 foo {} {10 10 30 30} foo}
+} -cleanup {
+    .c delete all
+    eval image delete [image names] 
+} -result {10 10 20 20 foo {} {10 10 30 30} foo}
     
 destroy .c
 eval image delete [image names]
@@ -439,3 +618,6 @@ eval image delete [image names]
 # cleanup
 cleanupTests
 return
+
+
+