Tk tests that create images need to be independent of the interpreter environment.

1 files changed, 128 insertions, 123 deletions

diff --git a/tests/image.test b/tests/image.test
index 5f2466d..184024c 100644
--- a/tests/image.test
+++ b/tests/image.test
@@ -7,14 +7,15 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: image.test,v 1.16 2008/08/15 01:10:03 aniap Exp $
+# RCS: @(#) $Id: image.test,v 1.17 2009/01/13 01:46:06 patthoyts Exp $
 
 package require tcltest 2.2
 namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
-eval image delete [image names]
+imageInit
+
 # Canvas used in some tests in the whole file
 canvas .c -highlightthickness 2
 pack .c
@@ -36,27 +37,27 @@ test image-1.4 {Tk_ImageCmd procedure, "create" option} -body {
 test image-1.5 {Tk_ImageCmd procedure, "create" option} -constraints {
     testImageType 
 } -body {
-    list [image create test myimage] [image names]
+    list [image create test myimage] [imageNames]
 } -cleanup {
-    eval image delete [image names]
+    imageCleanup
 } -result {myimage myimage}
 test image-1.6 {Tk_ImageCmd procedure, "create" option} -constraints {
     testImageType 
 } -setup {
-    eval image delete [image names] 
+    imageCleanup
 } -body {
     scan [image create test] image%d first
     image create test myimage
     scan [image create test -variable x] image%d second
     expr $second-$first
 } -cleanup {
-    eval image delete [image names]
+    imageCleanup
 } -result {1}
 
 test image-1.7 {Tk_ImageCmd procedure, "create" option} -constraints {
-	testImageType 
+    testImageType 
 } -setup {
-    eval image delete [image names] 
+    imageCleanup
 } -body {
     image create test myimage -variable x
     .c create image 100 50 -image myimage
@@ -67,13 +68,13 @@ test image-1.7 {Tk_ImageCmd procedure, "create" option} -constraints {
     update
     return $x
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -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] 
+    .c delete all
+    imageCleanup
 } -body {
     image create test myimage -variable x
     .c create image 100 50 -image myimage
@@ -86,7 +87,7 @@ test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints {
     return $x
 } -cleanup {
     .c delete all
-    eval image delete [image names] 
+    imageCleanup
 } -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 
@@ -97,7 +98,7 @@ test image-1.10 {Tk_ImageCmd procedure, "create" option} -constraints {
     testImageType 
 } -body {
     catch {image create test -badName foo}
-    image names
+    imageNames
 } -result {}
 test image-1.11 {Tk_ImageCmd procedure, "create" option with same name as main window} -body {
     set code [loadTkCommand]
@@ -124,8 +125,8 @@ test image-1.12 {Tk_ImageCmd procedure, "create" option with same name as main w
     removeFile script
 } -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] 
+    .c delete all
+    imageCleanup
 } -body {
     set i [image create bitmap]
     regexp {^image(\d+)$} $i -> serial
@@ -143,41 +144,41 @@ test image-2.1 {Tk_ImageCmd procedure, "delete" option} -body {
     image delete
 } -result {}
 test image-2.2 {Tk_ImageCmd procedure, "delete" option} -constraints {
-	testImageType 
+    testImageType 
 } -setup {
-    eval image delete [image names] 
+    imageCleanup
     set result {}
 } -body {
     image create test myimage
     image create test img2
-    lappend result [lsort [image names]]
+    lappend result [lsort [imageNames]]
     image d myimage img2
-    lappend result [image names]
+    lappend result [imageNames]
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -result {{img2 myimage} {}}
 test image-2.3 {Tk_ImageCmd procedure, "delete" option} -constraints {
-	testImageType 
+    testImageType 
 } -setup {
-    eval image delete [image names] 
+    imageCleanup
 } -body {
     image create test myimage
     image create test img2
     image delete myimage gorp img2
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -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] 
+    imageCleanup
 } -body {
     image create test myimage
     image create test img2
     catch {image delete myimage gorp img2}
-    image names
+    imageNames
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -result {img2}
 
 
@@ -193,14 +194,14 @@ test image-3.3 {Tk_ImageCmd procedure, "height" option} -body {
 test image-3.4 {Tk_ImageCmd procedure, "height" option} -constraints {
     testImageType 
 } -setup {
-    eval image delete [image names] 
+    imageCleanup
 } -body {
     image create test myimage
     set x [image h myimage]
     myimage changed 0 0 0 0 60 50
     list $x [image height myimage]
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -result {15 50}
 
 
@@ -208,24 +209,34 @@ 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 
+    testImageType 
 } -setup {
-    eval image delete [image names] 
-} -body {
-    image create test myimage
-    image create test img2
-    image create test 24613
-    lsort [image names]
+    catch {interp delete testinterp}
+} -body {
+    interp create testinterp
+    load {} Tk testinterp
+    interp eval testinterp {
+        image delete {*}[image names]
+        image create test myimage
+        image create test img2
+        image create test 24613
+        lsort [image names]
+    }
 } -cleanup {
-    eval image delete [image names] 
+    interp delete testinterp
 } -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]
+    catch {interp delete testinterp}
+} -body {
+    interp create testinterp
+    load {} Tk testinterp
+    interp eval testinterp {
+        image delete {*}[image names]
+        eval image delete [image names] [image names]
+        lsort [image names]
+    }
 } -cleanup {
-    eval image delete [image names] 
+    interp delete testinterp
 } -result {}
 
 
@@ -240,42 +251,42 @@ test image-5.3 {Tk_ImageCmd procedure, "type" option} -body {
 } -returnCodes error -result {image "foo" doesn't exist}
 
 test image-5.4 {Tk_ImageCmd procedure, "type" option} -constraints {
-	testImageType 
+    testImageType 
 } -setup {
-    eval image delete [image names] 
+    imageCleanup
 } -body {
     image create test myimage
     image type myimage
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -result {test}
 test image-5.5 {Tk_ImageCmd procedure, "type" option} -constraints {
-	testImageType 
+    testImageType 
 } -setup {
-    eval image delete [image names] 
+    imageCleanup
 } -body {
     image create test myimage
     .c create image 50 50 -image myimage
     image delete myimage
     image type myimage
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -returnCodes error -result {image "myimage" doesn't exist}
 test image-5.6 {Tk_ImageCmd procedure, "type" option} -constraints {
-	testOldImageType 
+    testOldImageType 
 } -setup {
-    eval image delete [image names] 
+    imageCleanup
 } -body {
     image create oldtest myimage
     image type myimage
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -result {oldtest}
 test image-5.7 {Tk_ImageCmd procedure, "type" option} -constraints {
-	testOldImageType 
+    testOldImageType 
 } -setup {
-	.c delete all
-    eval image delete [image names] 
+    .c delete all
+    imageCleanup
 } -body {
     image create oldtest myimage
     .c create image 50 50 -image myimage
@@ -283,7 +294,7 @@ test image-5.7 {Tk_ImageCmd procedure, "type" option} -constraints {
     image type myimage
 } -cleanup {
     .c delete all
-    eval image delete [image names] 
+    imageCleanup
 } -returnCodes error -result {image "myimage" doesn't exist}
 
 
@@ -307,23 +318,23 @@ 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 
+    testImageType 
 } -setup {
-    eval image delete [image names] 
+    imageCleanup
 } -body {
     image create test myimage
     set x [image w myimage]
     myimage changed 0 0 0 0 60 50
     list $x [image width myimage]
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -result {30 60}
 
 
 test image-8.1 {Tk_ImageCmd procedure, "inuse" option} -constraints {
-	testImageType 
+    testImageType 
 } -setup {
-    eval image delete [image names] 
+    imageCleanup
     set res {}
     destroy .b
 } -body {
@@ -332,14 +343,14 @@ test image-8.1 {Tk_ImageCmd procedure, "inuse" option} -constraints {
     button .b -image myimage2
     lappend res [image inuse myimage2]
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
     catch {destroy .b}
 } -result [list 0 1]
     
 
 test image-9.1 {Tk_ImageChanged procedure} -constraints testImageType -setup {
-	.c delete all
-    eval image delete [image names] 
+    .c delete all
+    imageCleanup
 } -body {
     image create test foo -variable x
     .c create image 50 50 -image foo
@@ -350,11 +361,11 @@ test image-9.1 {Tk_ImageChanged procedure} -constraints testImageType -setup {
     return $x
 } -cleanup {
     .c delete all
-    eval image delete [image names] 
+    imageCleanup
 } -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] 
+    .c delete all
+    imageCleanup
 } -body {
     image create test foo -variable x
     .c create image 50 50 -image foo
@@ -366,20 +377,20 @@ test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup {
     return $x
 } -cleanup {
     .c delete all
-    eval image delete [image names] 
+    imageCleanup
 } -result {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}}
 
 
 test image-10.1 {Tk_GetImage procedure} -setup {
-    eval image delete [image names] 
+    imageCleanup
 } -body {
     .c create image 100 10 -image bad_name
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -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] 
+    destroy .l
+    imageCleanup
 } -body {
     image create test mytest
     label .l -image mytest
@@ -387,13 +398,13 @@ test image-10.2 {Tk_GetImage procedure} -constraints testImageType -setup {
     label .l2 -image mytest
 } -cleanup {
     destroy .l
-    eval image delete [image names] 
+    imageCleanup
 } -returnCodes error -result {image "mytest" doesn't exist}
 
 
 test image-11.1 {Tk_FreeImage procedure} -constraints testImageType -setup {
-	.c delete all
-    eval image delete [image names] 
+    .c delete all
+    imageCleanup
 } -body {
     image create test foo -variable x
     .c create image 50 50 -image foo -tags i1
@@ -404,30 +415,30 @@ test image-11.1 {Tk_FreeImage procedure} -constraints testImageType -setup {
     .c delete i1
     pack .c
     update
-    list [image names] $x
+    list [imageNames] $x
 } -cleanup {
     .c delete all
-    eval image delete [image names] 
+    imageCleanup
 } -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] 
+    .c delete all
+    imageCleanup
 } -body {
     image create test foo -variable x
     .c create image 50 50 -image foo -tags i1
-    set names [image names]
+    set names [imageNames]
     image delete foo
     update
-    set names2 [image names]
+    set names2 [imageNames]
     set x {}
     .c delete i1
     pack forget .c
     pack .c
     update
-    list $names $names2 [image names] $x
+    list $names $names2 [imageNames] $x
 } -cleanup {
     .c delete all
-    eval image delete [image names] 
+    imageCleanup
 } -result {foo {} {} {}}
 
 
@@ -435,7 +446,7 @@ test image-11.2 {Tk_FreeImage procedure} -constraints testImageType -setup {
 test image-12.1 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
     testImageType nonPortable
 } -setup {
-    eval image delete [image names] 
+    imageCleanup
 } -body {
     image create test foo -variable x
     .c create image 50 60 -image foo -tags i1 -anchor nw
@@ -445,12 +456,12 @@ test image-12.1 {Tk_RedrawImage procedure, redisplay area clipping} -constraints
     update
     return $x
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -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] 
+    imageCleanup
 } -body {
     image create test foo -variable x
     .c create image 50 60 -image foo -tags i1 -anchor nw
@@ -460,12 +471,12 @@ test image-12.2 {Tk_RedrawImage procedure, redisplay area clipping} -constraints
     update
     return $x
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -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] 
+    imageCleanup
 } -body {
     image create test foo -variable x
     .c create image 50 60 -image foo -tags i1 -anchor nw
@@ -475,12 +486,12 @@ test image-12.3 {Tk_RedrawImage procedure, redisplay area clipping} -constraints
     update
     return $x
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -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] 
+    imageCleanup
 } -body {
     image create test foo -variable x
     .c create image 50 60 -image foo -tags i1 -anchor nw
@@ -490,12 +501,12 @@ test image-12.4 {Tk_RedrawImage procedure, redisplay area clipping} -constraints
     update
     return $x
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -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] 
+    imageCleanup
 } -body {
     image create test foo -variable x
     .c create image 50 60 -image foo -tags i1 -anchor nw
@@ -505,12 +516,12 @@ test image-12.5 {Tk_RedrawImage procedure, redisplay area clipping} -constraints
     update
     return $x
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -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] 
+    imageCleanup
 } -body {
     image create test foo -variable x
     .c create image 50 60 -image foo -tags i1 -anchor nw
@@ -520,104 +531,98 @@ test image-12.6 {Tk_RedrawImage procedure, redisplay area clipping} -constraints
     update
     return $x
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -result {{foo display 5 5 20 5 30 30}}
 
 
 test image-13.1 {Tk_SizeOfImage procedure} -constraints testImageType -setup {
-    eval image delete [image names] 
+    imageCleanup
 } -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]
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -result {30 15 85 60}
 
 test image-13.2 {DeleteImage procedure} -constraints testImageType -setup {
-	.c delete all
-    eval image delete [image names] 
+    .c delete all
+    imageCleanup
 } -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] |
+    lappend x | [imageNames] | [catch {image delete foo} msg] | $msg | [imageNames] |
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -result {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |}
 
 test image-13.3 {Tk_SizeOfImage procedure} -constraints testOldImageType -setup {
-    eval image delete [image names] 
+    imageCleanup
 } -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]
 } -cleanup {
-    eval image delete [image names] 
+    imageCleanup
 } -result {30 15 85 60}
 
 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] [image names]
+    imageCleanup
+} -body {
     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] |
+    lappend x | [imageNames] | [catch {image delete foo} msg] | $msg | [imageNames] |
 } -cleanup {
     .c delete all
-    eval image delete [image names] 
+    imageCleanup
 } -result {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |}
 
-
 test image-14.1 {image command vs hidden commands} -body {
     catch {image delete hidden}
-    set l [image names]
+    set l [imageNames]
     set h [interp hidden]
     image create photo hidden
     interp hide {} hidden
     image delete hidden
-    set res1 [list [image names] [interp hidden]]
+    set res1 [list [imageNames] [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} -setup {
-	.c delete all
-    eval image delete [image names] 
+    .c delete all
+    imageCleanup
 } -body {
     image create photo foo -width 10 -height 10
     .c create image 10 10 -image foo -tags i1 -anchor nw
     update
     set x [.c bbox i1]
-    lappend x [image names]
+    lappend x [imageNames]
     image delete foo
-    lappend x [image names]
+    lappend x [imageNames]
     image create photo foo -width 20 -height 20
-    lappend x [.c bbox i1] [image names]
+    lappend x [.c bbox i1] [imageNames]
 } -cleanup {
     .c delete all
-    eval image delete [image names] 
+    imageCleanup
 } -result {10 10 20 20 foo {} {10 10 30 30} foo}
     
 destroy .c
-eval image delete [image names]
+imageFinish
 
 # cleanup
 cleanupTests
 return
 
-
-
+# Local variables:
+# mode: tcl
+# End: