diff options
-rw-r--r-- | ChangeLog | 8 | ||||
-rw-r--r-- | generic/tclBasic.c | 9 | ||||
-rw-r--r-- | generic/tclExecute.c | 6 | ||||
-rw-r--r-- | generic/tclIORChan.c | 3 | ||||
-rw-r--r-- | generic/tclIORTrans.c | 3 | ||||
-rw-r--r-- | generic/tclThreadTest.c | 28 |
6 files changed, 49 insertions, 8 deletions
@@ -1,3 +1,11 @@ +2011-08-30 Don Porter <dgp@users.sourceforge.net> + + * generic/tclBasic.c: Prevent leak of interps when + * generic/tclExecute.c: using the [testthread exit] command. + * generic/tclIORChan.c: + * generic/tclIORTrans.c: + * generic/tclThreadtest.c: + 2011-08-30 Donal K. Fellows <dkf@users.sf.net> * generic/tclInterp.c (SlaveCommandLimitCmd, SlaveTimeLimitCmd): 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/tclIORChan.c b/generic/tclIORChan.c index 846618c..8ab36d0 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -2525,6 +2525,9 @@ DeleteReflectedChannelMap( * interpreter. They have already been marked as dead. */ + if (TclInThreadExit()) { + return; + } rcmPtr = GetThreadReflectedChannelMap(); for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); hPtr != NULL; diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index fa973c7..949d42d 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -2200,6 +2200,9 @@ DeleteReflectedTransformMap( * interpreter. They have already been marked as dead. */ + if (TclInThreadExit()) { + return; + } rtmPtr = GetThreadReflectedTransformMap(); for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch); hPtr != NULL; 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); |