Attachment "nametracedelete.patch" to
ticket [536937ffff]
added by
hobbs
2002-03-30 05:41:03.
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.26.2.5
diff -b -u -r1.26.2.5 tclCmdMZ.c
--- generic/tclCmdMZ.c 20 Nov 2001 15:14:09 -0000 1.26.2.5
+++ generic/tclCmdMZ.c 29 Mar 2002 22:40:17 -0000
@@ -2654,11 +2654,13 @@
while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
TraceVarProc, clientData)) != 0) {
tvarPtr = (TraceVarInfo *) clientData;
- if ((tvarPtr->length == length) && (tvarPtr->flags == flags)
+ if ((tvarPtr->length == length)
+ && (tvarPtr->flags == flags)
&& (strncmp(command, tvarPtr->command,
(size_t) length) == 0)) {
Tcl_UntraceVar(interp, name, flags | TCL_TRACE_UNSETS,
TraceVarProc, clientData);
+
if (tvarPtr->errMsg != NULL) {
ckfree(tvarPtr->errMsg);
}
@@ -2778,13 +2780,10 @@
* and the terminating null.
*/
- 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 : ""));
if (flags & TCL_TRACE_READS) {
Tcl_DStringAppend(&cmd, " r", 2);
} else if (flags & TCL_TRACE_WRITES) {
@@ -2796,9 +2795,16 @@
/*
* 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));
if (code != TCL_OK) { /* copy error msg to result */
Index: tests/trace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/trace.test,v
retrieving revision 1.6.2.1
diff -b -u -r1.6.2.1 trace.test
--- tests/trace.test 16 Oct 2001 05:46:04 -0000 1.6.2.1
+++ tests/trace.test 29 Mar 2002 22:40:17 -0000
@@ -977,6 +977,17 @@
trace variable x r p1
catch {set x}
} 1
+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.
@@ -987,15 +998,3 @@
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
