diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | doc/dde.n | 15 | ||||
| -rw-r--r-- | generic/tclBasic.c | 12 | ||||
| -rw-r--r-- | generic/tclProc.c | 28 | ||||
| -rw-r--r-- | tests/proc.test | 9 | ||||
| -rw-r--r-- | tests/safe.test | 14 |
6 files changed, 63 insertions, 22 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(). @@ -83,9 +83,11 @@ asynchronous invocation. The command returns an error message if the script did not run, unless the \fB\-async\fR flag was used, in which case the command returns immediately with no error. .VS 8.6 -The \fB\-binary\fR option treats \fIdata\fR as binary data, otherwise an utf-8 -string is sent. Combining \fB-binary\fR with the result of -\fBencoding convertto\fR may be used to send data in arbitrary encodings. +Without the \fB\-binary\fR option all data will be sent in unicode. For +dde clients which don't implement the CF_UNICODE clipboard format, this +will automatically be translated to the system encoding. You can use +the \fB\-binary\fR option in combination with the result of +\fBencoding convertto\fR to send data in any other encoding. .VE 8.6 .TP \fBdde poke ?\fB\-binary\fR? \fIservice topic item data\fR @@ -98,8 +100,11 @@ on. The \fIitem\fR is also application specific and is often not used, but it must always be non-null. The \fIdata\fR field is given to the remote application. .VS 8.6 -The \fB\-binary\fR option treats \fIdata\fR as binary data, otherwise an utf-8 -string is sent. +Without the \fB\-binary\fR option all data will be sent in unicode. For +dde clients which don't implement the CF_UNICODE clipboard format, this +will automatically be translated to the system encoding. You can use +the \fB\-binary\fR option in combination with the result of +\fBencoding convertto\fR to send data in any other encoding. .VE 8.6 .TP \fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b38558a..0b02d0d 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1555,12 +1555,16 @@ DeleteInterpProc( hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { CmdFrame *cfPtr = Tcl_GetHashValue(hPtr); + Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr); - if (cfPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(cfPtr->data.eval.path); + procPtr->iPtr = NULL; + if (cfPtr) { + if (cfPtr->type == TCL_LOCATION_SOURCE) { + Tcl_DecrRefCount(cfPtr->data.eval.path); + } + ckfree(cfPtr->line); + ckfree(cfPtr); } - ckfree(cfPtr->line); - ckfree(cfPtr); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(iPtr->linePBodyPtr); diff --git a/generic/tclProc.c b/generic/tclProc.c index d008217..7b0af3a 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2234,7 +2234,7 @@ TclProcCleanupProc( * procbody structures created by tbcload. */ - if (!iPtr) { + if (iPtr == NULL) { return; } @@ -2245,13 +2245,15 @@ TclProcCleanupProc( cfPtr = 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(cfPtr->line); + cfPtr->line = NULL; + ckfree(cfPtr); } - ckfree(cfPtr->line); - cfPtr->line = NULL; - ckfree(cfPtr); Tcl_DeleteHashEntry(hePtr); } @@ -2483,7 +2485,8 @@ SetLambdaFromAny( Interp *iPtr = (Interp *) interp; const char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv; - int objc, result; + int isNew, objc, result; + CmdFrame *cfPtr = NULL; Proc *procPtr; if (interp == NULL) { @@ -2578,14 +2581,14 @@ SetLambdaFromAny( if (contextPtr->line && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) { - int isNew, buf[2]; - CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); + int buf[2]; /* * Move from approximation (line of list cmd word) to actual * location (line of 2nd list element). */ + cfPtr = ckalloc(sizeof(CmdFrame)); TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL); cfPtr->level = -1; @@ -2601,9 +2604,6 @@ SetLambdaFromAny( cfPtr->cmd.str.cmd = NULL; cfPtr->cmd.str.len = 0; - - Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, - procPtr, &isNew), cfPtr); } /* @@ -2615,6 +2615,8 @@ SetLambdaFromAny( } TclStackFree(interp, contextPtr); } + Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, 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 ed3c4b6..e06720e 100644 --- a/tests/proc.test +++ b/tests/proc.test @@ -374,6 +374,15 @@ test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} -body { } -cleanup { namespace delete ugly } -result 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 catch {rename p ""} diff --git a/tests/safe.test b/tests/safe.test index dcd5bfd..4a2792e 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -334,6 +334,20 @@ test safe-8.9 {safe source and return} -setup { catch {safe::interpDelete $i} removeFile $returnScript } -result ok +test safe-8.10 {safe source and return} -setup { + set returnScript [makeFile {return -level 2 "ok"} return.tcl] + catch {safe::interpDelete $i} +} -body { + safe::interpCreate $i + set token [safe::interpAddToAccessPath $i [file dirname $returnScript]] + $i eval [list apply {filename { + source $filename + error boom + }} $token/[file tail $returnScript]] +} -cleanup { + catch {safe::interpDelete $i} + removeFile $returnScript +} -result ok test safe-9.1 {safe interps' deleteHook} -setup { set i "a" |