diff options
| -rw-r--r-- | generic/tkCanvas.c | 37 | ||||
| -rw-r--r-- | tests/canvas.test | 26 |
2 files changed, 44 insertions, 19 deletions
diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c index 0820e02..48cd329 100644 --- a/generic/tkCanvas.c +++ b/generic/tkCanvas.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvas.c,v 1.15 2000/11/22 01:49:37 ericm Exp $ + * RCS: @(#) $Id: tkCanvas.c,v 1.16 2001/04/03 04:40:31 hobbs Exp $ */ /* #define USE_OLD_TAG_SEARCH 1 */ @@ -1929,14 +1929,10 @@ DestroyCanvas(memPtr) { TkCanvas *canvasPtr = (TkCanvas *) memPtr; Tk_Item *itemPtr; +#ifndef USE_OLD_TAG_SEARCH + TagSearchExpr *expr, *next; +#endif - if (canvasPtr->tkwin != NULL) { - Tcl_DeleteCommandFromToken(canvasPtr->interp, canvasPtr->widgetCmd); - } - if (canvasPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr); - } - /* * Free up all of the items in the canvas. */ @@ -1963,15 +1959,11 @@ DestroyCanvas(memPtr) Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC); } #ifndef USE_OLD_TAG_SEARCH - { - TagSearchExpr *expr, *next; - - expr = canvasPtr->bindTagExprs; - while (expr) { - next = expr->next; - TagSearchExprDestroy(expr); - expr = next; - } + expr = canvasPtr->bindTagExprs; + while (expr) { + next = expr->next; + TagSearchExprDestroy(expr); + expr = next; } #endif Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler); @@ -2447,7 +2439,16 @@ CanvasEventProc(clientData, eventPtr) canvasPtr->flags |= REDRAW_BORDERS; } } else if (eventPtr->type == DestroyNotify) { - DestroyCanvas((char *) canvasPtr); + if (canvasPtr->tkwin != NULL) { + canvasPtr->tkwin = NULL; + Tcl_DeleteCommandFromToken(canvasPtr->interp, + canvasPtr->widgetCmd); + } + if (canvasPtr->flags & REDRAW_PENDING) { + Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr); + } + Tcl_EventuallyFree((ClientData) canvasPtr, + (Tcl_FreeProc *) DestroyCanvas); } else if (eventPtr->type == ConfigureNotify) { canvasPtr->flags |= UPDATE_SCROLLBARS; diff --git a/tests/canvas.test b/tests/canvas.test index 9a58a64..5029c0a 100644 --- a/tests/canvas.test +++ b/tests/canvas.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-2000 Ajuba Solutions. # All rights reserved. # -# RCS: @(#) $Id: canvas.test,v 1.11 2001/03/30 07:11:44 hobbs Exp $ +# RCS: @(#) $Id: canvas.test,v 1.12 2001/04/03 04:40:31 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -387,6 +387,30 @@ test canvas-12.2 {canvas mm obj, patch SF-403327, 102471} { incr val } {12} +proc kill_canvas {w} { + destroy $w + pack [canvas $w -height 200 -width 200] -fill both -expand yes + update idle + $w create rectangle 80 80 120 120 -fill blue -tags blue + # bind a button press to re-build the canvas + $w bind blue <ButtonRelease-1> [subst { + [lindex [info level 0] 0] $w + append ::x ok + } + ] +} + +test canvas-13.1 {canvas delete during event, SF bug-228024} { + kill_canvas .c + set ::x {} + # do this many times to improve chances of triggering the crash + for {set i 0} {$i < 30} {incr i} { + event generate .c <1> -x 100 -y 100 + event generate .c <ButtonRelease-1> -x 100 -y 100 + } + set ::x +} okokokokokokokokokokokokokokokokokokokokokokokokokokokokokok + # cleanup ::tcltest::cleanupTests return |