summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-05-14 20:58:24 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-05-14 20:58:24 (GMT)
commit63b954a5775049b63f7067e80d9c1b31c8176222 (patch)
tree288d4d74decb1ae3a9c5616c310ea88b3b8bee31 /tests
parente34b1b4d9d3de8cc8c9af59dc8e6927c0af02283 (diff)
downloadtk-63b954a5775049b63f7067e80d9c1b31c8176222.zip
tk-63b954a5775049b63f7067e80d9c1b31c8176222.tar.gz
tk-63b954a5775049b63f7067e80d9c1b31c8176222.tar.bz2
[Tk Bug 1712081]
* unix/Makefile.in: Updates to account for new and deleted files * win/Makefile.in: tkStubImg.c and tkOldTest.c. * win/makefile.bc: * win/makefile.vc: * generic/tkOldTest.c (new): New file used to create testing * generic/tkTest.c: commands for testing various Tk * tests/constraints.tcl: legacy interfaces where a separate * tests/image.test: compilation unit is needed in order to #define suitable macros during compilation. Only the effect of USE_OLD_IMAGE on Tk_CreateImageType() is currently tested, but more similar testing commands can be added to this same file. New constraint defined to detect presence of the image type provided by the new testing code, and a few tests added to exercise it. Having USE_OLD_IMAGE support tested by the default test suite should reduce chance of a recurrence of this bug. * doc/CrtImgType.3: Revised docs to better indicate the legacy * doc/CrtPhImgFmt.3: nature of the interfaces supported by USE_OLD_IMAGE. * generic/tkDecls.h: make genstubs * generic/tkStubInit.c: * generic/tk.decls: Reworked USE_OLD_IMAGE support to use * generic/tk.h: the same support mechanisms both with * generic/tkStubImg.c (deleted):and without a stub-enabled build. In each case, route the legacy calls to Tk_CreateImageType and Tk_CreatePhotoImageFormat through the Tk_CreateOldImageType and Tk_CreateOldPhotoImageFormat routines. Add those routines to the public stub table so they're available to a stub-enabled extension. Remove the definition of Tk_InitImageArgs() and use a macro to convert any calls to it in source code into a comment. * generic/tkImage.c: Removed the MODULE_SCOPE declarations that * generic/tkImgPhoto.c: broke USE_OLD_IMAGE support.
Diffstat (limited to 'tests')
-rw-r--r--tests/constraints.tcl1
-rw-r--r--tests/image.test34
2 files changed, 33 insertions, 2 deletions
diff --git a/tests/constraints.tcl b/tests/constraints.tcl
index a3a6af3..94f7931 100644
--- a/tests/constraints.tcl
+++ b/tests/constraints.tcl
@@ -159,6 +159,7 @@ testConstraint noExceed [expr {
# constraints for testing facilities defined in the tktest executable...
testConstraint testImageType [expr {[lsearch [image types] test] >= 0}]
+testConstraint testOldImageType [expr {[lsearch [image types] oldtest] >= 0}]
testConstraint testbitmap [llength [info commands testbitmap]]
testConstraint testborder [llength [info commands testborder]]
testConstraint testcbind [llength [info commands testcbind]]
diff --git a/tests/image.test b/tests/image.test
index b0264f0..01951e3 100644
--- a/tests/image.test
+++ b/tests/image.test
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: image.test,v 1.13 2004/12/04 00:04:41 dkf Exp $
+# RCS: @(#) $Id: image.test,v 1.14 2007/05/14 20:58:27 dgp Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -177,13 +177,23 @@ test image-5.5 {Tk_ImageCmd procedure, "type" option} testImageType {
image delete myimage
list [catch {image type myimage} msg] $msg
} {1 {image "myimage" doesn't exist}}
+test image-5.6 {Tk_ImageCmd procedure, "type" option} testOldImageType {
+ image create oldtest myimage
+ image type myimage
+} {oldtest}
+test image-5.7 {Tk_ImageCmd procedure, "type" option} testOldImageType {
+ image create oldtest myimage
+ .c create image 50 50 -image myimage
+ image delete myimage
+ list [catch {image type myimage} msg] $msg
+} {1 {image "myimage" doesn't exist}}
test image-6.1 {Tk_ImageCmd procedure, "types" option} {
list [catch {image types x} msg] $msg
} {1 {wrong # args: should be "image types"}}
test image-6.2 {Tk_ImageCmd procedure, "types" option} testImageType {
lsort [image types]
-} {bitmap photo test}
+} {bitmap oldtest photo test}
test image-7.1 {Tk_ImageCmd procedure, "width" option} {
list [catch {image width} msg] $msg
@@ -377,6 +387,26 @@ test image-13.2 {DeleteImage procedure} testImageType {
lappend x | [image names] | [catch {image delete foo} msg] | $msg | [image names] |
} {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |}
+test image-13.3 {Tk_SizeOfImage procedure} testOldImageType {
+ eval image delete [image names]
+ image create oldtest foo -variable x
+ set result [list [image width foo] [image height foo]]
+ foo changed 0 0 0 0 85 60
+ lappend result [image width foo] [image height foo]
+} {30 15 85 60}
+
+test image-13.4 {DeleteImage procedure} testOldImageType {
+ .c delete all
+ eval image delete [image names]
+ image create oldtest foo -variable x
+ .c create image 50 50 -image foo -tags i1
+ .c create image 90 100 -image foo -tags i2
+ set x {}
+ image delete foo
+ lappend x | [image names] | [catch {image delete foo} msg] | $msg | [image names] |
+} {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |}
+
+
catch {image delete hidden}
set l [image names]
set h [interp hidden]