summaryrefslogtreecommitdiffstats
path: root/tests/image.test
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2000-11-29 15:47:04 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2000-11-29 15:47:04 (GMT)
commite16059b4672ebbe9ff5cc2b37006b05dd8c1c380 (patch)
treeb7941ad7c36543d32f04b86d132bcac9268b3b8b /tests/image.test
parentb5702fc7b79150b86cccbae5cb5d1f69d0ca505e (diff)
downloadtk-e16059b4672ebbe9ff5cc2b37006b05dd8c1c380.zip
tk-e16059b4672ebbe9ff5cc2b37006b05dd8c1c380.tar.gz
tk-e16059b4672ebbe9ff5cc2b37006b05dd8c1c380.tar.bz2
A better fix for #120819 (all it needed was some Tcl_Preserve()s)
which also requires no documentation changes - the behaviour is now what you would predict from existing docs (as opposed to a crash!)
Diffstat (limited to 'tests/image.test')
-rw-r--r--tests/image.test35
1 files changed, 16 insertions, 19 deletions
diff --git a/tests/image.test b/tests/image.test
index 296eedf..cd6cb21 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.5 2000/11/23 13:50:10 dkf Exp $
+# RCS: @(#) $Id: image.test,v 1.6 2000/11/29 15:47:05 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -80,9 +80,20 @@ test image-1.9 {Tk_ImageCmd procedure, "create" option} {
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} {
- list [catch {image create test .} msg] $msg
-} {1 {image names cannot start with period symbols: "." is illegal}}
+test image-1.10 {Tk_ImageCmd procedure, "create" option with "." as name} {
+ catch {removeFile script}
+ set fd [open script w]
+ puts $fd {
+ 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
+ set x
+} {0 {1 {this isn't a Tk applicationNULL main window}}}
+# I don't like the error message!
test image-2.1 {Tk_ImageCmd procedure, "delete" option} {
list [catch {image delete} msg] $msg
@@ -374,20 +385,6 @@ destroy .c
eval image delete [image names]
# cleanup
+catch {removeFile script}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-