* generic/tkWindow.c (Tk_DestroyWindow,

	DeleteWindowsExitProc): Add TkHalfdeadWindow
	type and halfdeadWindowList to keep track
	of windows that were only partially deallocated
	before a call to exit. Finnish cleaning up
	these windows in DeleteWindowsExitProc.
	Keep track of cleanup status in Tk_DestroyWindow
	so that a window with a Destroy binding which
	calls exit will get fully destroyed.
	* tests/window.test: Add Tk_DestroyWindow tests
	for an assortment of half dead window cases.
	[Bug 630533]

3 files changed, 295 insertions, 29 deletions

diff --git a/ChangeLog b/ChangeLog
index 06d07af..39fb8c9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2002-11-14  Mo DeJong  <mdejong@users.sourceforge.net>
+
+	* generic/tkWindow.c (Tk_DestroyWindow,
+	DeleteWindowsExitProc): Add TkHalfdeadWindow
+	type and halfdeadWindowList to keep track
+	of windows that were only partially deallocated
+	before a call to exit. Finnish cleaning up
+	these windows in DeleteWindowsExitProc.
+	Keep track of cleanup status in Tk_DestroyWindow
+	so that a window with a Destroy binding which
+	calls exit will get fully destroyed.
+	* tests/window.test: Add Tk_DestroyWindow tests
+	for an assortment of half dead window cases.
+	[Bug 630533]
+
 2002-11-10  Daniel Steffen  <das@users.sourceforge.net>
 
 	* macosx/Wish.pbproj/project.pbxproj: fixed erroneous
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index d358cbf..dc75118 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.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: tkWindow.c,v 1.54 2002/09/02 19:16:23 hobbs Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.55 2002/11/14 17:30:20 mdejong Exp $
  */
 
 #include "tkPort.h"
@@ -22,6 +22,23 @@
 #include "tkUnixInt.h"
 #endif
 
+/* 
+ * Type used to keep track of Window objects that were
+ * only partically deallocated by Tk_DestroyWindow.
+ */
+
+#define HD_CLEANUP		1
+#define HD_FOCUS		2
+#define HD_MAIN_WIN		4
+#define HD_DESTROY_COUNT	8
+#define HD_DESTROY_EVENT	0x10
+
+typedef struct TkHalfdeadWindow {
+    int flags;
+    struct TkWindow *winPtr;
+    struct TkHalfdeadWindow *nextPtr;
+} TkHalfdeadWindow;
+
 
 typedef struct ThreadSpecificData {
     int numMainWindows;    /* Count of numver of main windows currently
@@ -29,6 +46,9 @@ typedef struct ThreadSpecificData {
     TkMainInfo *mainWindowList;
                            /* First in list of all main windows managed
 			    * by this thread. */
+    TkHalfdeadWindow *halfdeadWindowList;
+                           /* First in list of partially deallocated
+			    * windows. */
     TkDisplay *displayList;
                            /* List of all displays currently in use by 
 			    * the current thread. */
@@ -1207,7 +1227,9 @@ Tk_CreateWindowFromPath(interp, tkwin, pathName, screenName)
  * Tk_DestroyWindow --
  *
  *	Destroy an existing window.  After this call, the caller
- *	should never again use the token.
+ *	should never again use the token. Note that this function
+ *	can be reentered to destroy a window that was only
+ *	partially destroyed before a call to exit.
  *
  * Results:
  *	None.
@@ -1226,6 +1248,7 @@ Tk_DestroyWindow(tkwin)
     TkWindow *winPtr = (TkWindow *) tkwin;
     TkDisplay *dispPtr = winPtr->dispPtr;
     XEvent event;
+    TkHalfdeadWindow *halfdeadPtr, *prev_halfdeadPtr;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
 
@@ -1240,6 +1263,24 @@ Tk_DestroyWindow(tkwin)
     winPtr->flags |= TK_ALREADY_DEAD;
 
     /*
+     * Unless we are cleaning up a half dead
+     * window from DeleteWindowsExitProc,
+     * add this window to the half dead list.
+     */
+
+    if (tsdPtr->halfdeadWindowList &&
+	    (tsdPtr->halfdeadWindowList->flags & HD_CLEANUP) &&
+	    (tsdPtr->halfdeadWindowList->winPtr == winPtr)) {
+	halfdeadPtr = tsdPtr->halfdeadWindowList;
+    } else {
+	halfdeadPtr = (TkHalfdeadWindow *) ckalloc(sizeof(TkHalfdeadWindow));
+	halfdeadPtr->flags = 0;
+	halfdeadPtr->winPtr = winPtr;
+	halfdeadPtr->nextPtr = tsdPtr->halfdeadWindowList;
+	tsdPtr->halfdeadWindowList = halfdeadPtr;
+    }
+
+    /*
      * Some cleanup needs to be done immediately, rather than later,
      * because it needs information that will be destoyed before we
      * get to the main cleanup point.  For example, TkFocusDeadWindow
@@ -1248,28 +1289,28 @@ Tk_DestroyWindow(tkwin)
      * field will be NULL before the main cleanup point is reached.
      */
 
-    TkFocusDeadWindow(winPtr);
+    if (!(halfdeadPtr->flags & HD_FOCUS)) {
+	halfdeadPtr->flags |= HD_FOCUS;
+	TkFocusDeadWindow(winPtr);
+    }
 
     /*
      * If this is a main window, remove it from the list of main
      * windows.  This needs to be done now (rather than later with
      * all the other main window cleanup) to handle situations where
      * a destroy binding for a window calls "exit".  In this case
-     * the child window cleanup isn't complete when exit is called,
-     * so the reference count of its application doesn't go to zero
-     * when exit calls Tk_DestroyWindow on ".", so the main window
-     * doesn't get removed from the list and exit loops infinitely.
-     * Even worse, if "destroy ." is called by the destroy binding
-     * before calling "exit", "exit" will attempt to destroy
-     * mainPtr->winPtr, which no longer exists, and there may be a
-     * core dump.
+     * the child window cleanup isn't complete when exit is called.
+     * This situation is dealt with using the half dead window
+     * list. Windows that are half dead gets cleaned up during exit.
      *
      * Also decrement the display refcount so that if this is the
      * last Tk application in this process on this display, the display
      * can be closed and its data structures deleted.
      */
 
-    if (winPtr->mainPtr != NULL && winPtr->mainPtr->winPtr == winPtr) {
+    if (!(halfdeadPtr->flags & HD_MAIN_WIN) &&
+	    winPtr->mainPtr != NULL && winPtr->mainPtr->winPtr == winPtr) {
+	halfdeadPtr->flags |= HD_MAIN_WIN;
         dispPtr->refCount--;
 	if (tsdPtr->mainWindowList == winPtr->mainPtr) {
 	    tsdPtr->mainWindowList = winPtr->mainPtr->nextPtr;
@@ -1287,10 +1328,17 @@ Tk_DestroyWindow(tkwin)
     }
 
     /*
-     * Recursively destroy children.
+     * Recursively destroy children. Note that this child
+     * window block may need to be run multiple times
+     * in the case where a child window has a Destroy
+     * binding that calls exit.
      */
 
-    dispPtr->destroyCount++;
+    if (!(halfdeadPtr->flags & HD_DESTROY_COUNT)) {
+	halfdeadPtr->flags |= HD_DESTROY_COUNT;
+	dispPtr->destroyCount++;
+    }
+
     while (winPtr->childList != NULL) {
 	TkWindow *childPtr;
 	childPtr = winPtr->childList;
@@ -1300,8 +1348,8 @@ Tk_DestroyWindow(tkwin)
 	    /*
 	     * The child didn't remove itself from the child list, so
 	     * let's remove it here.  This can happen in some strange
-	     * conditions, such as when a Delete event handler for a
-	     * window deletes the window's parent.
+	     * conditions, such as when a Destroy event handler for a
+	     * window destroys the window's parent.
 	     */
 
 	    winPtr->childList = childPtr->nextPtr;
@@ -1342,7 +1390,10 @@ Tk_DestroyWindow(tkwin)
      * or generate the event.
      */
 
-    if (winPtr->pathName != NULL && !(winPtr->flags & TK_ANONYMOUS_WINDOW)) {
+    if (!(halfdeadPtr->flags & HD_DESTROY_EVENT) &&
+	    winPtr->pathName != NULL &&
+	    !(winPtr->flags & TK_ANONYMOUS_WINDOW)) {
+	halfdeadPtr->flags |= HD_DESTROY_EVENT;
 	if (winPtr->window == None) {
 	    Tk_MakeWindowExist(tkwin);
 	}
@@ -1357,6 +1408,30 @@ Tk_DestroyWindow(tkwin)
     }
 
     /*
+     * No additional bindings that could call exit
+     * should be invoked from this point on,
+     * so it is safe to remove this window
+     * from the half dead list.
+     */
+
+    for (prev_halfdeadPtr = NULL,
+	    halfdeadPtr = tsdPtr->halfdeadWindowList;
+	    halfdeadPtr != NULL; ) {
+	if (halfdeadPtr->winPtr == winPtr) {
+	    if (prev_halfdeadPtr == NULL)
+	        tsdPtr->halfdeadWindowList = halfdeadPtr->nextPtr;
+	    else
+	        prev_halfdeadPtr->nextPtr = halfdeadPtr->nextPtr;
+	    ckfree((char *) halfdeadPtr);
+	    break;
+	}
+	prev_halfdeadPtr = halfdeadPtr;
+	halfdeadPtr = halfdeadPtr->nextPtr;
+    }
+    if (halfdeadPtr == NULL)
+        panic("window not found on half dead list");
+
+    /*
      * Cleanup the data structures associated with this window.
      */
 
@@ -2612,7 +2687,10 @@ Tk_GetNumMainWindows()
  * DeleteWindowsExitProc --
  *
  *	This procedure is invoked as an exit handler.  It deletes all
- *	of the main windows in the process.
+ *	of the main windows in the current thread. We really should
+ *	be using a thread local exit handler to delete windows and a
+ *	process exit handler to close the display but Tcl does
+ *	not provide support for this usage.
  *
  * Results:
  *	None.
@@ -2632,17 +2710,33 @@ DeleteWindowsExitProc(clientData)
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
 
-    while (tsdPtr->mainWindowList != NULL) {
-        /*
-         * We must protect the interpreter while deleting the window,
-         * because of <Destroy> bindings which could destroy the interpreter
-         * while the window is being deleted. This would leave frames on
-         * the call stack pointing at deleted memory, causing core dumps.
-         */
-        
-        interp = tsdPtr->mainWindowList->winPtr->mainPtr->interp;
+    /*
+     * Finish destroying any windows that are in a
+     * half-dead state. We must protect the interpreter
+     * while destroying the window, because of <Destroy>
+     * bindings which could destroy the interpreter
+     * while the window is being deleted. This would
+     * leave frames on the call stack pointing at
+     * deleted memory, causing core dumps.
+     */
+
+    while (tsdPtr->halfdeadWindowList != NULL) {
+        interp = tsdPtr->halfdeadWindowList->winPtr->mainPtr->interp;
+        Tcl_Preserve((ClientData) interp);
+        tsdPtr->halfdeadWindowList->flags |= HD_CLEANUP;
+        tsdPtr->halfdeadWindowList->winPtr->flags &= ~TK_ALREADY_DEAD;
+        Tk_DestroyWindow((Tk_Window) tsdPtr->halfdeadWindowList->winPtr);
+        Tcl_Release((ClientData) interp);
+    }
+
+    /*
+     * Destroy any remaining main windows.
+     */
+
+    while (tsdPtr->mainWindowList != NULL) {        
+        interp = tsdPtr->mainWindowList->interp;
         Tcl_Preserve((ClientData) interp);
-	Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr);
+        Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr);
         Tcl_Release((ClientData) interp);
     }
 
diff --git a/tests/window.test b/tests/window.test
index 1325fab..51bacbc 100644
--- a/tests/window.test
+++ b/tests/window.test
@@ -5,11 +5,14 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: window.test,v 1.6 2002/07/13 20:28:36 dgp Exp $
+# RCS: @(#) $Id: window.test,v 1.7 2002/11/14 17:30:20 mdejong Exp $
 
 package require tcltest 2.1
 namespace import -force tcltest::configure
 namespace import -force tcltest::testsDirectory
+namespace import -force tcltest::interpreter
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
 configure -testdir [file join [pwd] [file dirname [info script]]]
 configure -loadfile [file join [testsDirectory] constraints.tcl]
 tcltest::loadTestedCommands
@@ -77,6 +80,160 @@ test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} {
     destroy .f
 } {}
 
+test window-2.4 {Tk_DestroyWindow, cleanup half dead window at exit} \
+        unixOrWin {
+    set script [makeFile {
+        update
+        bind . <Destroy> exit
+        destroy .
+    } script]
+    if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
+	set error 1
+    } else {
+	set error 0
+    }
+    removeFile script
+    list $error $msg
+} {0 {}}
+
+test window-2.5 {Tk_DestroyWindow, cleanup half dead windows at exit} \
+        unixOrWin {
+    set script [makeFile {
+        toplevel .t
+        update
+        bind .t <Destroy> exit
+        destroy .t
+    } script]
+    if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
+	set error 1
+    } else {
+	set error 0
+    }
+    removeFile script
+    list $error $msg
+} {0 {}}
+
+test window-2.6 {Tk_DestroyWindow, cleanup half dead windows at exit} \
+        unixOrWin {
+    set script [makeFile {
+        toplevel .t
+        update
+        bind .t <Destroy> exit
+        destroy .
+    } script]
+    if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
+	set error 1
+    } else {
+	set error 0
+    }
+    removeFile script
+    list $error $msg
+} {0 {}}
+
+test window-2.7 {Tk_DestroyWindow, cleanup half dead windows at exit} \
+        unixOrWin {
+    set script [makeFile {
+        toplevel .t
+        toplevel .t.f
+        update
+        bind .t.f <Destroy> exit
+        destroy .
+    } script]
+    if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
+	set error 1
+    } else {
+	set error 0
+    }
+    removeFile script
+    list $error $msg
+} {0 {}}
+
+test window-2.8 {Tk_DestroyWindow, cleanup half dead windows at exit} \
+        unixOrWin {
+    set script [makeFile {
+        toplevel .t1
+        toplevel .t2
+        toplevel .t3
+        update
+        bind .t3 <Destroy> {destroy .t2}
+        bind .t2 <Destroy> {destroy .t1}
+        bind .t1 <Destroy> {exit 0}
+        destroy .t3
+    } script]
+    if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
+	set error 1
+    } else {
+	set error 0
+    }
+    removeFile script
+    list $error $msg
+} {0 {}}
+
+test window-2.9 {Tk_DestroyWindow, Destroy bindings
+        evaluated after exit} unixOrWin {
+    set script [makeFile {
+        toplevel .t1
+        toplevel .t2
+        update
+        bind .t2 <Destroy> {puts "Destroy .t2" ; exit 1}
+        bind .t1 <Destroy> {puts "Destroy .t1" ; exit 0}
+        destroy .t2
+    } script]
+    if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
+	set error 1
+    } else {
+	set error 0
+    }
+    removeFile script
+    list $error $msg
+} {0 {Destroy .t2
+Destroy .t1}}
+
+test window-2.10 {Tk_DestroyWindow, Destroy binding
+        evaluated once} unixOrWin {
+    set script [makeFile {
+        update
+        bind . <Destroy> {
+            puts "Destroy ."
+            bind . <Destroy> {puts "Re-Destroy ."}
+            exit 0
+        }
+        destroy .
+    } script]
+    if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
+	set error 1
+    } else {
+	set error 0
+    }
+    removeFile script
+    list $error $msg
+} {0 {Destroy .}}
+
+test window-2.11 {Tk_DestroyWindow, don't reanimate a half-dead window} \
+        unixOrWin {
+    set script [makeFile {
+        toplevel .t1
+        toplevel .t2
+        update
+        bind .t1 <Destroy> {
+            if {[catch {entry .t2.newchild}]} {
+                puts YES
+            } else {
+                puts NO
+            }
+        }
+        bind .t2 <Destroy> {exit}
+        destroy .t2
+    } script]
+    if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
+	set error 1
+    } else {
+	set error 0
+    }
+    removeFile script
+    list $error $msg
+} {0 YES}
+
 # Some tests require the testmenubar command
 testConstraint testmenubar [llength [info commands testmenubar]]