diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2003-01-22 14:32:59 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2003-01-22 14:32:59 (GMT) |
| commit | 52da74a40ec7d58b961beb5f30fa40976bd71587 (patch) | |
| tree | d36caa6a34005845deeb4fa8eb884defa7bafe80 /tests/image.test | |
| parent | b2bfe80a4f86bf9cd9235f5cd97e3de7181ec0e9 (diff) | |
| download | tk-52da74a40ec7d58b961beb5f30fa40976bd71587.zip tk-52da74a40ec7d58b961beb5f30fa40976bd71587.tar.gz tk-52da74a40ec7d58b961beb5f30fa40976bd71587.tar.bz2 | |
* generic/tkImage.c (Tk_ImageObjCmd): Added check to make sure
that you're not creating an image named the same as .'s command,
which refixes 220891, even when the name of the command has been
changed with 'rename'. The error message is better too.
* generic/tkFrame.c (TkToplevelWindowForCommand): Added way of
mapping from command names to tkwins-for-toplevels.
* tests/image.test (image-1.10,image-1.11): Updated to match new
error message and added test for the rename case.
* generic/tclInt.decls: Made TkToplevelWindowForCommand exported
privately.
Diffstat (limited to 'tests/image.test')
| -rw-r--r-- | tests/image.test | 17 |
1 files changed, 13 insertions, 4 deletions
diff --git a/tests/image.test b/tests/image.test index 384c38a..dd5d3dd 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.7 2002/07/13 21:52:34 dgp Exp $ +# RCS: @(#) $Id: image.test,v 1.8 2003/01/22 14:32:59 dkf Exp $ package require tcltest 2.1 namespace import -force tcltest::configure @@ -73,7 +73,7 @@ test image-1.9 {Tk_ImageCmd procedure, "create" option} testImageType { 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} { +test image-1.10 {Tk_ImageCmd procedure, "create" option with same name as main window} { set script [makeFile { update puts [list [catch {image create photo .} msg] $msg] @@ -82,8 +82,17 @@ test image-1.10 {Tk_ImageCmd procedure, "create" option with "." as name} { 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! +} {0 {1 {images may not be named the same as the main window}}} +test image-1.11 {Tk_ImageCmd procedure, "create" option with same name as main window after renaming} { + set script [makeFile { + update + puts [list [catch {rename . foo;image create photo foo} msg] $msg] + exit + } script] + set x [list [catch {exec [interpreter] <$script} msg] $msg] + removeFile script + set x +} {0 {1 {images may not be named the same as the main window}}} test image-2.1 {Tk_ImageCmd procedure, "delete" option} { list [catch {image delete} msg] $msg |