From 3e1853a0a7548512056eb08a8b4916ec2f683ee6 Mon Sep 17 00:00:00 2001
From: aniap <aniap>
Date: Fri, 8 Aug 2008 17:46:38 +0000
Subject: Update to tcltest2

---
 ChangeLog         |   5 +
 tests/canvas.test | 530 ++++++++++++++++++++++++++++++++++++++++--------------
 2 files changed, 399 insertions(+), 136 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index cea922e..f014bf1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 2008-08-07  Ania Pawelczyk  <aniap@users.sourceforge.net>
 
+	* test/canvas.test: Update to tcltest2
+
+2008-08-07  Ania Pawelczyk  <aniap@users.sourceforge.net>
+
 	* test/canvPs.test: Update to tcltest2
 	* test/config.test  
 
@@ -25,6 +29,7 @@
 
 	* generic/tk.h: Added missing EXTERN for the Tcl_PkgInitStubsCheck
 	declaration to fix inability to embed non-stub-enabled Tk on Windows.
+	
 2008-07-29  Ania Pawelczyk  <aniap@users.sourceforge.net>
 
 	* test/constraints.tcl: -highlightthickness entry's option
diff --git a/tests/canvas.test b/tests/canvas.test
index 200fe55..1c95dc7 100644
--- a/tests/canvas.test
+++ b/tests/canvas.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-2000 Ajuba Solutions.
 # All rights reserved.
 #
-# RCS: @(#) $Id: canvas.test,v 1.24 2008/07/23 23:24:26 nijtmans Exp $
+# RCS: @(#) $Id: canvas.test,v 1.25 2008/08/08 17:46:38 aniap Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -15,83 +15,222 @@ tcltest::loadTestedCommands
 # XXX - This test file is woefully incomplete.  At present, only a
 # few of the features are tested.
 
+# Canvas used in 1.* test cases
 canvas .c
 pack .c
 update
-set i 1
-foreach {testname testinfo} {
-    canvas-1.1 {-background #ff0000 #ff0000
-	non-existent {unknown color name "non-existent"}}
-    canvas-1.2 {-bg #ff0000 #ff0000
-	non-existent {unknown color name "non-existent"}}
-    canvas-1.3 {-bd 4 4 badValue {bad screen distance "badValue"}}
-    canvas-1.4 {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
-    canvas-1.5 {-closeenough 24 24.0
-	bogus {expected floating-point number but got "bogus"}}
-    canvas-1.6 {-confine true 1 silly {expected boolean value but got "silly"}}
-    canvas-1.7 {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
-    canvas-1.8 {-height 2.1 2 x42 {bad screen distance "x42"}}
-    canvas-1.9 {-highlightbackground #112233 #112233
-	ugly {unknown color name "ugly"}}
-    canvas-1.10 {-highlightcolor #110022 #110022
-	bogus {unknown color name "bogus"}}
-    canvas-1.11 {-highlightthickness 18 18
-	badValue {bad screen distance "badValue"}}
-    canvas-1.12 {-insertbackground #110022 #110022
-	bogus {unknown color name "bogus"}}
-    canvas-1.13 {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}}
-    canvas-1.14 {-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
-    canvas-1.15 {-insertontime 100 100 3.2 {expected integer but got "3.2"}}
-    canvas-1.16 {-insertwidth 1.3 1 6x {bad screen distance "6x"}}
-    canvas-1.17 {-relief groove groove
-	1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
-    canvas-1.18 {-selectbackground #110022 #110022
-	bogus {unknown color name "bogus"}}
-    canvas-1.19 {-selectborderwidth 1.3 1
-	badValue {bad screen distance "badValue"}}
-    canvas-1.20 {-selectforeground #654321 #654321
-	bogus {unknown color name "bogus"}}
-    canvas-1.21 {-takefocus "any string" "any string" {} {}}
-    canvas-1.22 {-width 402 402 xyz {bad screen distance "xyz"}}
-    canvas-1.23 {-xscrollcommand {Some command} {Some command} {} {}}
-    canvas-1.24 {-yscrollcommand {Another command} {Another command} {} {}}
-} {
-    lassign $testinfo name goodValue goodResult badValue badResult
-    test $testname-good "configuration options: good value for $name" {
-	.c configure $name $goodValue
-	lindex [.c configure $name] 4
-    } $goodResult
-    incr i
-    if {$badValue ne ""} {
-	test $testname-bad "configuration options: bad value for $name" -body {
-	    .c configure $name $badValue
-	} -returnCodes error -result $badResult
-    }
-    .c configure $name [lindex [.c configure $name] 3]
-    incr i
-}
-test canvas-1.25 {configure throws error on bad option} {
-    set res [list [catch {.c configure -gorp foo}]]
-    .c create rect 10 10 100 100
-    lappend res [catch {.c configure -gorp foo}]
-    set res
-} [list 1 1]
+test canvas-1.1 {configuration options: good value for "background"} -body {
+    .c configure -background #ff0000
+    .c cget -background
+} -result {#ff0000}
+test canvas-1.2 {configuration options: bad value for "background"} -body {
+    .c configure -background non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+
+test canvas-1.3 {configuration options: good value for "bg"} -body {
+    .c configure -bg #ff0000
+    .c cget -bg
+} -result {#ff0000}
+test canvas-1.4 {configuration options: bad value for "bg"} -body {
+    .c configure -bg non-existent
+} -returnCodes error -result {unknown color name "non-existent"}
+
+test canvas-1.5 {configuration options: good value for "bd"} -body {
+    .c configure -bd 4
+    .c cget -bd
+} -result {4}
+test canvas-1.6 {configuration options: bad value for "bd"} -body {
+    .c configure -bd badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+
+test canvas-1.7 {configuration options: good value for "borderwidth"} -body {
+    .c configure -borderwidth 1.3
+    .c cget -borderwidth
+} -result {1}
+test canvas-1.8 {configuration options: bad value for "borderwidth"} -body {
+    .c configure -borderwidth badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+
+test canvas-1.9 {configuration options: good value for "closeenough"} -body {
+    .c configure -closeenough 24
+    .c cget -closeenough
+} -result {24.0}
+test canvas-1.10 {configuration options: bad value for "closeenough"} -body {
+    .c configure -closeenough bogus
+} -returnCodes error -result {expected floating-point number but got "bogus"}
+
+test canvas-1.11 {configuration options: good value for "confine"} -body {
+    .c configure -confine true
+    .c cget -confine
+} -result {1}
+test canvas-1.12 {configuration options: bad value for "confine"} -body {
+    .c configure -confine silly
+} -returnCodes error -result {expected boolean value but got "silly"}
+
+test canvas-1.13 {configuration options: good value for "cursor"} -body {
+    .c configure -cursor arrow
+    .c cget -cursor
+} -result {arrow}
+test canvas-1.14 {configuration options: bad value for "cursor"} -body {
+    .c configure -cursor badValue
+} -returnCodes error -result {bad cursor spec "badValue"}
+
+test canvas-1.15 {configuration options: good value for "height"} -body {
+    .c configure -height 2.1
+    .c cget -height
+} -result {2}
+test canvas-1.16 {configuration options: bad value for "height"} -body {
+    .c configure -height x42
+} -returnCodes error -result {bad screen distance "x42"}
+
+test canvas-1.17 {configuration options: good value for "highlightbackground"} -body {
+    .c configure -highlightbackground #112233
+    .c cget -highlightbackground
+} -result {#112233}
+test canvas-1.18 {configuration options: bad value for "highlightbackground"} -body {
+    .c configure -highlightbackground ugly
+} -returnCodes error -result {unknown color name "ugly"}
+
+test canvas-1.19 {configuration options: good value for "highlightcolor"} -body {
+    .c configure -highlightcolor #110022
+    .c cget -highlightcolor
+} -result {#110022}
+test canvas-1.20 {configuration options: bad value for "highlightcolor"} -body {
+    .c configure -highlightcolor bogus
+} -returnCodes error -result {unknown color name "bogus"}
+
+test canvas-1.21 {configuration options: good value for "highlightthickness"} -body {
+    .c configure -highlightthickness 18
+    .c cget -highlightthickness
+} -result {18}
+test canvas-1.22 {configuration options: bad value for "highlightthickness"} -body {
+    .c configure -highlightthickness badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+
+test canvas-1.23 {configuration options: good value for "insertbackground"} -body {
+    .c configure -insertbackground #110022
+    .c cget -insertbackground
+} -result {#110022}
+test canvas-1.24 {configuration options: bad value for "insertbackground"} -body {
+    .c configure -insertbackground bogus
+} -returnCodes error -result {unknown color name "bogus"}
+
+test canvas-1.25 {configuration options: good value for "insertborderwidth"} -body {
+    .c configure -insertborderwidth 1.3
+    .c cget -insertborderwidth
+} -result {1}
+test canvas-1.26 {configuration options: bad value for "insertborderwidth"} -body {
+    .c configure -insertborderwidth 2.6x
+} -returnCodes error -result {bad screen distance "2.6x"}
+
+test canvas-1.27 {configuration options: good value for "insertofftime"} -body {
+    .c configure -insertofftime 100
+    .c cget -insertofftime
+} -result {100}
+test canvas-1.28 {configuration options: bad value for "insertofftime"} -body {
+    .c configure -insertofftime 3.2
+} -returnCodes error -result {expected integer but got "3.2"}
 
+test canvas-1.29 {configuration options: good value for "insertontime"} -body {
+    .c configure -insertontime 100
+    .c cget -insertontime
+} -result {100}
+test canvas-1.30 {configuration options: bad value for "insertontime"} -body {
+    .c configure -insertontime 3.2
+} -returnCodes error -result {expected integer but got "3.2"}
+
+test canvas-1.31 {configuration options: good value for "insertwidth"} -body {
+    .c configure -insertwidth 1.3
+    .c cget -insertwidth
+} -result {1}
+test canvas-1.32 {configuration options: bad value for "insertwidth"} -body {
+    .c configure -insertwidth 6x
+} -returnCodes error -result {bad screen distance "6x"}
+
+test canvas-1.33 {configuration options: good value for "relief"} -body {
+    .c configure -relief groove
+    .c cget -relief
+} -result {groove}
+test canvas-1.34 {configuration options: bad value for "relief"} -body {
+    .c configure -relief 1.5
+} -returnCodes error -result {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}
+
+test canvas-1.35 {configuration options: good value for "selectbackground"} -body {
+    .c configure -selectbackground #110022
+    .c cget -selectbackground
+} -result {#110022}
+test canvas-1.36 {configuration options: bad value for "selectbackground"} -body {
+    .c configure -selectbackground bogus
+} -returnCodes error -result {unknown color name "bogus"}
+
+test canvas-1.37 {configuration options: good value for "selectborderwidth"} -body {
+    .c configure -selectborderwidth 1.3
+    .c cget -selectborderwidth
+} -result {1}
+test canvas-1.38 {configuration options: bad value for "selectborderwidth"} -body {
+    .c configure -selectborderwidth badValue
+} -returnCodes error -result {bad screen distance "badValue"}
+
+test canvas-1.39 {configuration options: good value for "selectforeground"} -body {
+    .c configure -selectforeground #654321
+    .c cget -selectforeground
+} -result {#654321}
+test canvas-1.40 {configuration options: bad value for "selectforeground"} -body {
+    .c configure -selectforeground bogus
+} -returnCodes error -result {unknown color name "bogus"}
+
+test canvas-1.41 {configuration options: good value for "takefocus"} -body {
+    .c configure -takefocus "any string"
+    .c cget -takefocus
+} -result {any string}
+
+test canvas-1.42 {configuration options: good value for "width"} -body {
+    .c configure -width 402
+    .c cget -width
+} -result {402}
+test canvas-1.43 {configuration options: bad value for "width"} -body {
+    .c configure -width xyz
+} -returnCodes error -result {bad screen distance "xyz"}
+
+test canvas-1.44 {configuration options: good value for "xscrollcommand"} -body {
+    .c configure -xscrollcommand {Some command}
+    .c cget -xscrollcommand
+} -result {Some command}
+
+test canvas-1.45 {configuration options: good value for "yscrollcommand"} -body {
+    .c configure -yscrollcommand {Another command}
+    .c cget -yscrollcommand
+} -result {Another command}
+
+test canvas-1.46 {configure throws error on bad option} -body {
+    .c configure -gorp foo
+} -returnCodes error -match glob -result {*}
+test canvas-1.47 {configure throws error on bad option} -body {
+    catch {.c configure -gorp foo}
+    .c create rect 10 10 100 100
+    .c configure -gorp foo
+} -returnCodes error -match glob -result {*}
 catch {destroy .c}
+
+
+# Canvas used in 2.* test cases
 canvas .c -width 60 -height 40 -scrollregion {0 0 200 150} -bd 0 \
 	-highlightthickness 0
 pack .c
 update
-
-test canvas-2.1 {CanvasWidgetCmd, bind option} {
+test canvas-2.1 {CanvasWidgetCmd, bind option} -body {
     set i [.c create rect 10 10 100 100]
-    list [catch {.c bind $i <a>} msg] $msg
-} {0 {}}
-test canvas-2.2 {CanvasWidgetCmd, bind option} {
+    .c bind $i <a>
+} -cleanup {
+	.c delete $i
+} -returnCodes ok
+test canvas-2.2 {CanvasWidgetCmd, bind option} -body {
     set i [.c create rect 10 10 100 100]
-    list [catch {.c bind $i <} msg] $msg
-} {1 {no event type or button # or keysym}}
-test canvas-2.3 {CanvasWidgetCmd, xview option} {
+    .c bind $i <
+} -cleanup {
+	.c delete $i
+} -returnCodes error -result {no event type or button # or keysym}
+test canvas-2.3 {CanvasWidgetCmd, xview option} -body {
     .c configure -xscrollincrement 40 -yscrollincrement 5
     .c xview moveto 0
     update
@@ -99,8 +238,8 @@ test canvas-2.3 {CanvasWidgetCmd, xview option} {
     .c xview scroll 2 units
     update
     lappend x [.c xview]
-} {{0.0 0.3} {0.4 0.7}}
-test canvas-2.4 {CanvasWidgetCmd, xview option} {nonPortable} {
+} -result {{0.0 0.3} {0.4 0.7}}
+test canvas-2.4 {CanvasWidgetCmd, xview option} -constraints nonPortable -body {
     # This test gives slightly different results on platforms such
     # as NetBSD.  I don't know why...
     .c configure -xscrollincrement 0 -yscrollincrement 5
@@ -110,14 +249,16 @@ test canvas-2.4 {CanvasWidgetCmd, xview option} {nonPortable} {
     .c xview scroll 2 units
     update
     lappend x [.c xview]
-} {{0.6 0.9} {0.66 0.96}}
-
+} -result {{0.6 0.9} {0.66 0.96}}
 catch {destroy .c}
+
+
+# Canvas used in 3.* test cases
 canvas .c -width 60 -height 40 -scrollregion {0 0 200 80} \
 	-borderwidth 0 -highlightthickness 0
 pack .c
 update
-test canvas-3.1 {CanvasWidgetCmd, yview option} {
+test canvas-3.1 {CanvasWidgetCmd, yview option} -body {
     .c configure -xscrollincrement 40 -yscrollincrement 5
     .c yview moveto 0
     update
@@ -125,8 +266,8 @@ test canvas-3.1 {CanvasWidgetCmd, yview option} {
     .c yview scroll 3 units
     update
     lappend x [.c yview]
-} {{0.0 0.5} {0.1875 0.6875}}
-test canvas-3.2 {CanvasWidgetCmd, yview option} {
+} -result {{0.0 0.5} {0.1875 0.6875}}
+test canvas-3.2 {CanvasWidgetCmd, yview option} -body {
     .c configure -xscrollincrement 40 -yscrollincrement 0
     .c yview moveto 0
     update
@@ -134,49 +275,54 @@ test canvas-3.2 {CanvasWidgetCmd, yview option} {
     .c yview scroll 2 units
     update
     lappend x [.c yview]
-} {{0.0 0.5} {0.1 0.6}}
+} -result {{0.0 0.5} {0.1 0.6}}
+destroy .c
+
 
-test canvas-4.1 {ButtonEventProc procedure} {
+test canvas-4.1 {ButtonEventProc procedure} -setup {
     deleteWindows
+    set x {}	
+} -body {
     canvas .c1 -bg #543210
     rename .c1 .c2
-    set x {}
     lappend x [winfo children .]
     lappend x [.c2 cget -bg]
     destroy .c1
     lappend x [info command .c*] [winfo children .]
-} {.c1 #543210 {} {}}
+} -result {.c1 #543210 {} {}}
 
-test canvas-5.1 {ButtonCmdDeletedProc procedure} {
-    deleteWindows
+test canvas-5.1 {ButtonCmdDeletedProc procedure} -body {
     canvas .c1
     rename .c1 {}
     list [info command .c*] [winfo children .]
-} {{} {}}
+} -cleanup {
+	destroy .c1
+} -result {{} {}}
 
-catch {destroy .c}
+
+# Canvas used in 6.* test cases
 canvas .c -width 100 -height 50 -scrollregion {-200 -100 305 102} \
 	-borderwidth 2 -highlightthickness 3
 pack .c
 update
-test canvas-6.1 {CanvasSetOrigin procedure} {
+test canvas-6.1 {CanvasSetOrigin procedure} -body {
     .c configure -xscrollincrement 0 -yscrollincrement 0
     .c xview moveto 0
     .c yview moveto 0
     update
     list [.c canvasx 0] [.c canvasy 0]
-} {-205.0 -105.0}
-test canvas-6.2 {CanvasSetOrigin procedure} {
+} -result {-205.0 -105.0}
+test canvas-6.2 {CanvasSetOrigin procedure} -body {
     .c configure -xscrollincrement 20 -yscrollincrement 10
     set x ""
     foreach i {.08 .10 .48 .50} {
-	.c xview moveto $i
-	update
-	lappend x [.c canvasx 0]
+		.c xview moveto $i
+		update
+		lappend x [.c canvasx 0]
     }
-    set x
-} {-165.0 -145.0 35.0 55.0}
-test canvas-6.3 {CanvasSetOrigin procedure} {
+    return $x
+} -result {-165.0 -145.0 35.0 55.0}
+test canvas-6.3 {CanvasSetOrigin procedure} -body {
     .c configure -xscrollincrement 20 -yscrollincrement 10
     set x ""
     foreach i {.06 .08 .70 .72} {
@@ -184,30 +330,33 @@ test canvas-6.3 {CanvasSetOrigin procedure} {
 	update
 	lappend x [.c canvasy 0]
     }
-    set x
-} {-95.0 -85.0 35.0 45.0}
-test canvas-6.4 {CanvasSetOrigin procedure} {
+    return $x
+} -result {-95.0 -85.0 35.0 45.0}
+test canvas-6.4 {CanvasSetOrigin procedure} -body {
     .c configure -xscrollincrement 20 -yscrollincrement 10
     .c xview moveto 1.0
     .c canvasx 0
-} {215.0}
-test canvas-6.5 {CanvasSetOrigin procedure} {
+} -result {215.0}
+test canvas-6.5 {CanvasSetOrigin procedure} -body {
     .c configure -xscrollincrement 20 -yscrollincrement 10
     .c yview moveto 1.0
     .c canvasy 0
-} {55.0}
-
+} -result {55.0}
 deleteWindows
 
-set l [lsort [interp hidden]]
+
 test canvas-7.1 {canvas widget vs hidden commands} -setup {
-    catch {destroy .c}
-} -body {
     canvas .c
+} -body {
+	set l [lsort [interp hidden]]
     interp hide {} .c
     destroy .c
-    list [winfo children .] [lsort [interp hidden]]
-} -result [list {} $l]
+    set result [list [winfo children .] [lsort [interp hidden]]]
+	expr {$result eq [list {} $l]}
+} -cleanup {
+	destroy .c
+} -result {1}
+
 
 test canvas-8.1 {canvas arc bbox} -setup {
     catch {destroy .c}
@@ -222,6 +371,7 @@ test canvas-8.1 {canvas arc bbox} -setup {
     list $arcBox $coordBox $pieBox
 } -result {{48 21 100 94} {248 21 300 94} {398 21 500 112}}
 
+
 test canvas-9.1 {canvas id creation and deletion} -setup {
     catch {destroy .c}
     canvas .c
@@ -232,13 +382,13 @@ test canvas-9.1 {canvas id creation and deletion} -setup {
     set size 15
 
     for {set i 0} {$i < $size} {incr i} {
-	set x [expr {-10 + 3*$i}]
-	for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} {
-	    .c create rect ${x}c ${y}c [expr $x+2]c [expr $y+2]c \
-		    -outline black -fill blue -tags rect
-	    .c create text [expr $x+1]c [expr $y+1]c -text "$i,$j" \
-		    -anchor center -tags text
-	}
+		set x [expr {-10 + 3*$i}]
+		for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} {
+			.c create rect ${x}c ${y}c [expr $x+2]c [expr $y+2]c \
+				-outline black -fill blue -tags rect
+			.c create text [expr $x+1]c [expr $y+1]c -text "$i,$j" \
+				-anchor center -tags text
+		}
     }
 
     # The actual bench mark - this code also exercises all the hash
@@ -256,6 +406,8 @@ test canvas-9.1 {canvas id creation and deletion} -setup {
 	
     set x ""
 } -result {}
+
+
 test canvas-10.1 {find items using tag expressions} -setup {
     catch {destroy .c}
     canvas .c
@@ -368,6 +520,7 @@ test canvas-10.12 {multple events bound to same tag expr} -setup {
     .c bind {a && b} <Leave> {puts Leave}
 } -result {}
 
+
 test canvas-11.1 {canvas poly fill check, bug 5783} -setup {
     destroy .c
     pack [canvas .c]
@@ -379,8 +532,8 @@ test canvas-11.1 {canvas poly fill check, bug 5783} -setup {
 test canvas-11.2 {canvas poly overlap fill check, bug 226357} -setup {
     destroy .c
     pack [canvas .c]
-} -body {
     set result {}
+} -body {
     .c create poly 30 30 90 90 30 90 90 30
     lappend result [.c find over 40 40 45 45]; # rect region inc. edge
     lappend result [.c find over 60 40 60 40]; # top-center point
@@ -397,6 +550,7 @@ test canvas-11.2 {canvas poly overlap fill check, bug 226357} -setup {
     lappend result [.c find over 45 50 45 50]; # outside poly
 } -result {1 1 {} 1 {} 1 1 {} 1 {} 1}
 
+
 test canvas-12.1 {canvas mm obj, patch SF-403327, 102471} -setup {
     destroy .c
     pack [canvas .c]
@@ -419,6 +573,7 @@ test canvas-12.2 {canvas mm obj, patch SF-403327, 102471} -setup {
     incr val
 } -result 12
 
+# procedure used in 13.1 test case
 proc kill_canvas {w} {
     destroy $w
     pack [canvas $w -height 200 -width 200] -fill both -expand yes
@@ -426,22 +581,22 @@ proc kill_canvas {w} {
     $w create rectangle 80 80 120 120 -fill blue -tags blue
     # bind a button press to re-build the canvas
     $w bind blue <ButtonRelease-1> [subst {
-	[lindex [info level 0] 0] $w
-	append ::x ok
+		[lindex [info level 0] 0] $w
+		append ::x ok
     }
     ]
 }
-
-test canvas-13.1 {canvas delete during event, SF bug-228024} {
+test canvas-13.1 {canvas delete during event, SF bug-228024} -body {
     kill_canvas .c
     set ::x {}
     # do this many times to improve chances of triggering the crash
     for {set i 0} {$i < 30} {incr i} {
-	event generate .c <1> -x 100 -y 100
-	event generate .c <ButtonRelease-1> -x 100 -y 100
+		event generate .c <1> -x 100 -y 100
+		event generate .c <ButtonRelease-1> -x 100 -y 100
     }
-    set ::x
-} okokokokokokokokokokokokokokokokokokokokokokokokokokokokokok
+    return $::x
+} -result {okokokokokokokokokokokokokokokokokokokokokokokokokokokokokok}
+
 
 test canvas-14.1 {canvas scan SF bug 581560} -setup {
     destroy .c
@@ -480,26 +635,124 @@ test canvas-14.6 {canvas scan} -setup {
     .c scan dragto 10 10 5
 } -result {}
 
-set i 0
-proc create {w type args} {
-    eval [list $w create $type] $args
-}
-foreach type {arc bitmap image line oval polygon rect text window} {
-    incr i
-    test canvas-15.$i "basic types check: $type requires coords" -setup {
+
+test canvas-15.1 {basic types check: arc requires coords} -setup {
 	destroy .c
 	canvas .c
-    } -body {
-	.c create $type
-    } -returnCodes error -result [format {wrong # args: should be ".c create %s coords ?arg ...?"} $type]
-    incr i
-    test canvas-15.$i "basic coords check: $type coords are paired" -setup {
+} -body {
+	.c create arc
+} -returnCodes error -result {wrong # args: should be ".c create arc coords ?arg ...?"}
+test canvas-15.2 "basic coords check: arc coords are paired" -setup {
 	destroy .c
 	canvas .c
-    } -match glob -body {
-	.c create $type 0
-    } -returnCodes error -result "wrong # coordinates: expected*"
-}
+} -body {
+	.c create arc 0
+} -returnCodes error -result {wrong # coordinates: expected 4, got 1}
+
+test canvas-15.3 {basic types check: bitmap requires coords} -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create bitmap
+} -returnCodes error -result {wrong # args: should be ".c create bitmap coords ?arg ...?"}
+test canvas-15.4 "basic coords check: bitmap coords are paired" -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create bitmap 0
+} -returnCodes error -result {wrong # coordinates: expected 2, got 1}
+
+test canvas-15.5 {basic types check: image requires coords} -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create image
+} -returnCodes error -result {wrong # args: should be ".c create image coords ?arg ...?"}
+test canvas-15.6 "basic coords check: image coords are paired" -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create image 0
+} -returnCodes error -result {wrong # coordinates: expected 2, got 1}
+
+test canvas-15.7 {basic types check: line requires coords} -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create line
+} -returnCodes error -result {wrong # args: should be ".c create line coords ?arg ...?"}
+test canvas-15.8 "basic coords check: line coords are paired" -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create line 0
+} -returnCodes error -result {wrong # coordinates: expected an even number, got 1}
+
+test canvas-15.9 {basic types check: oval requires coords} -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create oval
+} -returnCodes error -result {wrong # args: should be ".c create oval coords ?arg ...?"}
+test canvas-15.10 "basic coords check: oval coords are paired" -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create oval 0
+} -returnCodes error -result {wrong # coordinates: expected 0 or 4, got 1}
+
+test canvas-15.11 {basic types check: polygon requires coords} -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create polygon
+} -returnCodes error -result {wrong # args: should be ".c create polygon coords ?arg ...?"}
+test canvas-15.12 "basic coords check: polygon coords are paired" -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create polygon 0
+} -returnCodes error -result {wrong # coordinates: expected an even number, got 1}
+
+test canvas-15.13 {basic types check: rect requires coords} -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create rect
+} -returnCodes error -result {wrong # args: should be ".c create rect coords ?arg ...?"}
+test canvas-15.14 "basic coords check: rect coords are paired" -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create rect 0
+} -returnCodes error -result {wrong # coordinates: expected 0 or 4, got 1}
+
+test canvas-15.15 {basic types check: text requires coords} -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create text
+} -returnCodes error -result {wrong # args: should be ".c create text coords ?arg ...?"}
+test canvas-15.16 "basic coords check: text coords are paired" -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create text 0
+} -returnCodes error -result {wrong # coordinates: expected 2, got 1}
+
+test canvas-15.17 {basic types check: window requires coords} -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create window
+} -returnCodes error -result {wrong # args: should be ".c create window coords ?arg ...?"}
+test canvas-15.18 "basic coords check: window coords are paired" -setup {
+	destroy .c
+	canvas .c
+} -body {
+	.c create window 0
+} -returnCodes error -result {wrong # coordinates: expected 2, got 1}
+
 
 test canvas-16.1 {arc coords check} -setup {
     destroy .c
@@ -509,6 +762,7 @@ test canvas-16.1 {arc coords check} -setup {
     .c itemcget $id -start
 } -result {33.0}
 
+
 test canvas-17.1 {default smooth method handling} -setup {
     destroy .c
     canvas .c
@@ -519,7 +773,7 @@ test canvas-17.1 {default smooth method handling} -setup {
 	.c itemconfigure $id -smooth $smoother
 	lappend result [.c itemcget $id -smooth]
     }
-    set result
+    return $result
 } -result {0 true true true raw raw true}
 
 destroy .c
@@ -527,3 +781,7 @@ destroy .c
 # cleanup
 cleanupTests
 return
+
+
+
+
-- 
cgit v0.12