diff options
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] |