* Converted more files to tcltest and factored out common code.

1 files changed, 41 insertions, 52 deletions

diff --git a/tests/image.test b/tests/image.test
index cd6cb21..384c38a 100644
--- a/tests/image.test
+++ b/tests/image.test
@@ -7,25 +7,18 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: image.test,v 1.6 2000/11/29 15:47:05 dkf Exp $
+# RCS: @(#) $Id: image.test,v 1.7 2002/07/13 21:52:34 dgp Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
 
-if {[lsearch [image types] test] < 0} {
-    puts "This application hasn't been compiled with the \"test\" image"
-    puts "type, so I can't run this test.  Are you sure you're using"
-    puts "tktest instead of wish?"
-    ::tcltest::cleanupTests
-    return
-}
-
-foreach i [winfo children .] {
-    destroy $i
-}
-wm geometry . {}
-raise .
+namespace import -force tcltest::interpreter
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
 
 eval image delete [image names]
 canvas .c -highlightthickness 2
@@ -43,16 +36,16 @@ test image-1.3 {Tk_ImageCmd procedure, "create" option} {
 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} {
+test image-1.5 {Tk_ImageCmd procedure, "create" option} testImageType {
     list [image create test myimage] [image names]
 } {myimage myimage}
-test image-1.6 {Tk_ImageCmd procedure, "create" option} {
+test image-1.6 {Tk_ImageCmd procedure, "create" option} testImageType {
     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} {
+test image-1.7 {Tk_ImageCmd procedure, "create" option} testImageType {
     image delete myimage
     image create test myimage -variable x
     .c create image 100 50 -image myimage
@@ -63,7 +56,7 @@ test image-1.7 {Tk_ImageCmd procedure, "create" option} {
     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} {
+test image-1.8 {Tk_ImageCmd procedure, "create" option} testImageType {
     .c delete all
     image create test myimage -variable x
     .c create image 100 50 -image myimage
@@ -75,22 +68,19 @@ test image-1.8 {Tk_ImageCmd procedure, "create" option} {
     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} {
+test image-1.9 {Tk_ImageCmd procedure, "create" option} testImageType {
     .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 "." as name} {
-    catch {removeFile script}
-    set fd [open script w]
-    puts $fd {
+    set script [makeFile {
 	update
 	puts [list [catch {image create photo .} msg] $msg]
 	exit
-    }
-    close $fd
-    set x [list [catch {exec $::tcltest::tktest <script} msg] $msg]
-    file delete -force script
+    } script]
+    set x [list [catch {exec [interpreter] <$script} msg] $msg]
+    removeFile script
     set x
 } {0 {1 {this isn't a Tk applicationNULL main window}}}
 # I don't like the error message!
@@ -98,7 +88,7 @@ test image-1.10 {Tk_ImageCmd procedure, "create" option with "." as name} {
 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} {
+test image-2.2 {Tk_ImageCmd procedure, "delete" option} testImageType {
     .c delete all
     eval image delete [image names]
     image create test myimage
@@ -108,7 +98,7 @@ test image-2.2 {Tk_ImageCmd procedure, "delete" option} {
     image d myimage img2
     lappend result [image names]
 } {{img2 myimage} {}}
-test image-2.3 {Tk_ImageCmd procedure, "delete" option} {
+test image-2.3 {Tk_ImageCmd procedure, "delete" option} testImageType {
     .c delete all
     eval image delete [image names]
     image create test myimage
@@ -125,7 +115,7 @@ test image-3.2 {Tk_ImageCmd procedure, "height" option} {
 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} {
+test image-3.4 {Tk_ImageCmd procedure, "height" option} testImageType {
     image create test myimage
     set x [image h myimage]
     myimage changed 0 0 0 0 60 50
@@ -135,7 +125,7 @@ test image-3.4 {Tk_ImageCmd procedure, "height" option} {
 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} {
+test image-4.2 {Tk_ImageCmd procedure, "names" option} testImageType {
     .c delete all
     eval image delete [image names]
     image create test myimage
@@ -158,11 +148,11 @@ test image-5.2 {Tk_ImageCmd procedure, "type" option} {
 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} {
+test image-5.4 {Tk_ImageCmd procedure, "type" option} testImageType {
     image create test myimage
     image type myimage
 } {test}
-test image-5.5 {Tk_ImageCmd procedure, "type" option} {
+test image-5.5 {Tk_ImageCmd procedure, "type" option} testImageType {
     image create test myimage
     .c create image 50 50 -image myimage
     image delete myimage
@@ -172,7 +162,7 @@ test image-5.5 {Tk_ImageCmd procedure, "type" option} {
 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} {
+test image-6.2 {Tk_ImageCmd procedure, "types" option} testImageType {
     lsort [image types]
 } {bitmap photo test}
 
@@ -185,14 +175,14 @@ test image-7.2 {Tk_ImageCmd procedure, "width" option} {
 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} {
+test image-7.4 {Tk_ImageCmd procedure, "width" option} testImageType {
     image create test myimage
     set x [image w myimage]
     myimage changed 0 0 0 0 60 50
     list $x [image width myimage]
 } {30 60}
 
-test image-8.1 {Tk_ImageCmd procedure, "inuse" option} {
+test image-8.1 {Tk_ImageCmd procedure, "inuse" option} testImageType {
     catch {image delete myimage2}
     image create test myimage2
     set res {}
@@ -206,7 +196,7 @@ test image-8.1 {Tk_ImageCmd procedure, "inuse" option} {
 } [list 0 1]
     
 
-test image-9.1 {Tk_ImageChanged procedure} {
+test image-9.1 {Tk_ImageChanged procedure} testImageType {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -217,7 +207,7 @@ test image-9.1 {Tk_ImageChanged procedure} {
     update
     set x
 } {{foo display 5 6 7 8 30 30}}
-test image-9.2 {Tk_ImageChanged procedure} {
+test image-9.2 {Tk_ImageChanged procedure} testImageType {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -233,7 +223,7 @@ test image-9.2 {Tk_ImageChanged procedure} {
 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} {
+test image-10.2 {Tk_GetImage procedure} testImageType {
     image create test mytest
     catch {destroy .l}
     label .l -image mytest
@@ -243,7 +233,7 @@ test image-10.2 {Tk_GetImage procedure} {
     set result
 } {1 {image "mytest" doesn't exist}}
 
-test image-11.1 {Tk_FreeImage procedure} {
+test image-11.1 {Tk_FreeImage procedure} testImageType {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -257,7 +247,7 @@ test image-11.1 {Tk_FreeImage procedure} {
     update
     list [image names] $x
 } {foo {{foo free} {foo display 0 0 30 15 103 121}}}
-test image-11.2 {Tk_FreeImage procedure} {
+test image-11.2 {Tk_FreeImage procedure} testImageType {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -276,7 +266,7 @@ test image-11.2 {Tk_FreeImage procedure} {
 # Non-portable, apparently due to differences in rounding:
 
 test image-12.1 {Tk_RedrawImage procedure, redisplay area clipping} \
-	{nonPortable} {
+	{testImageType nonPortable} {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -288,7 +278,7 @@ test image-12.1 {Tk_RedrawImage procedure, redisplay area clipping} \
     set x
 } {{foo display 0 0 5 5 50 50}}
 test image-12.2 {Tk_RedrawImage procedure, redisplay area clipping} \
-	{nonPortable} {
+	{testImageType nonPortable} {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -300,7 +290,7 @@ test image-12.2 {Tk_RedrawImage procedure, redisplay area clipping} \
     set x
 } {{foo display 10 0 20 5 30 50}}
 test image-12.3 {Tk_RedrawImage procedure, redisplay area clipping} \
-	{nonPortable} {
+	{testImageType nonPortable} {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -312,7 +302,7 @@ test image-12.3 {Tk_RedrawImage procedure, redisplay area clipping} \
     set x
 } {{foo display 10 10 20 5 30 30}}
 test image-12.4 {Tk_RedrawImage procedure, redisplay area clipping} \
-	{nonPortable} {
+	{testImageType nonPortable} {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -324,7 +314,7 @@ test image-12.4 {Tk_RedrawImage procedure, redisplay area clipping} \
     set x
 } {{foo display 0 10 5 5 50 30}}
 test image-12.5 {Tk_RedrawImage procedure, redisplay area clipping} \
-	{nonPortable} {
+	{testImageType nonPortable} {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -336,7 +326,7 @@ test image-12.5 {Tk_RedrawImage procedure, redisplay area clipping} \
     set x
 } {{foo display 0 0 30 15 70 70}}
 test image-12.6 {Tk_RedrawImage procedure, redisplay area clipping} \
-	{nonPortable} {
+	{testImageType nonPortable} {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -348,7 +338,7 @@ test image-12.6 {Tk_RedrawImage procedure, redisplay area clipping} \
     set x
 } {{foo display 5 5 20 5 30 30}}
 
-test image-13.1 {Tk_SizeOfImage procedure} {
+test image-13.1 {Tk_SizeOfImage procedure} testImageType {
     eval image delete [image names]
     image create test foo -variable x
     set result [list [image width foo] [image height foo]]
@@ -356,7 +346,7 @@ test image-13.1 {Tk_SizeOfImage procedure} {
     lappend result [image width foo] [image height foo]
 } {30 15 85 60}
 
-test image-13.2 {DeleteImage procedure} {
+test image-13.2 {DeleteImage procedure} testImageType {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -385,6 +375,5 @@ destroy .c
 eval image delete [image names]
 
 # cleanup
-catch {removeFile script}
 ::tcltest::cleanupTests
 return