diff options
author | ferrieux <ferrieux@noemail.net> | 2009-04-27 22:10:28 (GMT) |
---|---|---|
committer | ferrieux <ferrieux@noemail.net> | 2009-04-27 22:10:28 (GMT) |
commit | 6dc7c42e23213866b0505a2d013b711f127713b9 (patch) | |
tree | 1b8ee5775fa5066b3ebec1a4612f2d15ef65118e /generic/tclEvent.c | |
parent | c6a10bd3e4f6c9af7b8a01a01fcff74152863ebd (diff) | |
download | tcl-6dc7c42e23213866b0505a2d013b711f127713b9.zip tcl-6dc7c42e23213866b0505a2d013b711f127713b9.tar.gz tcl-6dc7c42e23213866b0505a2d013b711f127713b9.tar.bz2 |
Backport fix for [Bug 1028264]: WSACleanup() too early. The fix introduces "late exit handlers" for similar late process-wide cleanups.
FossilOrigin-Name: 19cb09b3ecda47a8d8238b72069c8c4e808363b5
Diffstat (limited to 'generic/tclEvent.c')
-rw-r--r-- | generic/tclEvent.c | 113 |
1 files changed, 106 insertions, 7 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 2cdae51..554b8ee 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.28.2.15 2007/03/19 17:06:25 dgp Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.28.2.16 2009/04/27 22:10:28 ferrieux Exp $ */ #include "tclInt.h" @@ -56,8 +56,8 @@ typedef struct ErrAssocData { } ErrAssocData; /* - * For each exit handler created with a call to Tcl_CreateExitHandler - * there is a structure of the following type: + * For each exit handler created with a call to Tcl_Create(Late)ExitHandler there is + * a structure of the following type: */ typedef struct ExitHandler { @@ -76,6 +76,9 @@ typedef struct ExitHandler { static ExitHandler *firstExitPtr = NULL; /* First in list of all exit handlers for * application. */ +static ExitHandler *firstLateExitPtr = NULL; + /* First in list of all late exit handlers for + * application. */ TCL_DECLARE_MUTEX(exitMutex) /* @@ -435,6 +438,39 @@ Tcl_CreateExitHandler(proc, clientData) /* *---------------------------------------------------------------------- * + * TclCreateLateExitHandler -- + * + * Arrange for a given function to be invoked after all pre-thread cleanups + * + * Results: + * None. + * + * Side effects: + * Proc will be invoked with clientData as argument when the application + * exits. + * + *---------------------------------------------------------------------- + */ + +void +TclCreateLateExitHandler( + Tcl_ExitProc *proc, /* Function to invoke. */ + ClientData clientData) /* Arbitrary value to pass to proc. */ +{ + ExitHandler *exitPtr; + + exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler)); + exitPtr->proc = proc; + exitPtr->clientData = clientData; + Tcl_MutexLock(&exitMutex); + exitPtr->nextPtr = firstLateExitPtr; + firstLateExitPtr = exitPtr; + Tcl_MutexUnlock(&exitMutex); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_DeleteExitHandler -- * * This procedure cancels an existing exit handler matching proc @@ -479,6 +515,49 @@ Tcl_DeleteExitHandler(proc, clientData) /* *---------------------------------------------------------------------- * + * TclDeleteLateExitHandler -- + * + * This function cancels an existing late exit handler matching proc and + * clientData, if such a handler exits. + * + * Results: + * None. + * + * Side effects: + * If there is a late exit handler corresponding to proc and clientData then + * it is canceled; if no such handler exists then nothing happens. + * + *---------------------------------------------------------------------- + */ + +void +TclDeleteLateExitHandler( + Tcl_ExitProc *proc, /* Function that was previously registered. */ + ClientData clientData) /* Arbitrary value to pass to proc. */ +{ + ExitHandler *exitPtr, *prevPtr; + + Tcl_MutexLock(&exitMutex); + for (prevPtr = NULL, exitPtr = firstLateExitPtr; exitPtr != NULL; + prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) { + if ((exitPtr->proc == proc) + && (exitPtr->clientData == clientData)) { + if (prevPtr == NULL) { + firstLateExitPtr = exitPtr->nextPtr; + } else { + prevPtr->nextPtr = exitPtr->nextPtr; + } + ckfree((char *) exitPtr); + break; + } + } + Tcl_MutexUnlock(&exitMutex); + return; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_CreateThreadExitHandler -- * * Arrange for a given procedure to be invoked just before the @@ -825,14 +904,34 @@ Tcl_Finalize() * Note that there is no thread-local storage after this call. */ - Tcl_FinalizeThread(); + Tcl_FinalizeThread(); + /* + * Now invoke late (process-wide) exit handlers. + */ + + Tcl_MutexLock(&exitMutex); + for (exitPtr = firstLateExitPtr; exitPtr != NULL; exitPtr = firstLateExitPtr) { /* - * Now finalize the Tcl execution environment. Note that this - * must be done after the exit handlers, because there are - * order dependencies. + * Be careful to remove the handler from the list before invoking its + * callback. This protects us against double-freeing if the callback + * should call Tcl_DeleteLateExitHandler on itself. */ + firstLateExitPtr = exitPtr->nextPtr; + Tcl_MutexUnlock(&exitMutex); + exitPtr->proc(exitPtr->clientData); + ckfree((char *) exitPtr); + Tcl_MutexLock(&exitMutex); + } + firstLateExitPtr = NULL; + Tcl_MutexUnlock(&exitMutex); + + /* + * Now finalize the Tcl execution environment. Note that this must be done + * after the exit handlers, because there are order dependencies. + */ + TclFinalizeCompilation(); TclFinalizeExecution(); TclFinalizeEnvironment(); |