summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclBasic.c9
-rw-r--r--generic/tclExecute.c6
-rw-r--r--generic/tclIORChan.c3
-rw-r--r--generic/tclIORTrans.c3
-rw-r--r--generic/tclThreadTest.c28
6 files changed, 49 insertions, 8 deletions
diff --git a/ChangeLog b/ChangeLog
index 746955a..3b1fa30 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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);