diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2000-11-29 15:47:04 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2000-11-29 15:47:04 (GMT) |
commit | e16059b4672ebbe9ff5cc2b37006b05dd8c1c380 (patch) | |
tree | b7941ad7c36543d32f04b86d132bcac9268b3b8b /tests/image.test | |
parent | b5702fc7b79150b86cccbae5cb5d1f69d0ca505e (diff) | |
download | tk-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.test | 35 |
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 - - - - - - - - - - - - - - - |