Update to tcltest2

1 files changed, 393 insertions, 211 deletions

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
+
+
+