Tcl Source Code

Artifact d6e18b5b7a5fedf7555f5f5a350d573d7cc17050:

Attachment "trace-8.4.patch" to ticket [1348775fff] added by msofer 2005-11-08 04:32:58.

---

Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.82.2.23
diff -u -r1.82.2.23 tclCmdMZ.c
--- generic/tclCmdMZ.c	1 Nov 2005 20:19:26 -0000	1.82.2.23
+++ generic/tclCmdMZ.c	7 Nov 2005 21:31:44 -0000
@@ -23,7 +23,7 @@
 #include "tclCompile.h"
 
 /*
- * Structure used to hold information about variable traces:
+ * Structures used to hold information about variable traces:
  */
 
 typedef struct {
@@ -37,6 +37,11 @@
 				 * be larger than 4 bytes. */
 } TraceVarInfo;
 
+typedef struct {
+    VarTrace     trace;
+    TraceVarInfo tvar;
+} CompoundVarTrace;
+
 /*
  * Structure used to hold information about command traces:
  */
@@ -3678,10 +3683,24 @@
 	    command = Tcl_GetStringFromObj(objv[5], &commandLength);
 	    length = (size_t) commandLength;
 	    if ((enum traceOptions) optionIndex == TRACE_ADD) {
+		/*
+		 * This code essentially mallocs together the VarTrace and the
+		 * TraceVarInfo, then inlines the Tcl_TraceVar(). This is
+		 * necessary in order to have the TraceVarInfo to be freed 
+		 * automatically when the VarTrace is freed [Bug 1348775]
+		 */
+
+		CompoundVarTrace *compTracePtr;
 		TraceVarInfo *tvarPtr;
-		tvarPtr = (TraceVarInfo *) ckalloc((unsigned)
-			(sizeof(TraceVarInfo) - sizeof(tvarPtr->command)
+		Var *varPtr, *arrayPtr;
+		VarTrace *tracePtr;
+		int flagMask;
+
+		compTracePtr = (CompoundVarTrace *) ckalloc((unsigned)
+			(sizeof(CompoundVarTrace) - sizeof(tvarPtr->command)
 				+ length + 1));
+		tracePtr = &(compTracePtr->trace);
+		tvarPtr =  &(compTracePtr->tvar);
 		tvarPtr->flags = flags;
 		if (objv[0] == NULL) {
 		    tvarPtr->flags |= TCL_TRACE_OLD_STYLE;
@@ -3690,11 +3709,24 @@
 		flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
 		strcpy(tvarPtr->command, command);
 		name = Tcl_GetString(objv[3]);
-		if (Tcl_TraceVar(interp, name, flags, TraceVarProc,
-			(ClientData) tvarPtr) != TCL_OK) {
-		    ckfree((char *) tvarPtr);
+		flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
+		varPtr = TclLookupVar(interp, name, NULL,
+			(flags & flagMask) | TCL_LEAVE_ERR_MSG,
+			"trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+		if (varPtr == NULL) {
+		    ckfree((char *) tracePtr);
 		    return TCL_ERROR;
 		}
+		flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | 
+		    TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+		flagMask |= TCL_TRACE_OLD_STYLE;
+#endif
+		tracePtr->traceProc = TraceVarProc;
+		tracePtr->clientData = (ClientData) tvarPtr;
+		tracePtr->flags	= flags & flagMask;
+		tracePtr->nextPtr = varPtr->tracePtr;
+		varPtr->tracePtr = tracePtr;
 	    } else {
 		/*
 		 * Search through all of our traces on this variable to
@@ -3715,7 +3747,6 @@
 			Tcl_UntraceVar2(interp, name, NULL, 
 			  flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
 				TraceVarProc, clientData);
-			Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC);
 			break;
 		    }
 		}
@@ -4707,8 +4738,6 @@
      * freed while we still need it.
      */
 
-    Tcl_Preserve((ClientData) tvarPtr);
-
     result = NULL;
     if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) {
 	if (tvarPtr->length != (size_t) 0) {
@@ -4783,9 +4812,7 @@
 	    Tcl_DecrRefCount(errMsgObj);
 	    result = NULL;
 	}
-	Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC);
     }
-    Tcl_Release((ClientData) tvarPtr);
     return result;
 }