diff options
| -rw-r--r-- | ChangeLog | 15 | ||||
| -rw-r--r-- | generic/tkWindow.c | 150 | ||||
| -rw-r--r-- | tests/window.test | 159 |
3 files changed, 295 insertions, 29 deletions
@@ -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]] |