summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog5
-rw-r--r--tests/button.test27
-rw-r--r--tests/canvImg.test72
-rw-r--r--tests/canvPs.test9
-rw-r--r--tests/canvas.test4
-rw-r--r--tests/constraints.tcl36
-rw-r--r--tests/image.test251
-rw-r--r--tests/imgBmap.test120
-rw-r--r--tests/imgPNG.test5
-rw-r--r--tests/imgPPM.test6
-rw-r--r--tests/imgPhoto.test36
-rw-r--r--tests/menu.test115
-rw-r--r--tests/menuDraw.test31
-rw-r--r--tests/menubut.test31
-rw-r--r--tests/textImage.test10
-rw-r--r--tests/unixButton.test9
-rw-r--r--tests/winButton.test5
17 files changed, 412 insertions, 360 deletions
diff --git a/ChangeLog b/ChangeLog
index 76ddfd4..9d3ddc9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2009-01-13 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tests/constraints.tcl: Made the tests more independent of the presence
+ * tests/*.test: of images in the interpreter.
+
2009-01-11 Pat Thoyts <patthoyts@users.sourceforge.net>
* tests/bind.test: Fixed keysym bind tests for unix [Bug 2336454]
diff --git a/tests/button.test b/tests/button.test
index ee59731..7f1a318 100644
--- a/tests/button.test
+++ b/tests/button.test
@@ -7,13 +7,13 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: button.test,v 1.24 2009/01/11 23:37:15 patthoyts Exp $
+# RCS: @(#) $Id: button.test,v 1.25 2009/01/13 01:46:05 patthoyts Exp $
package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
-
+imageInit
proc bogusTrace args {
error "trace aborted"
@@ -3256,21 +3256,17 @@ test button-5.4 {ConfigureButton - variable trace} -body { ;# ex 6.2a
test button-5.5 {ConfigureButton - image handling} -constraints {
testImageType
} -setup {
- set images [image names]
+ imageCleanup
image create test image1
image create test image2
} -body {
button .b -image image1
image delete image1
.b configure -image image2
- set result {}
- foreach image [image names] {
- if {$image ni $images} { lappend result $image }
- }
- set result
+ imageNames
} -cleanup {
destroy .b
- image delete image2
+ imageCleanup
} -result {image2}
test button-5.6 {ConfigureButton - default value for variable} -body {
@@ -3914,15 +3910,10 @@ test button-13.8 {size behaviouor: checkbutton} -setup {
destroy .a .b .c
} -result {1 1 1}
-
+imageFinish
cleanupTests
return
-
-
-
-
-
-
-
-
+# Local variables:
+# mode: tcl
+# End:
diff --git a/tests/canvImg.test b/tests/canvImg.test
index d4bce0a..1f3cf24 100644
--- a/tests/canvImg.test
+++ b/tests/canvImg.test
@@ -7,14 +7,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: canvImg.test,v 1.11 2008/10/07 00:10:07 patthoyts Exp $
+# RCS: @(#) $Id: canvImg.test,v 1.12 2009/01/13 01:46:06 patthoyts Exp $
package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
+imageInit
-eval image delete [image names]
# Canvas used in every test case of the whole file
canvas .c
pack .c
@@ -195,21 +195,22 @@ test canvImg-4.3 {ConfiugreImage procedure} -constraints testImageType -setup {
test canvImg-5.1 {DeleteImage procedure} -constraints testImageType -setup {
.c delete all
+ imageCleanup
} -body {
- image create test foo -variable x
+ image create test foo -variable x
image create test foo2 -variable y
image create test xyzzy -variable z
.c create image 50 100 -image xyzzy -tags i1
update
- set names [lsort [image names]]
+ set names [lsort [imageNames]]
image delete xyzzy
set z {}
- set names2 [lsort [image names]]
+ set names2 [lsort [imageNames]]
.c delete i1
update
- list $names $names2 $z [lsort [image names]]
+ list $names $names2 $z [lsort [imageNames]]
} -cleanup {
- image delete foo foo2
+ imageCleanup
.c delete all
} -result {{foo foo2 xyzzy} {foo foo2} {} {foo foo2}}
test canvImg-5.2 {DeleteImage procedure (don't delete non-existent image)} -body {
@@ -222,24 +223,24 @@ test canvImg-5.2 {DeleteImage procedure (don't delete non-existent image)} -body
test canvImg-6.1 {ComputeImageBbox procedure} -constraints testImageType -setup {
- image create test foo
+ image create test foo
.c delete all
} -body {
.c create image 15.51 17.51 -image foo -tags i1 -anchor nw
.c bbox i1
} -cleanup {
.c delete all
- image delete foo
+ imageCleanup
} -result {16 18 46 33}
test canvImg-6.2 {ComputeImageBbox procedure} -constraints testImageType -setup {
- image create test foo
+ image create test foo
.c delete all
} -body {
.c create image 15.49 17.49 -image foo -tags i1 -anchor nw
.c bbox i1
} -cleanup {
.c delete all
- image delete foo
+ imageCleanup
} -result {15 17 45 32}
test canvImg-6.3 {ComputeImageBbox procedure} -setup {
.c delete all
@@ -250,7 +251,7 @@ test canvImg-6.3 {ComputeImageBbox procedure} -setup {
.c delete all
} -result {}
test canvImg-6.4 {ComputeImageBbox procedure} -constraints testImageType -setup {
- image create test foo
+ image create test foo
.c delete all
} -body {
.c delete all
@@ -258,10 +259,10 @@ test canvImg-6.4 {ComputeImageBbox procedure} -constraints testImageType -setup
.c bbox i1
} -cleanup {
.c delete all
- image delete foo
+ imageCleanup
} -result {20 30 50 45}
test canvImg-6.5 {ComputeImageBbox procedure} -constraints testImageType -setup {
- image create test foo
+ image create test foo
.c delete all
} -body {
.c delete all
@@ -269,10 +270,10 @@ test canvImg-6.5 {ComputeImageBbox procedure} -constraints testImageType -setup
.c bbox i1
} -cleanup {
.c delete all
- image delete foo
+ imageCleanup
} -result {5 30 35 45}
test canvImg-6.6 {ComputeImageBbox procedure} -constraints testImageType -setup {
- image create test foo
+ image create test foo
.c delete all
} -body {
.c delete all
@@ -280,10 +281,10 @@ test canvImg-6.6 {ComputeImageBbox procedure} -constraints testImageType -setup
.c bbox i1
} -cleanup {
.c delete all
- image delete foo
+ imageCleanup
} -result {-10 30 20 45}
test canvImg-6.7 {ComputeImageBbox procedure} -constraints testImageType -setup {
- image create test foo
+ image create test foo
.c delete all
} -body {
.c delete all
@@ -291,10 +292,10 @@ test canvImg-6.7 {ComputeImageBbox procedure} -constraints testImageType -setup
.c bbox i1
} -cleanup {
.c delete all
- image delete foo
+ imageCleanup
} -result {-10 23 20 38}
test canvImg-6.8 {ComputeImageBbox procedure} -constraints testImageType -setup {
- image create test foo
+ image create test foo
.c delete all
} -body {
.c delete all
@@ -302,10 +303,10 @@ test canvImg-6.8 {ComputeImageBbox procedure} -constraints testImageType -setup
.c bbox i1
} -cleanup {
.c delete all
- image delete foo
+ imageCleanup
} -result {-10 15 20 30}
test canvImg-6.9 {ComputeImageBbox procedure} -constraints testImageType -setup {
- image create test foo
+ image create test foo
.c delete all
} -body {
.c delete all
@@ -313,12 +314,12 @@ test canvImg-6.9 {ComputeImageBbox procedure} -constraints testImageType -setup
.c bbox i1
} -cleanup {
.c delete all
- image delete foo
+ imageCleanup
} -result {5 15 35 30}
test canvImg-6.10 {ComputeImageBbox procedure} -constraints {
- testImageType
+ testImageType
} -setup {
- image create test foo
+ image create test foo
.c delete all
} -body {
.c delete all
@@ -326,12 +327,12 @@ test canvImg-6.10 {ComputeImageBbox procedure} -constraints {
.c bbox i1
} -cleanup {
.c delete all
- image delete foo
+ image delete foo
} -result {20 15 50 30}
test canvImg-6.11 {ComputeImageBbox procedure} -constraints {
- testImageType
+ testImageType
} -setup {
- image create test foo
+ image create test foo
.c delete all
} -body {
.c delete all
@@ -339,12 +340,12 @@ test canvImg-6.11 {ComputeImageBbox procedure} -constraints {
.c bbox i1
} -cleanup {
.c delete all
- image delete foo
+ image delete foo
} -result {20 23 50 38}
test canvImg-6.12 {ComputeImageBbox procedure} -constraints {
testImageType
} -setup {
- image create test foo
+ image create test foo
.c delete all
} -body {
.c delete all
@@ -352,7 +353,7 @@ test canvImg-6.12 {ComputeImageBbox procedure} -constraints {
.c bbox i1
} -cleanup {
.c delete all
- image delete foo
+ image delete foo
} -result {5 23 35 38}
# The following test is non-portable because of differences in
@@ -363,7 +364,7 @@ test canvImg-7.1 {DisplayImage procedure} -constraints {
} -setup {
.c delete all
} -body {
- image create test foo -variable x
+ image create test foo -variable x
.c create image 50 100 -image foo -tags i1 -anchor nw
update
set x {}
@@ -382,7 +383,7 @@ test canvImg-7.2 {DisplayImage procedure, no image} -body {
# image used in 8.* test cases
if {[testConstraint testImageType]} {
- image create test foo
+ image create test foo
}
test canvImg-8.1 {ImageToArea procedure} -constraints testImageType -setup {
.c create image 50 100 -image foo -tags image -anchor nw
@@ -788,7 +789,10 @@ test canvImg-11.3 {ImageChangedProc procedure} -constraints {
} -result {{foo2 display 0 0 20 40 50 40}}
# cleanup
+imageFinish
cleanupTests
return
-
+# Local variables:
+# mode: tcl
+# End: \ No newline at end of file
diff --git a/tests/canvPs.test b/tests/canvPs.test
index 7b566e5..1ef967a 100644
--- a/tests/canvPs.test
+++ b/tests/canvPs.test
@@ -6,12 +6,13 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: canvPs.test,v 1.13 2008/08/07 23:05:15 aniap Exp $
+# RCS: @(#) $Id: canvPs.test,v 1.14 2009/01/13 01:46:06 patthoyts Exp $
package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
+imageInit
# canvas used in 1.* and 2.* test cases
canvas .c -width 400 -height 300 -bd 2 -relief sunken
@@ -157,6 +158,7 @@ test canvPs-3.1 {test ps generation with an embedded window} -constraints {
file exists $bar
} -cleanup {
destroy .c
+ imageCleanup
removeFile bar.ps
} -result {1}
test canvPs-3.2 {test ps generation with an embedded window not mapped} -setup {
@@ -186,6 +188,11 @@ test canvPs-4.1 {test ps generation with single-point uncolored poly, bug 734498
# cleanup
unset -nocomplain foo bar
+imageFinish
deleteWindows
cleanupTests
return
+
+# Local variables:
+# mode: tcl
+# End: \ No newline at end of file
diff --git a/tests/canvas.test b/tests/canvas.test
index 3128fa9..13108fb 100644
--- a/tests/canvas.test
+++ b/tests/canvas.test
@@ -7,11 +7,12 @@
# Copyright (c) 2008 Donal K. Fellows
# All rights reserved.
#
-# RCS: @(#) $Id: canvas.test,v 1.28 2008/12/12 00:09:38 nijtmans Exp $
+# RCS: @(#) $Id: canvas.test,v 1.29 2009/01/13 01:46:06 patthoyts Exp $
package require tcltest 2.1
eval tcltest::configure $argv
tcltest::loadTestedCommands
+imageInit
# XXX - This test file is woefully incomplete. At present, only a few of the
# features are tested.
@@ -935,6 +936,7 @@ test canvas-19.11 {rchars method - errors} -setup {
} -returnCodes error -result {bad index "foo"}
# cleanup
+imageCleanup
cleanupTests
return
diff --git a/tests/constraints.tcl b/tests/constraints.tcl
index 0750d7a..ac32852 100644
--- a/tests/constraints.tcl
+++ b/tests/constraints.tcl
@@ -138,6 +138,42 @@ namespace eval tk {
focus -force .focus.e
destroy .focus
}
+
+
+ namespace export imageInit imageFinish imageCleanup imageNames
+ variable ImageNames
+ proc imageInit {} {
+ variable ImageNames
+ if {![info exists ImageNames]} {
+ set ImageNames [lsort [image names]]
+ }
+ imageCleanup
+ if {[lsort [image names]] ne $ImageNames} {
+ return -code error "IMAGE NAMES mismatch: [image names] != $ImageNames"
+ }
+ }
+ proc imageFinish {} {
+ variable ImageNames
+ if {[lsort [image names]] ne $ImageNames} {
+ return -code error "images remaining: [image names] != $ImageNames"
+ }
+ imageCleanup
+ }
+ proc imageCleanup {} {
+ variable ImageNames
+ foreach img [image names] {
+ if {$img ni $ImageNames} {image delete $img}
+ }
+ }
+ proc imageNames {} {
+ variable ImageNames
+ set r {}
+ foreach img [image names] {
+ if {$img ni $ImageNames} {lappend r $img}
+ }
+ return $r
+ }
+
}
}
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:
diff --git a/tests/imgBmap.test b/tests/imgBmap.test
index 87dc4ae..6d0c02d 100644
--- a/tests/imgBmap.test
+++ b/tests/imgBmap.test
@@ -7,12 +7,13 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: imgBmap.test,v 1.8 2008/08/17 19:40:33 aniap Exp $
+# RCS: @(#) $Id: imgBmap.test,v 1.9 2009/01/13 01:46:06 patthoyts Exp $
package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
+imageInit
set data1 {#define foo_width 16
#define foo_height 16
@@ -34,7 +35,7 @@ set data2 {
makeFile $data1 foo.bm
makeFile $data2 foo2.bm
-eval image delete [image names]
+imageCleanup
#canvas .c
#pack .c
#update
@@ -121,21 +122,20 @@ rename bgerror {}
test imageBmap-2.1 {ImgBmapCreate procedure} -setup {
- eval image delete [image names]
+ imageCleanup
} -body {
- eval image delete [image names]
- list [catch {image create bitmap -gorp dum} msg] $msg [image names]
+ list [catch {image create bitmap -gorp dum} msg] $msg [imageNames]
} -result {1 {unknown option "-gorp"} {}}
test imageBmap-2.2 {ImgBmapCreate procedure} -setup {
- eval image delete [image names]
+ imageCleanup
} -body {
image create bitmap image1
- list [info commands image1] [image names] \
+ list [info commands image1] [imageNames] \
[image width image1] [image height image1] \
[lindex [image1 configure -foreground] 4] \
[lindex [image1 configure -background] 4]
} -cleanup {
- image delete image1
+ image delete image1
} -result {image1 image1 0 0 #000000 {}}
@@ -227,41 +227,28 @@ test imageBmap-5.1 {GetBitmapData procedure} -body {
test imageBmap-5.2 {GetBitmapData procedure} -body {
list [catch {image create bitmap -file bad_name} msg] [string tolower $msg]
} -result {1 {couldn't read bitmap file "bad_name": no such file or directory}}
-test imageBmap-5.3 {GetBitmapData procedure} -body {
- eval image delete [image names]
+test imageBmap-5.3 {GetBitmapData procedure} -setup {imageCleanup} -body {
image create bitmap -data { }
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-5.4 {GetBitmapData procedure} -body {
- eval image delete [image names]
- image create bitmap -data {#define foo2_width}
+test imageBmap-5.4 {GetBitmapData procedure} -setup {imageCleanup} -body {
+ image create bitmap -data "#define foo2_width"
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-5.5 {GetBitmapData procedure} -body {
- eval image delete [image names]
- image create bitmap -data {#define foo2_width gorp}
+test imageBmap-5.5 {GetBitmapData procedure} -setup {imageCleanup} -body {
+ image create bitmap -data "#define foo2_width gorp"
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-5.6 {GetBitmapData procedure} -body {
- eval image delete [image names]
-
- image create bitmap -data {#define foo2_width 1.4}
+test imageBmap-5.6 {GetBitmapData procedure} -setup {imageCleanup} -body {
+ image create bitmap -data "#define foo2_width 1.4"
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-5.7 {GetBitmapData procedure} -body {
- eval image delete [image names]
-
- image create bitmap -data {#define foo2_height}
+test imageBmap-5.7 {GetBitmapData procedure} -setup {imageCleanup} -body {
+ image create bitmap -data "#define foo2_height"
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-5.8 {GetBitmapData procedure} -body {
- eval image delete [image names]
-
- image create bitmap -data {#define foo2_height gorp}
+test imageBmap-5.8 {GetBitmapData procedure} -setup {imageCleanup} -body {
+ image create bitmap -data "#define foo2_height gorp"
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-5.9 {GetBitmapData procedure} -body {
- eval image delete [image names]
-
- image create bitmap -data {#define foo2_height 1.4}
+test imageBmap-5.9 {GetBitmapData procedure} -setup {imageCleanup} -body {
+ image create bitmap -data "#define foo2_height 1.4"
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-5.10 {GetBitmapData procedure} -body {
- eval image delete [image names]
-
+test imageBmap-5.10 {GetBitmapData procedure} -setup {imageCleanup} -body {
image create bitmap i1 -data {
#define foo2_height 14
#define foo2_width 15 xx _widtg 18 xwidth 18 _heighz 18 xheight 18
@@ -273,11 +260,9 @@ test imageBmap-5.10 {GetBitmapData procedure} -body {
}
list [image width i1] [image height i1]
} -cleanup {
- image delete i1
+ image delete i1
} -result {15 14}
-test imageBmap-5.11 {GetBitmapData procedure} -body {
- eval image delete [image names]
-
+test imageBmap-5.11 {GetBitmapData procedure} -setup {imageCleanup} -body {
image create bitmap i1 -data {
_height 14 _width 15
char {
@@ -288,11 +273,9 @@ test imageBmap-5.11 {GetBitmapData procedure} -body {
}
list [image width i1] [image height i1]
} -cleanup {
- image delete i1
+ image delete i1
} -result {15 14}
-test imageBmap-5.12 {GetBitmapData procedure} -body {
- eval image delete [image names]
-
+test imageBmap-5.12 {GetBitmapData procedure} -setup {imageCleanup} -body {
image create bitmap i1 -data {
#define foo2_height 14
#define foo2_width 15
@@ -303,9 +286,7 @@ test imageBmap-5.12 {GetBitmapData procedure} -body {
0xff, 0xff};
}
} -returnCodes error -result {format error in bitmap data; looks like it's an obsolete X10 bitmap file}
-test imageBmap-5.13 {GetBitmapData procedure} -body {
- eval image delete [image names]
-
+test imageBmap-5.13 {GetBitmapData procedure} -setup {imageCleanup} -body {
image create bitmap i1 -data {
#define foo2_height 16
#define foo2_width 16
@@ -316,25 +297,19 @@ test imageBmap-5.13 {GetBitmapData procedure} -body {
0xff, 0xff;
}
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-5.14 {GetBitmapData procedure} -body {
- eval image delete [image names]
-
+test imageBmap-5.14 {GetBitmapData procedure} -setup {imageCleanup} -body {
image create bitmap i1 -data {
#define foo2_width 16
static char foo2_bits[] = {
0xff, 0xff, 0xff, }}
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-5.15 {GetBitmapData procedure} -body {
- eval image delete [image names]
-
+test imageBmap-5.15 {GetBitmapData procedure} -setup {imageCleanup} -body {
image create bitmap i1 -data {
#define foo2_height 16
static char foo2_bits[] = {
0xff, 0xff, 0xff, }}
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-5.16 {GetBitmapData procedure} -body {
- eval image delete [image names]
-
+test imageBmap-5.16 {GetBitmapData procedure} -setup {imageCleanup} -body {
image create bitmap i1 -data {
#define foo2_height 16
#define foo2_width 16
@@ -345,9 +320,7 @@ test imageBmap-5.16 {GetBitmapData procedure} -body {
0xff, foo};
}
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-5.17 {GetBitmapData procedure} -body {
- eval image delete [image names]
-
+test imageBmap-5.17 {GetBitmapData procedure} -setup {imageCleanup} -body {
image create bitmap i1 -data "
#define foo2_height 16
#define foo2_width 16
@@ -360,24 +333,21 @@ test imageBmap-5.17 {GetBitmapData procedure} -body {
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-6.1 {NextBitmapWord procedure} -body {
- eval image delete [image names]
+test imageBmap-6.1 {NextBitmapWord procedure} -setup {imageCleanup} -body {
image create bitmap i1 -data {1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890}
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-6.2 {NextBitmapWord procedure} -body {
- eval image delete [image names]
+test imageBmap-6.2 {NextBitmapWord procedure} -setup {imageCleanup} -body {
makeFile {1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890} foo3.bm
image create bitmap i1 -file foo3.bm
} -returnCodes error -result {format error in bitmap data}
-test imageBmap-6.3 {NextBitmapWord procedure} -body {
- eval image delete [image names]
+test imageBmap-6.3 {NextBitmapWord procedure} -setup {imageCleanup} -body {
makeFile { } foo3.bm
image create bitmap i1 -file foo3.bm
} -returnCodes error -result {format error in bitmap data}
removeFile foo3.bm
-eval image delete [image names]
+imageCleanup
# Image used in 7.* tests
image create bitmap i1
test imageBmap-7.1 {ImgBmapCmd procedure} -body {
@@ -445,13 +415,13 @@ test imageBmap-9.1 {ImgBmapDisplay procedure, nothing to display} -setup {
update
} -body {
proc bgerror args {}
- eval image delete [image names]
+ imageCleanup
image create bitmap i1 -data $data1
.c create image 50 100 -image i1 -tags i1.1
i1 configure -data {}
update
} -cleanup {
- image delete i1
+ image delete i1
destroy .c
} -result {}
test imageBmap-9.2 {ImgBmapDisplay procedure, nothing to display} -setup {
@@ -460,14 +430,14 @@ test imageBmap-9.2 {ImgBmapDisplay procedure, nothing to display} -setup {
update
} -body {
proc bgerror args {}
- eval image delete [image names]
+ imageCleanup
.c delete all
image create bitmap i1 -data $data1
.c create image 50 100 -image i1 -tags i1.1
i1 configure -foreground bogus
update
} -cleanup {
- image delete i1
+ image delete i1
destroy .c
} -result {}
if {[info exists bgerror]} {
@@ -480,7 +450,7 @@ test imageBmap-10.1 {ImgBmapFree procedure, resource freeing} -setup {
pack [canvas .c]
update
} -body {
- eval image delete [image names]
+ imageCleanup
image create bitmap i1 -data $data1 -maskdata $data2 -foreground #112233 \
-background #445566
.c create image 100 100 -image i1
@@ -495,7 +465,7 @@ test imageBmap-10.2 {ImgBmapFree procedures, unlinking} -setup {
pack [canvas .c]
update
} -body {
- eval image delete [image names]
+ imageCleanup
image create bitmap i1 -data $data1 -maskdata $data2 -foreground #112233 \
-background #445566
.c create image 100 100 -image i1
@@ -534,14 +504,18 @@ test imageBmap-11.2 {ImgBmapDelete procedure} -body {
test imageBmap-12.1 {ImgBmapCmdDeletedProc procedure} -body {
image create bitmap i2 -file foo.bm -maskfile foo2.bm
rename i2 {}
- list [lsearch -exact [image names] i2] [catch {i2 foo} msg] $msg
+ list [lsearch -exact [imageNames] i2] [catch {i2 foo} msg] $msg
} -result {-1 1 {invalid command name "i2"}}
removeFile foo.bm
removeFile foo2.bm
-eval image delete [image names]
+imageFinish
# cleanup
cleanupTests
return
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/imgPNG.test b/tests/imgPNG.test
index 1d38ce6..7fb2622 100644
--- a/tests/imgPNG.test
+++ b/tests/imgPNG.test
@@ -8,12 +8,13 @@
# Copyright (c) 2008 Donal K. Fellows
# All rights reserved.
#
-# RCS: @(#) $Id: imgPNG.test,v 1.1 2008/12/28 13:08:38 dkf Exp $
+# RCS: @(#) $Id: imgPNG.test,v 1.2 2009/01/13 01:46:06 patthoyts Exp $
package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
+imageInit
namespace eval png {
variable encoded
@@ -62,7 +63,7 @@ test png-1.4 {reading basic images; alpha} -setup {
}
namespace delete png
-image delete {*}[image names]
+imageFinish
cleanupTests
return
diff --git a/tests/imgPPM.test b/tests/imgPPM.test
index 4e33843..38cdbd1 100644
--- a/tests/imgPPM.test
+++ b/tests/imgPPM.test
@@ -6,14 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: imgPPM.test,v 1.11 2008/08/17 19:40:33 aniap Exp $
+# RCS: @(#) $Id: imgPPM.test,v 1.12 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
# Note that we do not use [tcltest::makeFile] because it is
# only suitable for text files
@@ -164,7 +164,7 @@ test imgPPM-4.1 {StringReadPPM procedure, data too short [Bug 1822391]} -body {
image delete I
} -returnCodes error -result {truncated PPM data}
-eval image delete [image names]
+imageFinish
# cleanup
catch {file delete test.ppm}
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index ed4b23a..ee567ca 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -10,7 +10,7 @@
#
# Author: Paul Mackerras (paulus@cs.anu.edu.au)
#
-# RCS: @(#) $Id: imgPhoto.test,v 1.34 2008/08/28 15:36:16 dkf Exp $
+# RCS: @(#) $Id: imgPhoto.test,v 1.35 2009/01/13 01:46:06 patthoyts Exp $
package require tcltest 2.2
namespace import ::tcltest::*
@@ -52,7 +52,7 @@ proc checkImgTransLoop {img script1 script2} {
return $result
}
-image delete {*}[image names]
+imageInit
set README [makeFile {
README -- Tk test suite design document.
} README-imgPhoto]
@@ -113,16 +113,16 @@ test imgPhoto-1.11 {options for photo images - error case} -body {
} -returnCodes error -result {value for "-format" missing}
test imgPhoto-2.1 {ImgPhotoCreate procedure} -setup {
- image delete {*}[image names]
+ imageCleanup
} -body {
catch {image create photo -blah blah}
- image names
+ imageNames
} -result {}
test imgPhoto-2.2 {ImgPhotoCreate procedure} -setup {
- image delete {*}[image names]
+ imageCleanup
} -body {
image create photo image1
- list [info commands image1] [image names] \
+ list [info commands image1] [imageNames] \
[image width image1] [image height image1]
} -cleanup {
image delete image1
@@ -805,7 +805,7 @@ test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} -constraints {
} -setup {
destroy .c
pack [canvas .c]
- image delete {*}[image names]
+ imageCleanup
} -body {
image create photo photo1 -file $teapotPhotoFile
.c create image 0 0 -image photo1 -tags photo1.1
@@ -826,7 +826,7 @@ test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} -constraints {
test imgPhoto-6.1 {ImgPhotoDisplay procedure, blank display} -setup {
destroy .c
pack [canvas .c]
- image delete {*}[image names]
+ imageCleanup
} -body {
image create photo photo1 -width 10 -height 10
photo1 blank
@@ -842,7 +842,7 @@ test imgPhoto-7.1 {ImgPhotoFree procedure, resource freeing} -constraints {
} -setup {
destroy .c
pack [canvas .c]
- image delete {*}[image names]
+ imageCleanup
} -body {
image create photo photo1 -file $teapotPhotoFile
.c create image 0 0 -image photo1 -anchor nw
@@ -856,7 +856,7 @@ test imgPhoto-7.2 {ImgPhotoFree procedures, unlinking} -constraints {
hasTeapotPhoto
} -setup {
deleteWindows
- image delete {*}[image names]
+ imageCleanup
} -body {
image create photo photo1 -file $teapotPhotoFile
pack [canvas .c]
@@ -881,7 +881,7 @@ test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} -constraints {
hasTeapotPhoto
} -setup {
deleteWindows
- image delete {*}[image names]
+ imageCleanup
} -body {
image create photo photo1 -file $teapotPhotoFile
button .b1 -image photo1
@@ -919,7 +919,7 @@ test imgPhoto-8.3 {ImgPhotoDelete procedure, name cleanup} -body {
image delete photo2
photo1 copy photo2
} -returnCodes error -cleanup {
- image delete {*}[image names]
+ imageCleanup
} -result {image "photo2" doesn't exist or is not a photo image}
test imgPhoto-9.1 {ImgPhotoCmdDeletedProc procedure} -constraints {
@@ -927,11 +927,11 @@ test imgPhoto-9.1 {ImgPhotoCmdDeletedProc procedure} -constraints {
} -body {
image create photo photo2 -file $teapotPhotoFile
rename photo2 {}
- list [lsearch -exact [image names] photo2] [catch {photo2 foo} msg] $msg
+ list [lsearch -exact [imageNames] photo2] [catch {photo2 foo} msg] $msg
} -result {-1 1 {invalid command name "photo2"}}
test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} -setup {
- image delete {*}[image names]
+ imageCleanup
} -body {
image create photo photo1
photo1 put "{#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000}" -to 0 0
@@ -940,13 +940,13 @@ test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} -setup {
} -result {{0 255 0} {0 255 0} {255 0 0}}
test imgPhoto-11.1 {Tk_FindPhoto} -setup {
- image delete {*}[image names]
+ imageCleanup
} -body {
image create bitmap i1
image create photo photo1
photo1 copy i1
} -cleanup {
- image delete {*}[image names]
+ imageCleanup
} -returnCodes error -result {image "i1" doesn't exist or is not a photo image}
test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} -constraints hasTeapotPhoto -body {
@@ -959,7 +959,7 @@ test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} -constraints hasTeapotPhoto -body {
} -result {{19 92 192} {169 117 90} 512 512 {19 92 192}}
test imgPhoto-13.1 {check separation of images in different interpreters} -setup {
- image delete {*}[image names]
+ imageCleanup
set data {
R0lGODlhQgBkAPUAANbWxs7Wxs7OxsbOxsbGxsbGvb3Gvca9vcDAwL21vbW1vbW1tbWtta2t
ta2ltaWltaWlraWctaWcrZycrZyUrZSUrZSMrZSMpYyMrYyMpYyEpYSEpYR7pYR7nHp7pYRz
@@ -1120,7 +1120,7 @@ test imgPhoto-16.1 {copying to self doesn't access freed memory} -setup {
catch {rename foreachPixel {}}
catch {rename checkImgTrans {}}
catch {rename checkImgTransLoop {}}
-image delete {*}[image names]
+imageFinish
# cleanup
removeFile README-imgPhoto
diff --git a/tests/menu.test b/tests/menu.test
index 1b8cc26..dccdf52 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -5,12 +5,13 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: menu.test,v 1.22 2008/08/13 23:57:05 aniap Exp $
+# RCS: @(#) $Id: menu.test,v 1.23 2009/01/13 01:46:06 patthoyts Exp $
package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
+imageInit
# find the earth.gif file for use in these tests (tests 2.*)
set earthPhotoFile [file join [file dirname [info script]] earth.gif]
@@ -2265,7 +2266,7 @@ test menu-7.8 {UnhookCascadeEntry} -setup {
list [destroy .m1] [destroy .m2]
} -returnCodes ok -result {{} {}}
test menu-7.9 {UnhookCascadeEntry} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
menu .m2
@@ -2275,7 +2276,7 @@ test menu-7.9 {UnhookCascadeEntry} -setup {
} -returnCodes ok
test menu-8.1 {DestroyMenuEntry} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
menu .m2
@@ -2283,7 +2284,7 @@ test menu-8.1 {DestroyMenuEntry} -setup {
list [.m1 delete 1] [destroy .m1 .m2]
} -result {{} {}}
test menu-8.2 {DestroyMenuEntry} -constraints hasEarthPhoto -setup {
- deleteWindows
+ deleteWindows
catch {image delete image1a}
} -body {
image create photo image1a -file $earthPhotoFile
@@ -2292,16 +2293,19 @@ test menu-8.2 {DestroyMenuEntry} -constraints hasEarthPhoto -setup {
list [.m1 delete 1] [destroy .m1] [image delete image1a]
} -result {{} {} {}}
test menu-8.3 {DestroyMenuEntry} -constraints testImageType -setup {
- deleteWindows
- catch {eval image delete [image names]}
+ deleteWindows
+ imageCleanup
} -body {
image create test image1
image create test image2
menu .m1
.m1 add checkbutton -image image1 -selectimage image2
.m1 invoke 1
- list [.m1 delete 1] [destroy .m1] [eval image delete [image names]]
-} -result {{} {} {}}
+ list [.m1 delete 1] [destroy .m1]
+} -cleanup {
+ imageCleanup
+ deleteWindows
+} -result {{} {}}
test menu-8.4 {DestroyMenuEntry} -setup {
destroy .m1
} -body {
@@ -2599,31 +2603,31 @@ test menu-11.16 {ConfigureMenuEntry} -setup {
deleteWindows
} -result {}
test menu-11.17 {ConfigureMenuEntry} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add checkbutton
list [.m1 entryconfigure 1 -onvalue "test"] [.m1 entrycget 1 -onvalue]
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {{} test}
test menu-11.18 {ConfigureMenuEntry} -constraints testImageType -setup {
- deleteWindows
- catch {image delete image1}
+ deleteWindows
+ imageCleanup
} -body {
menu .m1
.m1 add command
image create test image1
.m1 entryconfigure 1 -image image1
} -cleanup {
- deleteWindows
- image delete image1
+ deleteWindows
+ imageCleanup
} -result {}
test menu-11.19 {ConfigureMenuEntry} -constraints {
- testImageType hasEarthPhoto
+ testImageType hasEarthPhoto
} -setup {
- deleteWindows
- catch {image delete image1 image2}
+ deleteWindows
+ imageCleanup
} -body {
image create test image1
image create photo image2 -file $earthPhotoFile
@@ -2631,14 +2635,14 @@ test menu-11.19 {ConfigureMenuEntry} -constraints {
.m1 add command -image image1
.m1 entryconfigure 1 -image image2
} -cleanup {
- deleteWindows
- image delete image1 image2
+ deleteWindows
+ imageCleanup
} -result {}
test menu-11.20 {ConfigureMenuEntry} -constraints {
- testImageType hasEarthPhoto
+ testImageType hasEarthPhoto
} -setup {
- deleteWindows
- catch {image delete image1 image2}
+ deleteWindows
+ imageCleanup
} -body {
image create photo image1 -file $earthPhotoFile
image create test image2
@@ -2646,14 +2650,14 @@ test menu-11.20 {ConfigureMenuEntry} -constraints {
.m1 add checkbutton -image image1
.m1 entryconfigure 1 -selectimage image2
} -cleanup {
- deleteWindows
- image delete image1 image2
+ deleteWindows
+ imageCleanup
} -result {}
test menu-11.21 {ConfigureMenuEntry} -constraints {
- testImageType hasEarthPhoto
+ testImageType hasEarthPhoto
} -setup {
- deleteWindows
- catch {image delete image1 image2 image3}
+ deleteWindows
+ imageCleanup
} -body {
image create photo image1 -file $earthPhotoFile
image create test image2
@@ -2662,13 +2666,13 @@ test menu-11.21 {ConfigureMenuEntry} -constraints {
.m1 add checkbutton -image image1 -selectimage image2
.m1 entryconfigure 1 -selectimage image3
} -cleanup {
- deleteWindows
- image delete image1 image2 image3
+ deleteWindows
+ imageCleanup
} -result {}
test menu-12.1 {ConfigureMenuCloneEntries} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 clone .m2
@@ -2678,10 +2682,10 @@ test menu-12.1 {ConfigureMenuCloneEntries} -setup {
.m1 add command -label "test2"
.m1 entryconfigure 1 -gork "foo"
} -cleanup {
- deleteWindows
+ deleteWindows
} -returnCodes error -result {unknown option "-gork"}
test menu-12.2 {ConfigureMenuCloneEntries} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 clone .m2
@@ -2690,20 +2694,20 @@ test menu-12.2 {ConfigureMenuCloneEntries} -setup {
menu .m4
.m1 entryconfigure 1 -menu .m4
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {}
test menu-12.3 {ConfigureMenuCloneEntries} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 clone .m2
.m1 add cascade -label dummy
.m1 entryconfigure dummy -menu .m3
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {}
test menu-12.4 {ConfigureMenuCloneEntries} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add cascade -label File -menu .m1.foo
@@ -2712,12 +2716,12 @@ test menu-12.4 {ConfigureMenuCloneEntries} -setup {
.m1 clone .m2
.m1 entryconfigure File -state disabled
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {}
test menu-13.1 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "active"
@@ -2726,10 +2730,10 @@ test menu-13.1 {TkGetMenuIndex} -setup {
.m1 activate 2
.m1 entrycget active -label
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {test2}
test menu-13.2 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "last"
@@ -2738,10 +2742,10 @@ test menu-13.2 {TkGetMenuIndex} -setup {
.m1 activate 2
.m1 entrycget last -label
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {test3}
test menu-13.3 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "last"
@@ -2750,28 +2754,28 @@ test menu-13.3 {TkGetMenuIndex} -setup {
.m1 activate 2
.m1 entrycget end -label
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {test3}
test menu-13.4 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "test"
list [.m1 insert last command -label "test2"] [.m1 entrycget last -label]
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {{} test2}
test menu-13.5 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "test"
list [.m1 insert end command -label "test2"] [.m1 entrycget end -label]
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {{} test2}
test menu-13.6 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "active"
@@ -2780,11 +2784,11 @@ test menu-13.6 {TkGetMenuIndex} -setup {
.m1 activate 2
.m1 entrycget none -label
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {}
#test menu-13.7 - Need to add @test here.
test menu-13.7 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "active"
@@ -2792,10 +2796,10 @@ test menu-13.7 {TkGetMenuIndex} -setup {
.m1 add command -label "test3"
.m1 entrycget 1 -label
} -cleanup {
- deleteWindows
+ deleteWindows
} -result {active}
test menu-13.8 {TkGetMenuIndex} -setup {
- deleteWindows
+ deleteWindows
} -body {
menu .m1
.m1 add command -label "active"
@@ -3809,10 +3813,11 @@ test menu-35.1 {menu -underline string overruns Bug 1599877} -setup {
} -result {}
# cleanup
+imageFinish
deleteWindows
cleanupTests
return
-
-
-
+# Local variables:
+# mode: tcl
+# End:
diff --git a/tests/menuDraw.test b/tests/menuDraw.test
index 406925a..c772fac 100644
--- a/tests/menuDraw.test
+++ b/tests/menuDraw.test
@@ -5,12 +5,13 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: menuDraw.test,v 1.11 2008/08/21 11:19:33 aniap Exp $
+# RCS: @(#) $Id: menuDraw.test,v 1.12 2009/01/13 01:46:06 patthoyts Exp $
package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test
+imageInit
test menuDraw-1.1 {TkMenuInitializeDrawingFields} -setup {
deleteWindows
@@ -325,7 +326,7 @@ test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending}
testImageType
} -setup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -body {
image create test image1
image create test image2
@@ -334,13 +335,15 @@ test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending}
.m1 invoke 1
set tearoff [tk::TearOffMenu .m1 40 40]
update idletasks
- list [image delete image2] [destroy .m1] [eval image delete [image names]]
-} -result {{} {} {}}
+ list [image delete image2] [destroy .m1]
+} -cleanup {
+ imageCleanup
+} -result {{} {}}
test menuDraw-11.2 {TkMenuSelectImageProc - entry selected; redraw pending} -constraints {
testImageType
} -setup {
deleteWindows
- catch {eval image delete [image names]}
+ imageCleanup
} -body {
image create test image1
image create test image2
@@ -348,13 +351,15 @@ test menuDraw-11.2 {TkMenuSelectImageProc - entry selected; redraw pending} -con
.m1 add checkbutton -image image1 -selectimage image2
.m1 invoke 1
set tearoff [tk::TearOffMenu .m1 40 40]
- list [image delete image2] [destroy .m1] [eval image delete [image names]]
-} -result {{} {} {}}
+ list [image delete image2] [destroy .m1]
+} -cleanup {
+ imageCleanup
+} -result {{} {}}
test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} -constraints {
testImageType
} -setup {
deleteWindows
- catch {eval image delete [image names]}
+ imageCleanup
} -body {
image create test image1
image create test image2
@@ -362,8 +367,10 @@ test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} -constraints {
.m1 add checkbutton -image image1 -selectimage image2
set tearoff [tk::TearOffMenu .m1 40 40]
update idletasks
- list [image delete image2] [destroy .m1] [eval image delete [image names]]
-} -result {{} {} {}}
+ list [image delete image2] [destroy .m1]
+} -cleanup {
+ imageCleanup
+} -result {{} {}}
#Don't know how to test missing tkwin in DisplayMenu
test menuDraw-12.1 {DisplayMenu - menubar background} -constraints unix -setup {
@@ -702,7 +709,11 @@ test menuDraw-17.2 {AdjustMenuCoords - menu} -constraints {
} -result {}
# cleanup
+imageFinish
deleteWindows
cleanupTests
return
+# Local variables:
+# mode: tcl
+# End:
diff --git a/tests/menubut.test b/tests/menubut.test
index 4932c31..17bf013 100644
--- a/tests/menubut.test
+++ b/tests/menubut.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: menubut.test,v 1.12 2008/08/18 16:09:10 aniap Exp $
+# RCS: @(#) $Id: menubut.test,v 1.13 2009/01/13 01:46:06 patthoyts Exp $
# XXX This test file is woefully incomplete right now. If any part
# XXX of a procedure has tests then the whole procedure has tests,
@@ -16,6 +16,7 @@ package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test
+imageInit
# Create entries in the option database to be sure that geometry options
# like border width have predictable values.
@@ -455,20 +456,20 @@ test menubutton-4.7 {ConfigureMenuButton procedure} -constraints {
testImageType
} -setup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -body {
image create test image1
button .mb1 -image image1
.mb1 configure -height 0.5x
} -cleanup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -returnCodes error -result {bad screen distance "0.5x"}
test menubutton-4.8 {ConfigureMenuButton procedure} -constraints {
testImageType
} -setup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -body {
image create test image1
button .mb1 -image image1
@@ -476,7 +477,7 @@ test menubutton-4.8 {ConfigureMenuButton procedure} -constraints {
return $errorInfo
} -cleanup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -result {bad screen distance "0.5x"
(processing -height option)
invoked from within
@@ -555,7 +556,7 @@ test menubutton-7.1 {ComputeMenuButtonGeometry procedure} -constraints {
list [winfo reqwidth .mb] [winfo reqheight .mb]
} -cleanup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -result {38 23}
test menubutton-7.2 {ComputeMenuButtonGeometry procedure} -constraints {
testImageType
@@ -568,7 +569,7 @@ test menubutton-7.2 {ComputeMenuButtonGeometry procedure} -constraints {
list [winfo reqwidth .mb] [winfo reqheight .mb]
} -cleanup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -result {36 21}
test menubutton-7.3 {ComputeMenuButtonGeometry procedure} -constraints {
testImageType
@@ -581,7 +582,7 @@ test menubutton-7.3 {ComputeMenuButtonGeometry procedure} -constraints {
list [winfo reqwidth .mb] [winfo reqheight .mb]
} -cleanup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -result {34 19}
test menubutton-7.4 {ComputeMenuButtonGeometry procedure} -constraints {
testImageType
@@ -595,7 +596,7 @@ test menubutton-7.4 {ComputeMenuButtonGeometry procedure} -constraints {
list [winfo reqwidth .mb] [winfo reqheight .mb]
} -cleanup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -result {48 23}
test menubutton-7.5 {ComputeMenuButtonGeometry procedure} -constraints {
testImageType
@@ -609,7 +610,7 @@ test menubutton-7.5 {ComputeMenuButtonGeometry procedure} -constraints {
list [winfo reqwidth .mb] [winfo reqheight .mb]
} -cleanup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -result {38 38}
test menubutton-7.6 {ComputeMenuButtonGeometry procedure} -setup {
deleteWindows
@@ -716,7 +717,7 @@ test menubutton-7.14 {ComputeMenuButtonGeometry procedure} -constraints {
list [winfo reqwidth .mb] [winfo reqheight .mb]
} -cleanup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -result {64 23}
test menubutton-7.15 {ComputeMenuButtonGeometry procedure} -constraints {
testImageType win nonPortable
@@ -733,7 +734,7 @@ test menubutton-7.15 {ComputeMenuButtonGeometry procedure} -constraints {
list [winfo reqwidth .mb] [winfo reqheight .mb]
} -cleanup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -result {65 23}
@@ -752,10 +753,12 @@ test menubutton-8.1 {menubutton vs hidden commands} -body {
deleteWindows
option clear
+imageFinish
# cleanup
cleanupTests
return
-
-
+# Local variables:
+# mode: tcl
+# End: \ No newline at end of file
diff --git a/tests/textImage.test b/tests/textImage.test
index e0fc05b..8cb717b 100644
--- a/tests/textImage.test
+++ b/tests/textImage.test
@@ -7,12 +7,13 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textImage.test,v 1.12 2008/08/28 08:52:06 aniap Exp $
+# RCS: @(#) $Id: textImage.test,v 1.13 2009/01/13 01:46:06 patthoyts Exp $
package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
+imageInit
# One time setup. Create a font to insure the tests are font metric invariant.
destroy .t
@@ -461,12 +462,13 @@ test textImage-5.1 {peer widget images} -setup {
# cleanup
destroy .t
-foreach image [image names] {image delete $image}
font delete test_font
+imageFinish
# cleanup
cleanupTests
return
-
-
+# Local variables:
+# mode: tcl
+# End:
diff --git a/tests/unixButton.test b/tests/unixButton.test
index 14ff0e5..5f50bbf 100644
--- a/tests/unixButton.test
+++ b/tests/unixButton.test
@@ -8,12 +8,13 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: unixButton.test,v 1.8 2008/08/18 16:09:10 aniap Exp $
+# RCS: @(#) $Id: unixButton.test,v 1.9 2009/01/13 01:46:06 patthoyts Exp $
package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test
+imageInit
# Create entries in the option database to be sure that geometry options
# like border width have predictable values.
@@ -41,7 +42,7 @@ test unixbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints {
unix testImageType
} -setup {
deleteWindows
- eval image delete [image names]
+ imageCleanup
} -body {
image create test image1
image1 changed 0 0 0 0 60 40
@@ -247,6 +248,10 @@ test unixbutton-2.1 {disabled coloring check, bug 669595} -constraints {
# cleanup
+imageFinish
cleanupTests
return
+# Local variables:
+# mode: tcl
+# End:
diff --git a/tests/winButton.test b/tests/winButton.test
index a383433..cd5cf57 100644
--- a/tests/winButton.test
+++ b/tests/winButton.test
@@ -8,18 +8,18 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: winButton.test,v 1.13 2008/08/30 21:52:26 aniap Exp $
+# RCS: @(#) $Id: winButton.test,v 1.14 2009/01/13 01:46:06 patthoyts Exp $
package require tcltest 2.2
namespace import ::tcltest::*
tcltest::configure {*}$argv
tcltest::loadTestedCommands
+imageInit
proc bogusTrace args {
error "trace aborted"
}
option clear
-eval image delete [image names]
# ----------------------------------------------------------------------
@@ -188,6 +188,7 @@ test winbutton-1.9 {TkpComputeButtonGeometry procedure} -constraints win -setup
} -result {23 33}
# cleanup
+imageFinish
deleteWindows
cleanupTests
return
generated by cgit v0.12 at 2024-11-08 04:53:47 (GMT)