diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tkImage.c | 49 | ||||
| -rw-r--r-- | tests/image.test | 35 |
3 files changed, 65 insertions, 28 deletions
@@ -1,3 +1,12 @@ +2000-11-29 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + * tests/image.test (image-1.10): Improved this test, which + previously only worked if the command failed to delete the root + window, and caused *major* trouble otherwise... + * generic/tkImage.c (EventuallyDeleteImage): Created this function + so that images that get deleted during the creation of an image + won't cause a nasty core dump. Properly fixes bug #120819. + 2000-11-28 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/image.n: diff --git a/generic/tkImage.c b/generic/tkImage.c index 7952108..f8d5388 100644 --- a/generic/tkImage.c +++ b/generic/tkImage.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkImage.c,v 1.9 2000/11/28 11:16:04 dkf Exp $ + * RCS: @(#) $Id: tkImage.c,v 1.10 2000/11/29 15:47:05 dkf Exp $ */ #include "tkInt.h" @@ -69,6 +69,7 @@ typedef struct ImageMaster { * entry). */ Image *instancePtr; /* Pointer to first in list of instances * derived from this name. */ + int deleted; /* Flag set when image is being deleted */ } ImageMaster; typedef struct ThreadSpecificData { @@ -83,7 +84,8 @@ static Tcl_ThreadDataKey dataKey; * Prototypes for local procedures: */ -static void DeleteImage _ANSI_ARGS_((ImageMaster *masterPtr)); +static void DeleteImage _ANSI_ARGS_((ImageMaster *masterPtr)); +static void EventuallyDeleteImage _ANSI_ARGS_((ImageMaster *masterPtr)); /* *---------------------------------------------------------------------- @@ -251,6 +253,7 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) masterPtr->tablePtr = &winPtr->mainPtr->imageTable; masterPtr->hPtr = hPtr; masterPtr->instancePtr = NULL; + masterPtr->deleted = 0; Tcl_SetHashValue(hPtr, masterPtr); } else { /* @@ -290,15 +293,18 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) } args[objc] = NULL; } + Tcl_Preserve(masterPtr); if ((*typePtr->createProc)(interp, name, objc, args, typePtr, (Tk_ImageMaster) masterPtr, &masterPtr->masterData) != TCL_OK) { - DeleteImage(masterPtr); + EventuallyDeleteImage(masterPtr); + Tcl_Release(masterPtr); if (oldimage) { ckfree((char *) args); } return TCL_ERROR; } + Tcl_Release(masterPtr); if (oldimage) { ckfree((char *) args); } @@ -322,8 +328,7 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) "\" doesn't exist", (char *) NULL); return TCL_ERROR; } - masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); - DeleteImage(masterPtr); + DeleteImage((ImageMaster *) Tcl_GetHashValue(hPtr)); } break; } @@ -861,7 +866,7 @@ Tk_DeleteImage(interp, name) if (hPtr == NULL) { return; } - DeleteImage((ImageMaster *) Tcl_GetHashValue(hPtr)); + DeleteImage((ImageMaster *)Tcl_GetHashValue(hPtr)); } /* @@ -911,6 +916,34 @@ DeleteImage(masterPtr) /* *---------------------------------------------------------------------- * + * EventuallyDeleteImage -- + * + * Arrange for an image to be deleted when it is safe to do so. + * + * Results: + * None. + * + * Side effects: + * Image will get freed, though not until it is no longer + * Tcl_Preserve()d by anything. May be called multiple times on + * the same image without ill effects. + * + *---------------------------------------------------------------------- + */ + +static void +EventuallyDeleteImage(masterPtr) + ImageMaster *masterPtr; /* Pointer to main data structure for image. */ +{ + if (!masterPtr->deleted) { + masterPtr->deleted = 1; + Tcl_EventuallyFree(masterPtr, (Tcl_FreeProc *)DeleteImage); + } +} + +/* + *---------------------------------------------------------------------- + * * TkDeleteAllImages -- * * This procedure is called when an application is deleted. It @@ -934,12 +967,10 @@ TkDeleteAllImages(mainPtr) { Tcl_HashSearch search; Tcl_HashEntry *hPtr; - ImageMaster *masterPtr; for (hPtr = Tcl_FirstHashEntry(&mainPtr->imageTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); - DeleteImage(masterPtr); + EventuallyDeleteImage((ImageMaster *) Tcl_GetHashValue(hPtr)); } Tcl_DeleteHashTable(&mainPtr->imageTable); } 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 - - - - - - - - - - - - - - - |