From 8fae2e48d382c746bf71132b4871acde852cf783 Mon Sep 17 00:00:00 2001
From: hobbs <hobbs>
Date: Tue, 3 Apr 2001 04:40:31 +0000
Subject: 	* 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]

---
 generic/tkCanvas.c | 37 +++++++++++++++++++------------------
 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
-- 
cgit v0.12