diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 36 | ||||
| -rw-r--r-- | tests/trace.test | 13 |
3 files changed, 45 insertions, 14 deletions
@@ -1,3 +1,13 @@ +2002-03-29 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tclCmdMZ.c (Tcl_TraceObjCmd, TraceVarProc) + (TraceCommandProc, TclTraceCommandObjCmd): corrected + potential double-free of traces on variables by flagging in + Trace*Proc that it will free the var in case the eval wants to + delete the var trace as well. [Bug #536937] + Also converted Tcl_UntraceVar -> Tcl_UntraceVar2 and Tcl_Eval to + Tcl_EvalEx in Trace*Proc for slight efficiency improvement. + 2002-03-29 Don Porter <dgp@users.sourceforge.net> * doc/AllowExc.3: diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 017b407..0721ac0 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.64 2002/03/20 22:47:36 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.65 2002/03/29 22:47:23 hobbs Exp $ */ #include "tclInt.h" @@ -3005,7 +3005,7 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv) if ((tvarPtr->length == length) && (tvarPtr->flags == flags) && (strncmp(command, tvarPtr->command, (size_t) length) == 0)) { - Tcl_UntraceVar(interp, name, + Tcl_UntraceVar2(interp, name, NULL, flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT, TraceVarProc, clientData); ckfree((char *) tvarPtr); @@ -3359,7 +3359,7 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv) && (tvarPtr->flags == flags) && (strncmp(command, tvarPtr->command, (size_t) length) == 0)) { - Tcl_UntraceVar(interp, name, + Tcl_UntraceVar2(interp, name, NULL, flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT, TraceVarProc, clientData); ckfree((char *) tvarPtr); @@ -3659,13 +3659,10 @@ TraceCommandProc(clientData, interp, oldName, newName, flags) * for the old and new command name and the operation. */ - if (newName == NULL) { - newName = ""; - } Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length); Tcl_DStringAppendElement(&cmd, oldName); - Tcl_DStringAppendElement(&cmd, newName); + Tcl_DStringAppendElement(&cmd, (newName ? newName : "")); if (flags & TCL_TRACE_RENAME) { Tcl_DStringAppend(&cmd, " rename", 7); } else if (flags & TCL_TRACE_DELETE) { @@ -3675,11 +3672,19 @@ TraceCommandProc(clientData, interp, oldName, newName, flags) /* * Execute the command. Save the interp's result used for * the command. We discard any object result the command returns. + * + * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to + * other areas that this will be destroyed by us, otherwise a + * double-free might occur depending on what the eval does. */ Tcl_SaveResult(interp, &state); + if (flags & TCL_TRACE_DESTROYED) { + tcmdPtr->flags |= TCL_TRACE_DESTROYED; + } - code = Tcl_Eval(interp, Tcl_DStringValue(&cmd)); + code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), + Tcl_DStringLength(&cmd), 0); if (code != TCL_OK) { /* We ignore errors in these traced commands */ } @@ -3741,13 +3746,10 @@ TraceVarProc(clientData, interp, name1, name2, flags) * for the two variable names and the operation. */ - if (name2 == NULL) { - name2 = ""; - } Tcl_DStringInit(&cmd); Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length); Tcl_DStringAppendElement(&cmd, name1); - Tcl_DStringAppendElement(&cmd, name2); + Tcl_DStringAppendElement(&cmd, (name2 ? name2 : "")); #ifndef TCL_REMOVE_OBSOLETE_TRACES if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) { if (flags & TCL_TRACE_ARRAY) { @@ -3777,11 +3779,19 @@ TraceVarProc(clientData, interp, name1, name2, flags) /* * Execute the command. Save the interp's result used for * the command. We discard any object result the command returns. + * + * Add the TCL_TRACE_DESTROYED flag to tvarPtr to indicate to + * other areas that this will be destroyed by us, otherwise a + * double-free might occur depending on what the eval does. */ Tcl_SaveResult(interp, &state); + if (flags & TCL_TRACE_DESTROYED) { + tvarPtr->flags |= TCL_TRACE_DESTROYED; + } - code = Tcl_Eval(interp, Tcl_DStringValue(&cmd)); + code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), + Tcl_DStringLength(&cmd), 0); if (code != TCL_OK) { /* copy error msg to result */ register Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp); Tcl_IncrRefCount(errMsgObj); diff --git a/tests/trace.test b/tests/trace.test index 6a5cc88..81aa82e 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: trace.test,v 1.16 2001/12/07 13:55:59 msofer Exp $ +# RCS: @(#) $Id: trace.test,v 1.17 2002/03/29 22:47:22 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1145,6 +1145,17 @@ test trace-18.1 {unset traces on procedure returns} { p1 foo bar set info } {0 {a x y}} +test trace-18.2 {namespace delete / trace vdelete combo} { + namespace eval ::foo { + variable x 123 + } + proc p1 args { + trace vdelete ::foo::x u p1 + } + trace variable ::foo::x u p1 + namespace delete ::foo + info exists ::foo::x +} 0 # Delete arrays when done, so they can be re-used as scalars # elsewhere. |