summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>2001-04-03 04:40:31 (GMT)
committerhobbs <hobbs>2001-04-03 04:40:31 (GMT)
commit9eb72b9d79626c34c27d968c36568bce309c741f (patch)
tree6241c435bfeb41c37c66950bd67cc0f216562d1c
parent8c7404c8e44cbe53b2b83dedcd302ec40497335e (diff)
downloadtk-9eb72b9d79626c34c27d968c36568bce309c741f.zip
tk-9eb72b9d79626c34c27d968c36568bce309c741f.tar.gz
tk-9eb72b9d79626c34c27d968c36568bce309c741f.tar.bz2
* tests/canvas.test: test of canvas delete during event
* generic/tkCanvas.c (DestroyCanvas, CanvasEventProc): fixed the canvas to survive deletion during event processing. [Bug #228024]
-rw-r--r--generic/tkCanvas.c37
-rw-r--r--tests/canvas.test26
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