diff options
author | dgp <dgp@users.sourceforge.net> | 2007-05-14 20:58:24 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2007-05-14 20:58:24 (GMT) |
commit | 63b954a5775049b63f7067e80d9c1b31c8176222 (patch) | |
tree | 288d4d74decb1ae3a9c5616c310ea88b3b8bee31 /tests | |
parent | e34b1b4d9d3de8cc8c9af59dc8e6927c0af02283 (diff) | |
download | tk-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.tcl | 1 | ||||
-rw-r--r-- | tests/image.test | 34 |
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] |