diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclBasic.c | 13 | ||||
| -rw-r--r-- | generic/tclEvent.c | 49 | ||||
| -rw-r--r-- | generic/tclExecute.c | 12 | ||||
| -rw-r--r-- | generic/tclInt.h | 2 | ||||
| -rw-r--r-- | generic/tclMain.c | 87 |
6 files changed, 126 insertions, 44 deletions
@@ -1,5 +1,12 @@ 2011-08-09 Alexandre Ferrieux <ferrieux@users.sourceforge.net> + * generic/tclBasic.c: [Bug 2919042] Restore "valgrindability" of Tcl + * generic/tclEvent.c: that was lost by the streamlining of [exit], by + * generic/tclExecute.c: conditionally forcing a full Finalize: + * generic/tclInt.h: use -DPURIFY or ::env(TCL_FINALIZE_ON_EXIT) + +2011-08-09 Alexandre Ferrieux <ferrieux@users.sourceforge.net> + * generic/tclCompCmds.c: [Bug 3386417] avoid a reference loop between * generic/tclInt.h: the bytecode and its companion errostack * generic/tclResult.c: when compiling a syntax error. diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a44d736..124f932 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1355,10 +1355,11 @@ DeleteInterpProc( int i; /* - * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup. + * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup, + * unless we are exiting. */ - if (iPtr->numLevels > 0) { + if ((iPtr->numLevels > 0) && !TclInExit()) { Tcl_Panic("DeleteInterpProc called with active evals"); } @@ -1481,7 +1482,7 @@ DeleteInterpProc( * namespace. The order is important [Bug 1658572]. */ - if (iPtr->framePtr != iPtr->rootFramePtr) { + if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) { Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top"); } Tcl_PopCallFrame(interp); @@ -1602,7 +1603,7 @@ DeleteInterpProc( * know which arguments will be used as scripts and which will not. */ - if (iPtr->lineLAPtr->numEntries) { + if (iPtr->lineLAPtr->numEntries && !TclInExit()) { /* * When the interp goes away we have nothing on the stack, so there * are no arguments, so this table has to be empty. @@ -1612,10 +1613,10 @@ DeleteInterpProc( } Tcl_DeleteHashTable(iPtr->lineLAPtr); - ckfree(iPtr->lineLAPtr); + ckfree((char *) iPtr->lineLAPtr); iPtr->lineLAPtr = NULL; - if (iPtr->lineLABCPtr->numEntries) { + if (iPtr->lineLABCPtr->numEntries && !TclInExit()) { /* * When the interp goes away we have nothing on the stack, so there * are no arguments, so this table has to be empty. diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 6816487..e65862c 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -953,27 +953,38 @@ Tcl_Exit( currentAppExitPtr(INT2PTR(status)); Tcl_Panic("AppExitProc returned unexpectedly"); } else { - /* - * Use default handling. - */ - InvokeExitHandlers(); + if (TclFullFinalizationRequested()) { - /* - * Ensure the thread-specific data is initialised as it is used in - * Tcl_FinalizeThread() - */ - - (void) TCL_TSD_INIT(&dataKey); - - /* - * Now finalize the calling thread only (others are not safely - * reachable). Among other things, this triggers a flush of the - * Tcl_Channels that may have data enqueued. - */ - - Tcl_FinalizeThread(); - + /* + * Thorough finalization for Valgrind et al. + */ + + Tcl_Finalize(); + + } else { + + /* + * Fast and deterministic exit (default behavior) + */ + + InvokeExitHandlers(); + + /* + * Ensure the thread-specific data is initialised as it is used in + * Tcl_FinalizeThread() + */ + + (void) TCL_TSD_INIT(&dataKey); + + /* + * Now finalize the calling thread only (others are not safely + * reachable). Among other things, this triggers a flush of the + * Tcl_Channels that may have data enqueued. + */ + + Tcl_FinalizeThread(); + } TclpExit(status); Tcl_Panic("OS exit failed!"); } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a7d6184..691c8d7 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -53,6 +53,8 @@ static int execInitialized = 0; TCL_DECLARE_MUTEX(execMutex) +static int cachedInExit = 0; + #ifdef TCL_COMPILE_DEBUG /* * Variable that controls whether execution tracing is enabled and, if so, @@ -896,7 +898,7 @@ static void DeleteExecStack( ExecStack *esPtr) { - if (esPtr->markerPtr) { + if (esPtr->markerPtr && !cachedInExit) { Tcl_Panic("freeing an execStack which is still in use"); } @@ -915,6 +917,8 @@ TclDeleteExecEnv( { ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr; + cachedInExit = TclInExit(); + /* * Delete all stacks in this exec env. */ @@ -930,10 +934,10 @@ TclDeleteExecEnv( TclDecrRefCount(eePtr->constants[0]); TclDecrRefCount(eePtr->constants[1]); - if (eePtr->callbackPtr) { - Tcl_Panic("Deleting execEnv with pending NRE callbacks!"); + if (eePtr->callbackPtr && !cachedInExit) { + Tcl_Panic("Deleting execEnv with pending TEOV callbacks!"); } - if (eePtr->corPtr) { + if (eePtr->corPtr && !cachedInExit) { Tcl_Panic("Deleting execEnv with existing coroutine"); } ckfree(eePtr); diff --git a/generic/tclInt.h b/generic/tclInt.h index 9f00077..d65f712 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3787,6 +3787,8 @@ MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr); MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr); MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); +MODULE_SCOPE int TclFullFinalizationRequested(void); + /* *---------------------------------------------------------------- * Macros used by the Tcl core to create and release Tcl objects. diff --git a/generic/tclMain.c b/generic/tclMain.c index 26383b5..c7166d7 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -125,6 +125,7 @@ typedef struct InteractiveState { MODULE_SCOPE Tcl_MainLoopProc *TclGetMainLoop(void); static void Prompt(Tcl_Interp *interp, InteractiveState *isPtr); static void StdinProc(ClientData clientData, int mask); +static void FreeMainInterp(ClientData clientData); #ifndef TCL_ASCII_MAIN static Tcl_ThreadDataKey dataKey; @@ -387,6 +388,13 @@ Tcl_MainEx( if (Tcl_LimitExceeded(interp)) { goto done; } + if (TclFullFinalizationRequested()) { + /* + * Arrange for final deletion of the main interp + */ + // ARGH Munchhausen effect + Tcl_CreateExitHandler(FreeMainInterp, (ClientData)interp); + } /* * Invoke the script specified on the command line, if any. Must fetch it @@ -597,31 +605,18 @@ Tcl_MainEx( if (!Tcl_InterpDeleted(interp)) { if (!Tcl_LimitExceeded(interp)) { Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode); - + Tcl_IncrRefCount(cmd); Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmd); } - + } /* * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual * is happening. Maybe interp has been deleted; maybe [exit] was * redefined, maybe we've blown up because of an exceeded limit. We * still want to cleanup and exit. */ - - if (!Tcl_InterpDeleted(interp)) { - Tcl_DeleteInterp(interp); - } - } - Tcl_SetStartupScript(NULL, NULL); - - /* - * If we get here, the master interp has been deleted. Allow its - * destruction with the last matching Tcl_Release. - */ - - Tcl_Release(interp); Tcl_Exit(exitCode); } @@ -699,6 +694,42 @@ TclGetMainLoop(void) /* *---------------------------------------------------------------------- * + * TclFullFinalizationRequested -- + * + * This function returns true when either -DPURIFY is specified, or the + * environment variable TCL_FINALIZE_ON_EXIT is set and not "0". This + * predicate is called at places affecting the exit sequence, so that the + * default behavior is a fast and deadlock-free exit, and the modified + * behavior is a more thorough finalization for debugging purposes (leak + * hunting etc). + * + * Results: + * A boolean. + * + *---------------------------------------------------------------------- + */ +MODULE_SCOPE int +TclFullFinalizationRequested(void) +{ +#ifdef PURIFY + return 1; +#else + const char *fin; + Tcl_DString ds; + int finalize = 0; + + fin = TclGetEnv("TCL_FINALIZE_ON_EXIT", &ds); + finalize = ((fin != NULL) && strcmp(fin, "0")); + if (fin != NULL) { + Tcl_DStringFree(&ds); + } + return finalize; +#endif +} + +/* + *---------------------------------------------------------------------- + * * StdinProc -- * * This function is invoked by the event dispatcher whenever standard @@ -881,6 +912,32 @@ Prompt( } /* + *---------------------------------------------------------------------- + * + * FreeMainInterp -- + * + * Exit handler used to cleanup the main interpreter and ancillary startup + * script storage at exit. + * + *---------------------------------------------------------------------- + */ + +static void +FreeMainInterp( + ClientData clientData) +{ + Tcl_Interp *interp = (Tcl_Interp *) clientData; + + //if (TclInExit()) return; + + if (!Tcl_InterpDeleted(interp)) { + Tcl_DeleteInterp(interp); + } + Tcl_SetStartupScript(NULL, NULL); + Tcl_Release(interp); +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 |