Attachment "nametracedelete84.patch" to
ticket [536937ffff]
added by
hobbs
2002-03-30 05:46:19.
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.64
diff -b -u -r1.64 tclCmdMZ.c
--- generic/tclCmdMZ.c 20 Mar 2002 22:47:36 -0000 1.64
+++ generic/tclCmdMZ.c 29 Mar 2002 22:43:09 -0000
@@ -3005,7 +3005,7 @@
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 @@
&& (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 @@
* 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 @@
/*
* 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 @@
* 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 @@
/*
* 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);
Index: tests/trace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/trace.test,v
retrieving revision 1.16
diff -b -u -r1.16 trace.test
--- tests/trace.test 7 Dec 2001 13:55:59 -0000 1.16
+++ tests/trace.test 29 Mar 2002 22:43:09 -0000
@@ -1145,6 +1145,17 @@
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.
