diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclBasic.c | 13 | ||||
| -rw-r--r-- | generic/tclProc.c | 28 | ||||
| -rw-r--r-- | tests/proc.test | 8 |
4 files changed, 38 insertions, 18 deletions
@@ -1,3 +1,10 @@ +2012-06-11 Don Porter <dgp@users.sourceforge.net> + + * generic/tclBasic.c: [Bug 3532959] Make sure the lifetime management + * generic/tclProc.c: of entries in the linePBodyPtr hash table can + * tests/proc.test: tolerate either order of teardown, interp first, + or Proc first. + 2012-06-08 Don Porter <dgp@users.sourceforge.net> * unix/configure.in: Update autogoo for gettimeofday(). diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 954b2b3..fa13b50 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1388,12 +1388,15 @@ DeleteInterpProc( hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { CmdFrame *cfPtr = Tcl_GetHashValue(hPtr); - - if (cfPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(cfPtr->data.eval.path); + Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr); + procPtr->iPtr = NULL; + if (cfPtr) { + if (cfPtr->type == TCL_LOCATION_SOURCE) { + Tcl_DecrRefCount(cfPtr->data.eval.path); + } + ckfree((char *) cfPtr->line); + ckfree((char *) cfPtr); } - ckfree((char *) cfPtr->line); - ckfree((char *) cfPtr); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(iPtr->linePBodyPtr); diff --git a/generic/tclProc.c b/generic/tclProc.c index 43e88c6..2c6d300 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2198,7 +2198,7 @@ TclProcCleanupProc( * the same ProcPtr is overwritten with a new CmdFrame. */ - if (!iPtr) { + if (iPtr == NULL) { return; } @@ -2209,13 +2209,15 @@ TclProcCleanupProc( cfPtr = (CmdFrame *) Tcl_GetHashValue(hePtr); - if (cfPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(cfPtr->data.eval.path); - cfPtr->data.eval.path = NULL; + if (cfPtr) { + if (cfPtr->type == TCL_LOCATION_SOURCE) { + Tcl_DecrRefCount(cfPtr->data.eval.path); + cfPtr->data.eval.path = NULL; + } + ckfree((char *) cfPtr->line); + cfPtr->line = NULL; + ckfree((char *) cfPtr); } - ckfree((char *) cfPtr->line); - cfPtr->line = NULL; - ckfree((char *) cfPtr); Tcl_DeleteHashEntry(hePtr); } @@ -2447,7 +2449,8 @@ SetLambdaFromAny( Interp *iPtr = (Interp *) interp; char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr; - int objc, result; + int isNew, objc, result; + CmdFrame *cfPtr = NULL; Proc *procPtr; if (interp == NULL) { @@ -2544,14 +2547,14 @@ SetLambdaFromAny( if (contextPtr->line && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) { - int isNew, buf[2]; - CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame)); + int buf[2]; /* * Move from approximation (line of list cmd word) to actual * location (line of 2nd list element). */ + cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame)); TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL); cfPtr->level = -1; @@ -2567,9 +2570,6 @@ SetLambdaFromAny( cfPtr->cmd.str.cmd = NULL; cfPtr->cmd.str.len = 0; - - Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, - (char *) procPtr, &isNew), cfPtr); } /* @@ -2581,6 +2581,8 @@ SetLambdaFromAny( } TclStackFree(interp, contextPtr); } + Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, + &isNew), cfPtr); /* * Set the namespace for this lambda: given by objv[2] understood as a diff --git a/tests/proc.test b/tests/proc.test index 5673caa..c0f80e3 100644 --- a/tests/proc.test +++ b/tests/proc.test @@ -391,6 +391,14 @@ test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} { set res } {0 4} +test proc-7.4 {Proc struct outlives its interp: Bug 3532959} { + set lambda x + lappend lambda {set a 1} + interp create slave + slave eval [list apply $lambda foo] + interp delete slave + unset lambda +} {} # cleanup |