Update to tcltest2

1 files changed, 636 insertions, 248 deletions

diff --git a/tests/canvText.test b/tests/canvText.test
index 5367681..2e7ac54 100644
--- a/tests/canvText.test
+++ b/tests/canvText.test
@@ -6,117 +6,191 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: canvText.test,v 1.17 2008/07/23 23:24:25 nijtmans Exp $
+# RCS: @(#) $Id: canvText.test,v 1.18 2008/08/11 21:33:17 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
+# Canvas used in 1.* - 17.* tests
 canvas .c -width 400 -height 300 -bd 2 -relief sunken
 pack .c
 update
 
-set i 1
+# Item used in 1.*  tests
 .c create text 20 20 -tag test
-
-set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
-set ay [font metrics $font -linespace]
-set ax [font measure $font 0]
-
-
-foreach test {
-    {-anchor nw nw xyz {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center}}
-    {-fill #ff0000 #ff0000 xyz {unknown color name "xyz"}}
-    {-fill {} {} {} {}}
-    {-font {Times 40} {Times 40} {} {font "" doesn't exist}}
-    {-justify left left xyz {bad justification "xyz": must be left, right, or center}}
-    {-stipple gray50 gray50 xyz {bitmap "xyz" not defined}}
-    {-tags {test a b c} {test a b c} {} {}}
-    {-text xyz xyz {} {}}
-    {-underline 0 0 xyz {expected integer but got "xyz"}}
-    {-width 6 6 xyz {bad screen distance "xyz"}}
-} {
-    lassign $test name goodValue goodResult badValue badResult
-    test canvText-1.$i "configuration options: good value for $name" {
-	.c itemconfigure test $name $goodValue
-	list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name]
-    } [list $goodResult $goodResult]
-    incr i
-    if {$badValue ne ""} {
-	test canvText-1.$i "configuration options: bad value for $name" -body {
-	    .c itemconfigure test $name $badValue
-	} -returnCodes error -result $badResult
-    }
-    incr i
-}
-test canvText-1.$i {configuration options} {
-    .c itemconfigure test -tags {test xyz}
-    .c itemcget xyz -tags
-} {test xyz}
-
+test canvText-1.1 {configuration options: good value for "anchor"} -body {
+    .c itemconfigure test -anchor nw
+    list [lindex [.c itemconfigure test -anchor] 4] [.c itemcget test -anchor]
+} -result {nw nw}
+test canvasText-1.2 {configuration options: bad value for "anchor"} -body {
+    .c itemconfigure test -anchor xyz
+} -returnCodes error -result {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center}
+
+test canvText-1.3 {configuration options: good value for "fill"} -body {
+    .c itemconfigure test -fill #ff0000
+    list [lindex [.c itemconfigure test -fill] 4] [.c itemcget test -fill]
+} -result {{#ff0000} #ff0000}
+test canvasText-1.4 {configuration options: bad value for "fill"} -body {
+    .c itemconfigure test -fill xyz
+} -returnCodes error -result {unknown color name "xyz"}
+test canvText-1.5 {configuration options: good value for "fill"} -body {
+    .c itemconfigure test -fill {}
+    list [lindex [.c itemconfigure test -fill] 4] [.c itemcget test -fill]
+} -result {{} {}}
+
+test canvText-1.6 {configuration options: good value for "font"} -body {
+    .c itemconfigure test -font {Times 40}
+    list [lindex [.c itemconfigure test -font] 4] [.c itemcget test -font]
+} -result {{Times 40} {Times 40}}
+test canvasText-1.7 {configuration options: bad value for "font"} -body {
+    .c itemconfigure test -font {}
+} -returnCodes error -result {font "" doesn't exist}
+
+test canvText-1.8 {configuration options: good value for "justify"} -body {
+    .c itemconfigure test -justify left
+    list [lindex [.c itemconfigure test -justify] 4] [.c itemcget test -justify]
+} -result {left left}
+test canvasText-1.9 {configuration options: bad value for "justify"} -body {
+    .c itemconfigure test -justify xyz
+} -returnCodes error -result {bad justification "xyz": must be left, right, or center}
+
+test canvText-1.10 {configuration options: good value for "stipple"} -body {
+    .c itemconfigure test -stipple gray50
+    list [lindex [.c itemconfigure test -stipple] 4] [.c itemcget test -stipple]
+} -result {gray50 gray50}
+test canvasText-1.11 {configuration options: bad value for "stipple"} -body {
+    .c itemconfigure test -stipple xyz
+} -returnCodes error -result {bitmap "xyz" not defined}
+
+test canvText-1.12 {configuration options: good value for "underline"} -body {
+    .c itemconfigure test -underline 0
+    list [lindex [.c itemconfigure test -underline] 4] [.c itemcget test -underline]
+} -result {0 0}
+test canvasText-1.13 {configuration options: bad value for "underline"} -body {
+    .c itemconfigure test -underline xyz
+} -returnCodes error -result {expected integer but got "xyz"}
+
+test canvText-1.14 {configuration options: good value for "width"} -body {
+    .c itemconfigure test -width 6
+    list [lindex [.c itemconfigure test -width] 4] [.c itemcget test -width]
+} -result {6 6}
+test canvasText-1.15 {configuration options: bad value for "width"} -body {
+    .c itemconfigure test -width xyz
+} -returnCodes error -result {bad screen distance "xyz"}
+
+test canvText-1.16 {configuration options: good value for "tags"} -body {
+    .c itemconfigure test -tags {test a b c}
+    list [lindex [.c itemconfigure test -tags] 4] [.c itemcget test -tags]
+} -result {{test a b c} {test a b c}}
 .c delete test
-.c create text 20 20 -tag test
 
-test canvText-2.1 {CreateText procedure: args} {
-    list [catch {.c create text} msg] $msg
-} {1 {wrong # args: should be ".c create text coords ?arg ...?"}}
-test canvText-2.2 {CreateText procedure: args} {
-    list [catch {.c create text xyz 0} msg] $msg
-} {1 {bad screen distance "xyz"}}
-test canvText-2.3 {CreateText procedure: args} {
-    list [catch {.c create text 0 xyz} msg] $msg
-} {1 {bad screen distance "xyz"}}
-test canvText-2.4 {CreateText procedure: args} {
-    list [catch {.c create text 0 0 -xyz xyz} msg] $msg
-} {1 {unknown option "-xyz"}}
-test canvText-2.5 {CreateText procedure} {
+
+test canvText-2.1 {CreateText procedure: args} -body {
+    .c create text
+} -returnCodes {error} -result {wrong # args: should be ".c create text coords ?arg ...?"}
+test canvText-2.2 {CreateText procedure: args} -body {
+    .c create text xyz 0
+} -cleanup {
+	.c delete all
+} -returnCodes {error} -result {bad screen distance "xyz"}
+test canvText-2.3 {CreateText procedure: args} -body {
+    .c create text 0 xyz
+} -cleanup {
+	.c delete all
+} -returnCodes {error} -result {bad screen distance "xyz"}
+test canvText-2.4 {CreateText procedure: args} -body {
+    .c create text 0 0 -xyz xyz
+} -cleanup {
+	.c delete all
+} -returnCodes {error} -result {unknown option "-xyz"}
+test canvText-2.5 {CreateText procedure} -body {
     .c create text 0 0 -tags x
-    set x [.c coords x]
+    .c coords x
+} -cleanup {
     .c delete x
-    set x
-} {0.0 0.0}
+} -result {0.0 0.0}
 
-focus -force .c
-.c focus test
-.c coords test 0 0
-update
 
-test canvText-3.1 {TextCoords procedure} {
+test canvText-3.1 {TextCoords procedure} -body {
+	.c create text 20 20 -tag test
+	.c coords test 0 0
+	update
     .c coords test
-} {0.0 0.0}
-test canvText-3.2 {TextCoords procedure} {
-    list [catch {.c coords test xyz 0} msg] $msg
-} {1 {bad screen distance "xyz"}}
-test canvText-3.3 {TextCoords procedure} {
-    list [catch {.c coords test 0 xyz} msg] $msg
-} {1 {bad screen distance "xyz"}}
-test canvText-3.4 {TextCoords procedure} {
+} -cleanup {
+	.c delete test
+} -result {0.0 0.0}
+test canvText-3.2 {TextCoords procedure} -setup {
+	.c create text 20 20 -tag test
+} -body {
+    .c coords test xyz 0
+} -cleanup {
+	.c delete test
+} -returnCodes {error} -result {bad screen distance "xyz"}
+test canvText-3.3 {TextCoords procedure} -setup {
+	.c create text 20 20 -tag test
+} -body {
+    .c coords test 0 xyz
+} -cleanup {
+	.c delete test
+} -returnCodes {error} -result {bad screen distance "xyz"}
+test canvText-3.4 {TextCoords procedure} -setup {
+	.c create text 20 20 -tag test
+} -body {
     .c coords test 10 10
     set result {}
     foreach element [.c coords test] {
 	lappend result [format %.1f $element]
     }
-    set result
-} {10.0 10.0}
-test canvText-3.5 {TextCoords procedure} {
-    list [catch {.c coords test 10} msg] $msg
-} {1 {wrong # coordinates: expected 2, got 1}}
-test canvText-3.6 {TextCoords procedure} {
-    list [catch {.c coords test 10 10 10} msg] $msg
-} {1 {wrong # coordinates: expected 0 or 2, got 3}}
-
-test canvText-4.1 {ConfigureText procedure} {
-    list [catch {.c itemconfig test -fill xyz} msg] $msg
-} {1 {unknown color name "xyz"}}
-test canvText-4.2 {ConfigureText procedure} {
+    return $result
+} -cleanup {
+	.c delete test
+} -result {10.0 10.0}
+test canvText-3.5 {TextCoords procedure} -setup {
+	.c create text 20 20 -tag test
+} -body {
+    .c coords test 10
+} -cleanup {
+	.c delete test
+} -returnCodes {error} -result {wrong # coordinates: expected 2, got 1}
+test canvText-3.6 {TextCoords procedure} -setup {
+	.c create text 20 20 -tag test
+} -body {
+    .c coords test 10 10 10
+} -cleanup {
+	.c delete test
+} -returnCodes {error} -result {wrong # coordinates: expected 0 or 2, got 3}
+
+
+test canvText-4.1 {ConfigureText procedure} -setup {
+	.c create text 20 20 -tag test
+} -body {
+    .c itemconfig test -fill xyz
+} -cleanup {
+	.c delete test
+} -returnCodes {error} -result {unknown color name "xyz"}
+test canvText-4.2 {ConfigureText procedure} -setup {
+	.c create text 20 20 -tag test
+} -body {
     .c itemconfig test -fill blue
     .c itemcget test -fill
-} {blue}
-test canvText-4.3 {ConfigureText procedure: construct font gcs} {
+} -cleanup {
+	.c delete test
+} -result {blue}
+test canvText-4.3 {ConfigureText procedure: construct font gcs} -setup {
+	.c create text 20 20 -tag test
+} -body {
     .c itemconfig test -font "times 20" -fill black -stipple gray50
     list [.c itemcget test -font] [.c itemcget test -fill] [.c itemcget test -stipple]
-} {{times 20} black gray50}
-test canvText-4.4 {ConfigureText procedure: construct cursor gc} {
+} -cleanup {
+	.c delete test
+} -result {{times 20} black gray50}
+test canvText-4.4 {ConfigureText procedure: construct cursor gc} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
     .c itemconfig test -text "abcdefg"
     .c select from test 2
     .c select to test 4
@@ -133,9 +207,15 @@ test canvText-4.4 {ConfigureText procedure: construct cursor gc} {
     .c config -selectbackground red
     .c itemconfig test -just left
     update
-} {}
-test canvText-4.5 {ConfigureText procedure: adjust selection} {
+} -cleanup {
+	.c delete test
+} -result {}
+test canvText-4.5 {ConfigureText procedure: adjust selection} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
     set x {}
+} -body {
     .c itemconfig test -text "abcdefghi"
     .c select from test 2
     .c select to test 6
@@ -154,89 +234,276 @@ test canvText-4.5 {ConfigureText procedure: adjust selection} {
     lappend x [selection get]
     .c dchars test 4 end
     lappend x [selection get]
-} {cdefg 1 cdefg cd cdef cd}
-test canvText-4.6 {ConfigureText procedure: adjust cursor} {
+} -cleanup {
+	.c delete test
+} -result {cdefg 1 cdefg cd cdef cd}
+test canvText-4.6 {ConfigureText procedure: adjust cursor} -setup {
+	.c create text 20 20 -tag test
+} -body {
     .c itemconfig test -text "abcdefghi"
-    set x {}
     .c icursor test 6
     .c dchars test 4 end
     .c index test insert
-} {4}
+} -cleanup {
+	.c delete test
+} -result {4}
+
 
-test canvText-5.1 {ConfigureText procedure: adjust cursor} {
+test canvText-5.1 {ConfigureText procedure: adjust cursor} -body {
     .c create text 10 10 -tag x -fill blue -font "times 40" -stipple gray50 -text "xyz"
     .c delete x
-} {}
+} -result {}
+
 
-test canvText-6.1 {ComputeTextBbox procedure} {fonts nonPortable} {
+test canvText-6.1 {ComputeTextBbox procedure} -constraints {
+	fonts
+} -setup {
+	.c delete test
+} -body {
+	set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
+	set ay [font metrics $font -linespace]
+	set ax [font measure $font 0]
+
+	.c create text 0 0 -tag test
     .c itemconfig test -font $font -text 0
-    .c coords test 0 0
-    set x {}
-    lappend x [.c itemconfig test -anchor n; .c bbox test]
-    lappend x [.c itemconfig test -anchor nw; .c bbox test]
-    lappend x [.c itemconfig test -anchor w; .c bbox test]
-    lappend x [.c itemconfig test -anchor sw; .c bbox test]
-    lappend x [.c itemconfig test -anchor s; .c bbox test]
-    lappend x [.c itemconfig test -anchor se; .c bbox test]
-    lappend x [.c itemconfig test -anchor e; .c bbox test]
-    lappend x [.c itemconfig test -anchor ne; .c bbox test]
-    lappend x [.c itemconfig test -anchor center; .c bbox test]
-} "{[expr -$ax/2-1] 0 [expr $ax/2+1] $ay}\
-{-1 0 [expr $ax+1] $ay}\
-{-1 [expr -$ay/2] [expr $ax+1] [expr $ay/2]}\
-{-1 -$ay [expr $ax+1] 0}\
-{[expr -$ax/2-1] -$ay [expr $ax/2+1] 0}\
-{[expr -$ax-1] -$ay 1 0}\
-{[expr -$ax-1] [expr -$ay/2] 1 [expr $ay/2]}\
-{[expr -$ax-1] 0 1 $ay}\
-{[expr -$ax/2-1] [expr -$ay/2] [expr $ax/2+1] [expr $ay/2]}"
+    expr {[.c itemconfig test -anchor n; .c bbox test] \
+			eq "[expr -$ax/2-1] 0 [expr $ax/2+1] $ay"}
+} -cleanup {
+	.c delete test
+} -result 1
+test canvText-6.2 {ComputeTextBbox procedure} -constraints {
+	fonts
+} -setup {
+	.c delete test
+} -body {
+	set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
+	set ay [font metrics $font -linespace]
+	set ax [font measure $font 0]
+
+	.c create text 0 0 -tag test
+    .c itemconfig test -font $font -text 0
+    expr {[.c itemconfig test -anchor nw; .c bbox test] \
+			eq "-1 0 [expr $ax+1] $ay"}
+} -cleanup {
+	.c delete test
+} -result 1
+test canvText-6.3 {ComputeTextBbox procedure} -constraints {
+	fonts
+} -setup {
+	.c delete test
+} -body {
+	set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
+	set ay [font metrics $font -linespace]
+	set ax [font measure $font 0]
+
+	.c create text 0 0 -tag test
+    .c itemconfig test -font $font -text 0
+    expr {[.c itemconfig test -anchor w; .c bbox test] \
+			eq "-1 [expr -$ay/2] [expr $ax+1] [expr $ay/2]"}
+} -cleanup {
+	.c delete test
+} -result 1
+test canvText-6.4 {ComputeTextBbox procedure} -constraints {
+	fonts
+} -setup {
+	.c delete test
+} -body {
+	set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
+	set ay [font metrics $font -linespace]
+	set ax [font measure $font 0]
+
+	.c create text 0 0 -tag test
+    .c itemconfig test -font $font -text 0
+    expr {[.c itemconfig test -anchor sw; .c bbox test] \
+			eq "-1 -$ay [expr $ax+1] 0"}
+} -cleanup {
+	.c delete test
+} -result 1
+test canvText-6.5 {ComputeTextBbox procedure} -constraints {
+	fonts
+} -setup {
+	.c delete test
+} -body {
+	set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
+	set ay [font metrics $font -linespace]
+	set ax [font measure $font 0]
+
+	.c create text 0 0 -tag test
+    .c itemconfig test -font $font -text 0
+    expr {[.c itemconfig test -anchor s; .c bbox test] \
+			eq "[expr -$ax/2-1] -$ay [expr $ax/2+1] 0"}
+} -cleanup {
+	.c delete test
+} -result 1
+test canvText-6.6 {ComputeTextBbox procedure} -constraints {
+	fonts
+} -setup {
+	.c delete test
+} -body {
+	set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
+	set ay [font metrics $font -linespace]
+	set ax [font measure $font 0]
+
+	.c create text 0 0 -tag test
+    .c itemconfig test -font $font -text 0
+    expr {[.c itemconfig test -anchor se; .c bbox test] \
+			eq "[expr -$ax-1] -$ay 1 0"}
+} -cleanup {
+	.c delete test
+} -result 1
+test canvText-6.7 {ComputeTextBbox procedure} -constraints {
+	fonts
+} -setup {
+	.c delete test
+} -body {
+	set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
+	set ay [font metrics $font -linespace]
+	set ax [font measure $font 0]
+
+	.c create text 0 0 -tag test
+    .c itemconfig test -font $font -text 0
+    expr {[.c itemconfig test -anchor e; .c bbox test]\
+			eq "[expr -$ax-1] [expr -$ay/2] 1 [expr $ay/2]"}
+} -cleanup {
+	.c delete test
+} -result 1
+test canvText-6.8 {ComputeTextBbox procedure} -constraints {
+	fonts
+} -setup {
+	.c delete test
+} -body {
+	set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
+	set ay [font metrics $font -linespace]
+	set ax [font measure $font 0]
+
+	.c create text 0 0 -tag test
+    .c itemconfig test -font $font -text 0
+    expr {[.c itemconfig test -anchor ne; .c bbox test] \
+			eq "[expr -$ax-1] 0 1 $ay"}
+} -cleanup {
+	.c delete test
+} -result 1
+test canvText-6.9 {ComputeTextBbox procedure} -constraints {
+	fonts
+} -setup {
+	.c delete test
+} -body {
+	set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
+	set ay [font metrics $font -linespace]
+	set ax [font measure $font 0]
+
+	.c create text 0 0 -tag test
+    .c itemconfig test -font $font -text 0
+    expr {[.c itemconfig test -anchor center; .c bbox test] \
+			eq "[expr -$ax/2-1] [expr -$ay/2] [expr $ax/2+1] [expr $ay/2]"}
+} -cleanup {
+	.c delete test
+} -result 1
 
+
+#.c delete test
+#.c create text 20 20 -tag test
+#focus -force .c
+#.c focus test
 focus .c
 .c focus test
 .c itemconfig test -text "abcd\nefghi\njklmnopq"
-test canvText-7.0 {DisplayText procedure: stippling} {
+test canvText-7.1 {DisplayText procedure: stippling} -body {
+	.c create text 20 20 -tag test
     .c itemconfig test -stipple gray50
     update
     .c itemconfig test -stipple {}
     update
-} {}
-test canvText-7.2 {DisplayText procedure: draw selection} {
+} -cleanup {
+	.c delete test
+} -result {}
+test canvText-7.2 {DisplayText procedure: draw selection} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
+	.c itemconfig test -text "abcd\nefghi\njklmnopq"
     .c select from test 0
     .c select to test end
     update
     selection get
-} "abcd\nefghi\njklmnopq"
-test canvText-7.3 {DisplayText procedure: selection} {
+} -cleanup {
+	.c delete test
+} -result "abcd\nefghi\njklmnopq"
+test canvText-7.3 {DisplayText procedure: selection} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
+	.c itemconfig test -text "abcd\nefghi\njklmnopq"
     .c select from test 0
     .c select to test end
     update
     selection get
-} "abcd\nefghi\njklmnopq"
-test canvText-7.4 {DisplayText procedure: one line selection} {
+} -cleanup {
+	.c delete test
+} -result "abcd\nefghi\njklmnopq"
+test canvText-7.4 {DisplayText procedure: one line selection} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
+	.c itemconfig test -text "abcd\nefghi\njklmnopq"
     .c select from test 2
     .c select to test 3
     update
-} {}
-test canvText-7.5 {DisplayText procedure: multi-line selection} {
+} -cleanup {
+	.c delete test
+} -result {}
+test canvText-7.5 {DisplayText procedure: multi-line selection} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
+	.c itemconfig test -text "abcd\nefghi\njklmnopq"
     .c select from test 2
     .c select to test 12
     update
-} {}
-test canvText-7.6 {DisplayText procedure: draw cursor} {
+} -cleanup {
+	.c delete test
+} -result {}
+test canvText-7.6 {DisplayText procedure: draw cursor} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
+	.c itemconfig test -text "abcd\nefghi\njklmnopq"
     .c icursor test 3
     update
-} {}
-test canvText-7.7 {DisplayText procedure: selected text different color} {
+} -cleanup {
+	.c delete test
+} -result {}
+test canvText-7.7 {DisplayText procedure: selected text different color} -setup {
+	.c create text 20 20 -tag test
+	.c itemconfig test -text "abcd\nefghi\njklmnopq"
+	focus .c
+	.c focus test
+} -body {
     .c config -selectforeground blue
     .c itemconfig test -anchor n
     update
-} {}
-test canvText-7.8 {DisplayText procedure: not selected} {
+} -cleanup {
+	.c delete test
+} -result {}
+test canvText-7.8 {DisplayText procedure: not selected} -setup {
+	.c create text 20 20 -tag test
+	.c itemconfig test -text "abcd\nefghi\njklmnopq"
+	focus .c
+	.c focus test
+} -body {
     .c select clear
     update
-} {}
-test canvText-7.9 {DisplayText procedure: select end} {
-    catch {destroy .t}
+} -cleanup {
+	.c delete test
+} -result {}
+test canvText-7.9 {DisplayText procedure: select end} -setup {
+	destroy .t
+} -body {
     toplevel .t
     wm geometry .t +0+0
     canvas .t.c
@@ -248,244 +515,348 @@ test canvText-7.9 {DisplayText procedure: select end} {
     update
     #catch {destroy .t}
     update
-} {}
-
-test canvText-8.1 {TextInsert procedure: 0 length insert} {
+} -cleanup {
+	destroy .t
+} -result {}
+
+test canvText-8.1 {TextInsert procedure: 0 length insert} -setup {
+	.c create text 20 20 -tag test
+	.c itemconfig test -text "abcd\nefghi\njklmnopq"
+	focus .c
+	.c focus test
+} -body {
     .c insert test end {}
-} {}
-test canvText-8.2 {TextInsert procedure: before beginning/after end} {
+} -cleanup {
+	.c delete test
+} -result {}
+test canvText-8.2 {TextInsert procedure: before beginning/after end} -body {
     # Can't test this because GetTextIndex filters out those numbers.
-} {}
-test canvText-8.3 {TextInsert procedure: inserting in a selected item} {
+} -result {}
+test canvText-8.3 {TextInsert procedure: inserting in a selected item} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
     .c itemconfig test -text "abcdefg"
     .c select from test 2
     .c select to test 4
     .c insert test 1 "xyz"
     .c itemcget test -text
-} {axyzbcdefg}
-test canvText-8.4 {TextInsert procedure: inserting before selection} {
+} -result {axyzbcdefg}
+test canvText-8.4 {TextInsert procedure: inserting before selection} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
     .c itemconfig test -text "abcdefg"
     .c select from test 2
     .c select to test 4
     .c insert test 1 "xyz"
     list [.c index test sel.first] [.c index test sel.last]
-} {5 7}
-test canvText-8.5 {TextInsert procedure: inserting in selection} {
+} -result {5 7}
+test canvText-8.5 {TextInsert procedure: inserting in selection} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
     .c itemconfig test -text "abcdefg"
     .c select from test 2
     .c select to test 4
     .c insert test 3 "xyz"
     list [.c index test sel.first] [.c index test sel.last]
-} {2 7}
-test canvText-8.6 {TextInsert procedure: inserting after selection} {
+} -result {2 7}
+test canvText-8.6 {TextInsert procedure: inserting after selection} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
     .c itemconfig test -text "abcdefg"
     .c select from test 2
     .c select to test 4
     .c insert test 5 "xyz"
     list [.c index test sel.first] [.c index test sel.last]
-} {2 4}
-test canvText-8.7 {TextInsert procedure: inserting in unselected item} {
+} -result {2 4}
+test canvText-8.7 {TextInsert procedure: inserting in unselected item} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
     .c itemconfig test -text "abcdefg"
     .c select clear
     .c insert test 5 "xyz"
     .c itemcget test -text
-} {abcdexyzfg}
-test canvText-8.8 {TextInsert procedure: inserting before cursor} {
+} -result {abcdexyzfg}
+test canvText-8.8 {TextInsert procedure: inserting before cursor} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
     .c itemconfig test -text "abcdefg"
     .c icursor test 3
     .c insert test 2 "xyz"
     .c index test insert
-} {6}
-test canvText-8.9 {TextInsert procedure: inserting after cursor} {
+} -result {6}
+test canvText-8.9 {TextInsert procedure: inserting after cursor} -setup {
+	.c create text 20 20 -tag test
+	focus .c
+	.c focus test
+} -body {
     .c itemconfig test -text "abcdefg"
     .c icursor test 3
     .c insert test 4 "xyz"
     .c index test insert
-} {3}
+} -result {3}
 
-test canvText-9.1 {TextInsert procedure: before beginning/after end} {
+# Item used in 9.* tests
+.c create text 20 20 -tag test
+test canvText-9.1 {TextInsert procedure: before beginning/after end} -body {
     # Can't test this because GetTextIndex filters out those numbers.
-} {}
-test canvText-9.2 {TextInsert procedure: start > end} {
+} -result {}
+test canvText-9.2 {TextInsert procedure: start > end} -body {
     .c itemconfig test -text "abcdefg"
     .c dchars test 4 2
     .c itemcget test -text
-} {abcdefg}
-test canvText-9.3 {TextInsert procedure: deleting from a selected item} {
+} -result {abcdefg}
+test canvText-9.3 {TextInsert procedure: deleting from a selected item} -body {
     .c itemconfig test -text "abcdefg"
     .c select from test 2
     .c select to test 4
     .c dchars test 3 5
     .c itemcget test -text
-} {abcg}
-test canvText-9.4 {TextInsert procedure: deleting before start} {
+} -result {abcg}
+test canvText-9.4 {TextInsert procedure: deleting before start} -body {
     .c itemconfig test -text "abcdefghijk"
     .c select from test 4
     .c select to test 8
     .c dchars test 1 1
     list [.c index test sel.first] [.c index test sel.last]
-} {3 7}
-test canvText-9.5 {TextInsert procedure: keep start > first char deleted} {
+} -result {3 7}
+test canvText-9.5 {TextInsert procedure: keep start > first char deleted} -body {
     .c itemconfig test -text "abcdefghijk"
     .c select from test 4
     .c select to test 8
     .c dchars test 2 6
     list [.c index test sel.first] [.c index test sel.last]
-} {2 3}
-test canvText-9.6 {TextInsert procedure: deleting inside selection} {
+} -result {2 3}
+test canvText-9.6 {TextInsert procedure: deleting inside selection} -body {
     .c itemconfig test -text "abcdefghijk"
     .c select from test 4
     .c select to test 8
     .c dchars test 6 6
     list [.c index test sel.first] [.c index test sel.last]
-} {4 7}
-test canvText-9.7 {TextInsert procedure: keep end > first char deleted} {
+} -result {4 7}
+test canvText-9.7 {TextInsert procedure: keep end > first char deleted} -body {
     .c itemconfig test -text "abcdefghijk"
     .c select from test 4
     .c select to test 8
     .c dchars test 6 10
     list [.c index test sel.first] [.c index test sel.last]
-} {4 5}
-test canvText-9.8 {TextInsert procedure: selectFirst > selectLast: deselect} {
+} -result {4 5}
+test canvText-9.8 {TextInsert procedure: selectFirst > selectLast: deselect} -body {
     .c itemconfig test -text "abcdefghijk"
     .c select from test 4
     .c select to test 8
     .c dchars test 3 10
-    list [catch {.c index test sel.first} msg] $msg
-} {1 {selection isn't in item}}
-test canvText-9.9 {TextInsert procedure: selectFirst <= selectLast} {
+    .c index test sel.first
+} -returnCodes {error} -result {selection isn't in item}
+test canvText-9.9 {TextInsert procedure: selectFirst <= selectLast} -body {
     .c itemconfig test -text "abcdefghijk"
     .c select from test 4
     .c select to test 8
     .c dchars test 4 7
     list [.c index test sel.first] [.c index test sel.last]
-} {4 4}
-test canvText-9.10 {TextInsert procedure: move anchor} {
+} -result {4 4}
+test canvText-9.10 {TextInsert procedure: move anchor} -body {
     .c itemconfig test -text "abcdefghijk"
     .c select from test 6
     .c select to test 8
     .c dchars test 2 4
     .c select to test 1
     list [.c index test sel.first] [.c index test sel.last]
-} {1 2}
-test canvText-9.11 {TextInsert procedure: keep anchor >= first} {
+} -result {1 2}
+test canvText-9.11 {TextInsert procedure: keep anchor >= first} -body {
     .c itemconfig test -text "abcdefghijk"
     .c select from test 6
     .c select to test 8
     .c dchars test 5 7
     .c select to test 1
     list [.c index test sel.first] [.c index test sel.last]
-} {1 4}
-test canvText-9.12 {TextInsert procedure: anchor doesn't move} {
+} -result {1 4}
+test canvText-9.12 {TextInsert procedure: anchor doesn't move} -body {
     .c itemconfig test -text "abcdefghijk"
     .c select from test 2
     .c select to test 5
     .c dchars test 6 8
     .c select to test 8
     list [.c index test sel.first] [.c index test sel.last]
-} {2 8}
-test canvText-9.13 {TextInsert procedure: move cursor} {
+} -result {2 8}
+test canvText-9.13 {TextInsert procedure: move cursor} -body {
     .c itemconfig test -text "abcdefghijk"
     .c icursor test 6
     .c dchars test 2 4
     .c index test insert
-} {3}
-test canvText-9.14 {TextInsert procedure: keep cursor >= first} {
+} -result {3}
+test canvText-9.14 {TextInsert procedure: keep cursor >= first} -body {
     .c itemconfig test -text "abcdefghijk"
     .c icursor test 6
     .c dchars test 2 10
     .c index test insert
-} {2}
-test canvText-9.15 {TextInsert procedure: cursor doesn't move} {
+} -result {2}
+test canvText-9.15 {TextInsert procedure: cursor doesn't move} -body {
     .c itemconfig test -text "abcdefghijk"
     .c icursor test 5
     .c dchars test 7 9
     .c index test insert
-} {5}
+} -result {5}
+.c delete test
+
 
-test canvText-10.1 {TextToPoint procedure} {
-    .c coords test 0 0
+test canvText-10.1 {TextToPoint procedure} -body {
+	.c create text 0 0 -tag test
     .c itemconfig test -text 0 -anchor center
     .c index test @0,0
-} {0}
+} -cleanup {
+	.c delete test
+} -result {0}
+
 
-test canvText-11.1 {TextToArea procedure} {
-    .c coords test 0 0
+test canvText-11.1 {TextToArea procedure} -setup {
+	.c create text 0 0 -tag test
+	focus .c
+	.c focus test
+} -body {    
     .c itemconfig test -text 0 -anchor center
-    .c find overlapping 0 0 1 1
-} [.c find withtag test]
-test canvText-11.2 {TextToArea procedure} {
-    .c coords test 0 0
+	set res1 [.c find overlapping 0 0 1 1]
+	set res2 [.c find withtag test]
+	expr {$res1 eq $res2}
+} -cleanup {
+	.c delete test
+} -result 1
+test canvText-11.2 {TextToArea procedure} -setup {
+	.c create text 0 0 -tag test
+	focus .c
+	.c focus test
+} -body {    
     .c itemconfig test -text 0 -anchor center
     .c find overlapping 1000 1000 1001 1001
-} {}
+} -cleanup {
+	.c delete test
+} -result {}
 
-test canvText-12.1 {ScaleText procedure} {
-    .c coords test 100 100
+
+test canvText-12.1 {ScaleText procedure} -body {
+	.c create text 100 100 -tag test
     .c scale all 50 50 2 2
     .c coords test
-} {150.0 150.0}
+} -cleanup {
+	.c delete test
+} -result {150.0 150.0}
+
 
-test canvText-13.1 {TranslateText procedure} {
-    .c coords test 100 100
+test canvText-13.1 {TranslateText procedure} -body {
+	.c create text 100 100 -tag test
     .c move all 10 10
     .c coords test
-} {110.0 110.0}
-
-.c itemconfig test -text "abcdefghijklmno" -anchor nw
-.c select from test 5
-.c select to test 8
-.c icursor test 12
-.c coords test 0 0
-test canvText-14.1 {GetTextIndex procedure} {
+} -cleanup {
+	.c delete test
+} -result {110.0 110.0}
+
+
+test canvText-14.1 {GetTextIndex procedure} -setup {
+	.c create text 0 0 -tag test
+	focus .c
+	.c focus test
+} -body {    
+	.c itemconfig test -text "abcdefghijklmno" -anchor nw
+	.c select from test 5
+	.c select to test 8
+	.c icursor test 12
+	.c coords test 0 0
+
     list [.c index test end] [.c index test insert] \
 	[.c index test sel.first] [.c index test sel.last] \
 	[.c index test @0,0] \
 	[.c index test -1] [.c index test 10] [.c index test 100]
-} {15 12 5 8 0 0 10 15}
-test canvText-14.2 {GetTextIndex procedure: select error} {
+} -cleanup {
+	.c delete test
+} -result {15 12 5 8 0 0 10 15}
+test canvText-14.2 {GetTextIndex procedure: select error} -setup {
+	.c create text 0 0 -tag test
+	focus .c
+	.c focus test
+} -body {    
     .c select clear
-    list [catch {.c index test sel.first} msg] $msg
-} {1 {selection isn't in item}}
-test canvText-14.3 {GetTextIndex procedure: select error} {
+    .c index test sel.first
+} -cleanup {
+	.c delete test
+} -returnCodes {error} -result {selection isn't in item}
+test canvText-14.3 {GetTextIndex procedure: select error} -setup {
+	.c create text 0 0 -tag test
+	focus .c
+	.c focus test
+} -body {    
     .c select clear
-    list [catch {.c index test sel.last} msg] $msg
-} {1 {selection isn't in item}}
-test canvText-14.4 {GetTextIndex procedure: select error} {
+    .c index test sel.last
+} -cleanup {
+	.c delete test
+} -returnCodes {error} -result {selection isn't in item}
+test canvText-14.4 {GetTextIndex procedure: select error} -setup {
+	.c create text 0 0 -tag test
+	focus .c
+	.c focus test
+} -body {    
     .c select clear
-    list [catch {.c index test sel.} msg] $msg
-} {1 {bad index "sel."}}
-test canvText-14.5 {GetTextIndex procedure: bad int or unknown index} {
-    list [catch {.c index test xyz} msg] $msg
-} {1 {bad index "xyz"}}
-
-test canvText-15.1 {SetTextCursor procedure} {
+    .c index test sel.
+} -cleanup {
+	.c delete test
+} -returnCodes {error} -result {bad index "sel."}
+test canvText-14.5 {GetTextIndex procedure: bad int or unknown index} -setup {
+	.c create text 0 0 -tag test
+	focus .c
+	.c focus test
+} -body {    
+    .c index test xyz
+} -cleanup {
+	.c delete test
+} -returnCodes {error} -result {bad index "xyz"}
+
+
+test canvText-15.1 {SetTextCursor procedure} -setup {
+	.c create text 0 0 -tag test
+	focus .c
+	.c focus test
+} -body {    
+	.c itemconfig test -text "abcdefghijklmno" -anchor nw
     .c itemconfig -text "abcdefg"
     .c icursor test 3
     .c index test insert
-} {3}
+} -cleanup {
+	.c delete test
+} -result {3}
 
-test canvText-16.1 {GetSelText procedure} {
+
+test canvText-16.1 {GetSelText procedure} -setup {
+	.c create text 0 0 -tag test
+	focus .c
+	.c focus test
+} -body {    
     .c itemconfig test -text "abcdefghijklmno" -anchor nw
     .c select from test 5
     .c select to test 8
     selection get
-} {fghi}
+} -cleanup {
+	.c delete test
+} -result {fghi}
 
-set font {Courier 12 italic}
-set ax [font measure $font 0]
-set ay [font metrics $font -linespace]
 
-test canvText-17.1 {TextToPostscript procedure} {
+test canvText-17.1 {TextToPostscript procedure} -setup {
     .c delete all
-    .c config -height 300 -highlightthickness 0 -bd 0
-    update
-    .c create text 100 100 -tags test
-    .c itemconfig test -font $font -text "00000000" -width [expr 3*$ax]
-    .c itemconfig test -anchor n -fill black
-    set x [.c postscript]
-    set x [string range $x [string first "/Courier-Oblique" $x] end]
-} "/Courier-Oblique findfont [font actual $font -size] scalefont ISOEncode setfont
+} -body {
+	set font {Courier 12 italic}
+	set ax [font measure $font 0]
+	set ay [font metrics $font -linespace]
+
+	set result "/Courier-Oblique findfont [font actual $font -size] scalefont ISOEncode setfont
 0.000 0.000 0.000 setrgbcolor AdjustColor
 100 200 \[
 \[(000)\]
@@ -499,23 +870,35 @@ restore showpage
 end
 %%EOF
 "
+    .c config -height 300 -highlightthickness 0 -bd 0
+    update
+    .c create text 100 100 -tags test
+    .c itemconfig test -font $font -text "00000000" -width [expr 3*$ax]
+    .c itemconfig test -anchor n -fill black
+    set x [.c postscript]
+    set x [string range $x [string first "/Courier-Oblique" $x] end]
+	expr {$x eq $result}
+} -result 1
 
-test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} {
-    catch {destroy .c}
-    canvas .c
-    pack .c
-    .c delete all
+test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} -setup {
+    destroy .c
+} -body {
+    pack [canvas .c]
     .c create text 100 100 -text Hello\n -anchor nw
     set bbox [.c bbox 1]
     set x2 [lindex $bbox 2]
     set y2 [lindex $bbox 3]
     incr y2
     update
-    .c find enclosed 99 99 [expr $x2 + $i] [expr $y2 + 1]
-} 1
+    .c find enclosed 99 99 [expr $x2 + 1] [expr $y2 + 1]
+} -cleanup {
+	destroy .c
+} -result 1
+
 
-test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} {
-    catch {destroy .c}
+test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} -setup {
+    destroy .c
+} -body {
     set c [canvas .c -bg black -width 964]
     pack $c
     $c delete all
@@ -565,10 +948,15 @@ test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} {
     lappend results [$c index tbox1 @$x,$y1]
     lappend results [$c index tbox2 @$x,$y2]
 
-    set results
-} {{Yeah } Yeah- 4 4}
+    return $results
+} -cleanup {
+	destroy .c
+} -result {{Yeah } Yeah- 4 4}
 
 
 # cleanup
 cleanupTests
 return
+
+
+