* 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]

1 files changed, 25 insertions, 1 deletions

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