diff options
author | dgp <dgp@users.sourceforge.net> | 2011-08-29 20:41:02 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2011-08-29 20:41:02 (GMT) |
commit | f3cc548bb35e246dad1cb4bb6d2cdc90278b9e1a (patch) | |
tree | 9a4be80a4c04129c06cd4801284f9ac960aaccdf /generic | |
parent | d65bb6e67d734ac2958cf3ff427488bb8cf04ab8 (diff) | |
download | tcl-f3cc548bb35e246dad1cb4bb6d2cdc90278b9e1a.zip tcl-f3cc548bb35e246dad1cb4bb6d2cdc90278b9e1a.tar.gz tcl-f3cc548bb35e246dad1cb4bb6d2cdc90278b9e1a.tar.bz2 |
Work in progress plugging thread finalization memory leaks.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 9 | ||||
-rw-r--r-- | generic/tclExecute.c | 6 | ||||
-rw-r--r-- | generic/tclThreadTest.c | 28 |
3 files changed, 35 insertions, 8 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 9758449..950b2de 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1359,7 +1359,7 @@ DeleteInterpProc( * unless we are exiting. */ - if ((iPtr->numLevels > 0) && !TclInExit()) { + if ((iPtr->numLevels > 0) && !TclInExit() && !TclInThreadExit()) { Tcl_Panic("DeleteInterpProc called with active evals"); } @@ -1482,7 +1482,8 @@ DeleteInterpProc( * namespace. The order is important [Bug 1658572]. */ - if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) { + if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit() + && !TclInThreadExit()) { Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top"); } Tcl_PopCallFrame(interp); @@ -1607,7 +1608,7 @@ DeleteInterpProc( * know which arguments will be used as scripts and which will not. */ - if (iPtr->lineLAPtr->numEntries && !TclInExit()) { + if (iPtr->lineLAPtr->numEntries && !TclInExit() && !TclInThreadExit()) { /* * When the interp goes away we have nothing on the stack, so there * are no arguments, so this table has to be empty. @@ -1620,7 +1621,7 @@ DeleteInterpProc( ckfree((char *) iPtr->lineLAPtr); iPtr->lineLAPtr = NULL; - if (iPtr->lineLABCPtr->numEntries && !TclInExit()) { + if (iPtr->lineLABCPtr->numEntries && !TclInExit() && !TclInThreadExit()) { /* * 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/tclExecute.c b/generic/tclExecute.c index 691c8d7..f244a1c 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -898,7 +898,7 @@ static void DeleteExecStack( ExecStack *esPtr) { - if (esPtr->markerPtr && !cachedInExit) { + if (esPtr->markerPtr && !cachedInExit && !TclInThreadExit()) { Tcl_Panic("freeing an execStack which is still in use"); } @@ -934,10 +934,10 @@ TclDeleteExecEnv( TclDecrRefCount(eePtr->constants[0]); TclDecrRefCount(eePtr->constants[1]); - if (eePtr->callbackPtr && !cachedInExit) { + if (eePtr->callbackPtr && !cachedInExit && !TclInThreadExit()) { Tcl_Panic("Deleting execEnv with pending TEOV callbacks!"); } - if (eePtr->corPtr && !cachedInExit) { + if (eePtr->corPtr && !cachedInExit &&!TclInThreadExit()) { Tcl_Panic("Deleting execEnv with existing coroutine"); } ckfree(eePtr); diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 71d5a66..425c8a9 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -139,6 +139,7 @@ static void ThreadFreeProc(ClientData clientData); static int ThreadDeleteEvent(Tcl_Event *eventPtr, ClientData clientData); static void ThreadExitProc(ClientData clientData); +static void ReleaseInterp(ClientData clientData); extern int Tcltest_Init(Tcl_Interp *interp); /* @@ -326,8 +327,9 @@ ThreadObjCmd( return TCL_ERROR; } ListRemove(NULL); + Tcl_DeleteInterp(interp); Tcl_ExitThread(0); - return TCL_OK; + return TCL_ERROR; case THREAD_ID: if (objc == 2 || objc == 3) { Tcl_Obj *idObj; @@ -564,6 +566,7 @@ NewTestThread( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int result; char *threadEvalScript; + int fullFinal = TclFullFinalizationRequested(); /* * Initialize the interpreter. This should be more general. @@ -614,7 +617,13 @@ NewTestThread( */ Tcl_Preserve(tsdPtr->interp); + if (fullFinal) { + Tcl_CreateThreadExitHandler(ReleaseInterp, tsdPtr->interp); + } result = Tcl_Eval(tsdPtr->interp, threadEvalScript); + if (fullFinal) { + Tcl_DeleteThreadExitHandler(ReleaseInterp, tsdPtr->interp); + } if (result != TCL_OK) { ThreadErrorProc(tsdPtr->interp); } @@ -631,6 +640,15 @@ NewTestThread( TCL_THREAD_CREATE_RETURN; } +static void +ReleaseInterp( + ClientData clientData) +{ + Tcl_Interp *interp = (Tcl_Interp *) clientData; + + Tcl_Release(interp); +} + /* *------------------------------------------------------------------------ * @@ -1024,11 +1042,19 @@ ThreadEventProc( errorCode = "THREAD"; errorInfo = ""; } else { + int fullFinal = TclFullFinalizationRequested(); + Tcl_Preserve(interp); Tcl_ResetResult(interp); + if (fullFinal) { + Tcl_CreateThreadExitHandler(ReleaseInterp, tsdPtr->interp); + } Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script); code = Tcl_GlobalEval(interp, threadEventPtr->script); Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script); + if (fullFinal) { + Tcl_DeleteThreadExitHandler(ReleaseInterp, tsdPtr->interp); + } if (code != TCL_OK) { errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); |