Changes due to TIP#68; memory handling in variable traces is now correct!

3 files changed, 238 insertions, 75 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index cb5c9d5..f960f51 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.104 2001/10/15 17:34:35 hobbs Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.105 2001/11/19 14:35:54 dkf Exp $
  */
 
 #ifndef _TCL
@@ -942,6 +942,9 @@ typedef struct Tcl_DString {
 /* Required to support old variable/vdelete/vinfo traces */
 #define TCL_TRACE_OLD_STYLE	 0x1000
 #endif
+/* Indicate the semantics of the result of a trace */
+#define TCL_TRACE_RESULT_DYNAMIC 0x8000
+#define TCL_TRACE_RESULT_OBJECT  0x10000
 
 /*
  * Flag values passed to command-related procedures.
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 7ac9677..836c080 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -13,7 +13,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.48 2001/10/16 05:31:17 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.49 2001/11/19 14:35:54 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -27,8 +27,6 @@
 typedef struct {
     int flags;			/* Operations for which Tcl command is
 				 * to be invoked. */
-    char *errMsg;		/* Error message returned from Tcl command,
-				 * or NULL.  Malloc'ed. */
     size_t length;		/* Number of non-NULL chars. in command. */
     char command[4];		/* Space for Tcl command to invoke.  Actual
 				 * size will be as large as necessary to
@@ -2806,9 +2804,8 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
 		    (sizeof(TraceVarInfo) - sizeof(tvarPtr->command)
 			    + length + 1));
 	    tvarPtr->flags = flags;
-	    tvarPtr->errMsg = NULL;
 	    tvarPtr->length = length;
-	    flags |= TCL_TRACE_UNSETS;
+	    flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
 	    strcpy(tvarPtr->command, command);
 	    name = Tcl_GetString(objv[2]);
 	    if (Tcl_TraceVar(interp, name, flags, TraceVarProc,
@@ -2864,11 +2861,9 @@ 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, flags | TCL_TRACE_UNSETS,
+		    Tcl_UntraceVar(interp, name,
+			    flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
 			    TraceVarProc, clientData);
-		    if (tvarPtr->errMsg != NULL) {
-			ckfree(tvarPtr->errMsg);
-		    }
 		    ckfree((char *) tvarPtr);
 		    break;
 		}
@@ -3019,7 +3014,6 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
 			(sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
 				+ length + 1));
 		tcmdPtr->flags = flags;
-		tcmdPtr->errMsg = NULL;
 		tcmdPtr->length = length;
 		flags |= TCL_TRACE_DELETE;
 		strcpy(tcmdPtr->command, command);
@@ -3050,9 +3044,6 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
 			Tcl_UntraceCommand(interp, name,
 				flags | TCL_TRACE_DELETE,
 				TraceCommandProc, clientData);
-			if (tcmdPtr->errMsg != NULL) {
-			    ckfree(tcmdPtr->errMsg);
-			}
 			ckfree((char *) tcmdPtr);
 			break;
 		    }
@@ -3198,9 +3189,8 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
 			(sizeof(TraceVarInfo) - sizeof(tvarPtr->command)
 				+ length + 1));
 		tvarPtr->flags = flags;
-		tvarPtr->errMsg = NULL;
 		tvarPtr->length = length;
-		flags |= TCL_TRACE_UNSETS;
+		flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
 		strcpy(tvarPtr->command, command);
 		name = Tcl_GetString(objv[3]);
 		if (Tcl_TraceVar(interp, name, flags, TraceVarProc,
@@ -3225,11 +3215,9 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
 			    && (tvarPtr->flags == flags)
 			    && (strncmp(command, tvarPtr->command,
 				    (size_t) length) == 0)) {
-			Tcl_UntraceVar(interp, name, flags | TCL_TRACE_UNSETS,
+			Tcl_UntraceVar(interp, name,
+				flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
 				TraceVarProc, clientData);
-			if (tvarPtr->errMsg != NULL) {
-			    ckfree(tvarPtr->errMsg);
-			}
 			ckfree((char *) tvarPtr);
 			break;
 		    }
@@ -3521,10 +3509,6 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
     int code;
     Tcl_DString cmd;
 
-    if (tcmdPtr->errMsg != NULL) {
-	ckfree(tcmdPtr->errMsg);
-	tcmdPtr->errMsg = NULL;
-    }
     if ((tcmdPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) {
 	/*
 	 * Generate a command to execute by appending list elements
@@ -3561,9 +3545,6 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
 	Tcl_DStringFree(&cmd);
     }
     if (flags & TCL_TRACE_DESTROYED) {
-	if (tcmdPtr->errMsg != NULL) {
-	    ckfree(tcmdPtr->errMsg);
-	}
 	ckfree((char *) tcmdPtr);
     }
     return;
@@ -3605,10 +3586,6 @@ TraceVarProc(clientData, interp, name1, name2, flags)
     Tcl_DString cmd;
 
     result = NULL;
-    if (tvarPtr->errMsg != NULL) {
-	ckfree(tvarPtr->errMsg);
-	tvarPtr->errMsg = NULL;
-    }
     if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) {
 	if (tvarPtr->length != (size_t) 0) {
 	    /*
@@ -3658,13 +3635,9 @@ TraceVarProc(clientData, interp, name1, name2, flags)
 
 	    code = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
 	    if (code != TCL_OK) {	     /* copy error msg to result */
-		char *string;
-		int length;
-		
-		string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
-		tvarPtr->errMsg = (char *) ckalloc((unsigned) (length + 1));
-		memcpy(tvarPtr->errMsg, string, (size_t) (length + 1));
-		result = tvarPtr->errMsg;
+		register Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);
+		Tcl_IncrRefCount(errMsgObj);
+		result = (char *) errMsgObj;
 	    }
 
 	    Tcl_RestoreResult(interp, &state);
@@ -3673,9 +3646,11 @@ TraceVarProc(clientData, interp, name1, name2, flags)
 	}
     }
     if (flags & TCL_TRACE_DESTROYED) {
-	result = NULL;
-	if (tvarPtr->errMsg != NULL) {
-	    ckfree(tvarPtr->errMsg);
+	if (result != NULL) {
+	    register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
+
+	    Tcl_DecrRefCount(errMsgObj);
+	    result = NULL;
 	}
 	ckfree((char *) tvarPtr);
     }
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 530b3d8..31437e7 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclVar.c,v 1.40 2001/11/14 23:17:04 hobbs Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.41 2001/11/19 14:35:54 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -42,7 +42,7 @@ static char *isArrayElement =	"name refers to an element in an array";
 
 static  char *		CallTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr,
 			    Var *varPtr, char *part1, char *part2,
-			    int flags));
+			    int flags, int *resultTypePtr));
 static void		CleanupVar _ANSI_ARGS_((Var *varPtr,
 			    Var *arrayPtr));
 static void		DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));
@@ -634,11 +634,23 @@ Tcl_GetVar2Ex(interp, part1, part2, flags)
 
     if ((varPtr->tracePtr != NULL)
 	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	int resultType;
 	msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
-		(flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY)) | TCL_TRACE_READS);
+		(flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY)) | TCL_TRACE_READS,
+		&resultType);
 	if (msg != NULL) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		VarErrMsg(interp, part1, part2, "read", msg);
+		if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		    VarErrMsg(interp, part1, part2, "read",
+			      Tcl_GetString((Tcl_Obj *) msg));
+		} else {
+		    VarErrMsg(interp, part1, part2, "read", msg);
+		}
+	    }
+	    if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		ckfree(msg);
+	    } else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		Tcl_DecrRefCount((Tcl_Obj *) msg);
 	    }
 	    goto errorReturn;
 	}
@@ -758,11 +770,23 @@ TclGetIndexedScalar(interp, localIndex, flags)
      */
 
     if (varPtr->tracePtr != NULL) {
+	int resultType;
+
 	msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL,
-		TCL_TRACE_READS);
+		TCL_TRACE_READS, &resultType);
 	if (msg != NULL) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		VarErrMsg(interp, varName, NULL, "read", msg);
+		if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		    VarErrMsg(interp, varName, NULL, "read",
+			      Tcl_GetString((Tcl_Obj *) msg));
+		} else {
+		    VarErrMsg(interp, varName, NULL, "read", msg);
+		}
+	    }
+	    if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		ckfree(msg);
+	    } else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		Tcl_DecrRefCount((Tcl_Obj *) msg);
 	    }
 	    return NULL;
 	}
@@ -915,11 +939,23 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, flags)
 
     if ((varPtr->tracePtr != NULL)
             || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	int resultType;
+
 	msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
-	        TCL_TRACE_READS);
+	        TCL_TRACE_READS, &resultType);
 	if (msg != NULL) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		VarErrMsg(interp, arrayName, elem, "read", msg);
+		if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		    VarErrMsg(interp, arrayName, elem, "read",
+			      Tcl_GetString((Tcl_Obj *) msg));
+		} else {
+		    VarErrMsg(interp, arrayName, elem, "read", msg);
+		}
+	    }
+	    if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		ckfree(msg);
+	    } else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		Tcl_DecrRefCount((Tcl_Obj *)msg);
 	    }
 	    goto errorReturn;
 	}
@@ -1331,11 +1367,24 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
 
     if ((varPtr->tracePtr != NULL)
 	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	int resultType;
+
 	char *msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
-	        (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_WRITES);
+	        (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_WRITES,
+		&resultType);
 	if (msg != NULL) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		VarErrMsg(interp, part1, part2, "set", msg);
+		if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		    VarErrMsg(interp, part1, part2, "set",
+			      Tcl_GetString((Tcl_Obj *) msg));
+		} else {
+		    VarErrMsg(interp, part1, part2, "set", msg);
+		}
+	    }
+	    if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		ckfree(msg);
+	    } else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		Tcl_DecrRefCount((Tcl_Obj *)msg);
 	    }
 	    goto cleanup;
 	}
@@ -1466,11 +1515,23 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags)
 
     if ((flags & TCL_APPEND_VALUE) && (flags & TCL_LIST_ELEMENT)
 	    && (varPtr->tracePtr != NULL)) {
+	int resultType;
+
 	char *msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL,
-		TCL_TRACE_READS);
+		TCL_TRACE_READS, &resultType);
 	if (msg != NULL) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		VarErrMsg(interp, varName, NULL, "read", msg);
+		if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		    VarErrMsg(interp, varName, NULL, "read",
+			      Tcl_GetString((Tcl_Obj *) msg));
+		} else {
+		    VarErrMsg(interp, varName, NULL, "read", msg);
+		}
+	    }
+	    if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		ckfree(msg);
+	    } else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		Tcl_DecrRefCount((Tcl_Obj *)msg);
 	    }
 	    return NULL;
 	}
@@ -1570,11 +1631,23 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags)
      */
 
     if (varPtr->tracePtr != NULL) {
+	int resultType;
+
 	char *msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr,
-	        varName, (char *) NULL, TCL_TRACE_WRITES);
+	        varName, (char *) NULL, TCL_TRACE_WRITES, &resultType);
 	if (msg != NULL) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		VarErrMsg(interp, varName, NULL, "set", msg);
+		if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		    VarErrMsg(interp, varName, NULL, "set",
+			      Tcl_GetString((Tcl_Obj *) msg));
+		} else {
+		    VarErrMsg(interp, varName, NULL, "set", msg);
+		}
+	    }
+	    if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		ckfree(msg);
+	    } else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		Tcl_DecrRefCount((Tcl_Obj *)msg);
 	    }
 	    goto cleanup;
 	}
@@ -1776,11 +1849,23 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags)
     if ((flags & TCL_APPEND_VALUE) && (flags & TCL_LIST_ELEMENT)
 	    && ((varPtr->tracePtr != NULL)
 		    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
+	int resultType;
+
 	char *msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
-		TCL_TRACE_READS);
+		TCL_TRACE_READS, &resultType);
 	if (msg != NULL) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		VarErrMsg(interp, arrayName, elem, "read", msg);
+		if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		    VarErrMsg(interp, arrayName, elem, "read",
+			      Tcl_GetString((Tcl_Obj *) msg));
+		} else {
+		    VarErrMsg(interp, arrayName, elem, "read", msg);
+		}
+	    }
+	    if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		ckfree(msg);
+	    } else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		Tcl_DecrRefCount((Tcl_Obj *) msg);
 	    }
 	    goto errorReturn;
 	}
@@ -1851,11 +1936,23 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags)
 
     if ((varPtr->tracePtr != NULL)
 	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	int resultType;
+
 	char *msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
-		TCL_TRACE_WRITES);
+		TCL_TRACE_WRITES, &resultType);
 	if (msg != NULL) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		VarErrMsg(interp, arrayName, elem, "set", msg);
+		if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		    VarErrMsg(interp, arrayName, elem, "set",
+			      Tcl_GetString((Tcl_Obj *) msg));
+		} else {
+		    VarErrMsg(interp, arrayName, elem, "set", msg);
+		}
+	    }
+	    if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		ckfree(msg);
+	    } else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		Tcl_DecrRefCount((Tcl_Obj *) msg);
 	    }
 	    goto errorReturn;
 	}
@@ -2259,10 +2356,21 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
 
     if ((dummyVar.tracePtr != NULL)
 	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	char *msg;
+	int resultType;
+
 	varPtr->refCount++;
 	dummyVar.flags &= ~VAR_TRACE_ACTIVE;
-	(void) CallTraces(iPtr, arrayPtr, &dummyVar, part1, part2,
-		(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
+	msg = CallTraces(iPtr, arrayPtr, &dummyVar, part1, part2,
+		(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS,
+		&resultType);
+	if (msg != NULL) {
+	    if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		ckfree(msg);
+	    } else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		Tcl_DecrRefCount((Tcl_Obj *) msg);
+	    }
+	}
 	while (dummyVar.tracePtr != NULL) {
 	    VarTrace *tracePtr = dummyVar.tracePtr;
 	    dummyVar.tracePtr = tracePtr->nextPtr;
@@ -2436,11 +2544,20 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
     }
 
     /*
+     * Check for a nonsense flag combination.  Note that this is a
+     * panic() because there should be no code path that ever sets
+     * both flags.
+     */
+    if ((flags&TCL_TRACE_RESULT_DYNAMIC) && (flags&TCL_TRACE_RESULT_OBJECT)) {
+	panic("bad result flag combination");
+    }
+
+    /*
      * Set up trace information.
      */
 
-    flagMask = (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | 
-		TCL_TRACE_ARRAY);
+    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
@@ -2545,7 +2662,7 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
      * interested in now.
      */
     flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
-	TCL_TRACE_ARRAY; 
+	TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT; 
 #ifndef TCL_REMOVE_OBSOLETE_TRACES
     flagMask |= TCL_TRACE_OLD_STYLE;
 #endif
@@ -3074,11 +3191,22 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
 
     if (varPtr != NULL && varPtr->tracePtr != NULL
 	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+	int resultType;
+
 	msg = CallTraces(iPtr, arrayPtr, varPtr, varName, NULL,
 		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		TCL_TRACE_ARRAY));
+		TCL_TRACE_ARRAY), &resultType);
 	if (msg != NULL) {
-	    VarErrMsg(interp, varName, NULL, "trace array", msg);
+	    if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		VarErrMsg(interp, varName, NULL, "trace array", msg);
+		ckfree(msg);
+	    } else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		VarErrMsg(interp, varName, NULL, "trace array",
+			  Tcl_GetString((Tcl_Obj *) msg));
+		Tcl_DecrRefCount((Tcl_Obj *)msg);
+	    } else {
+		VarErrMsg(interp, varName, NULL, "trace array", msg);
+	    }
 	    return TCL_ERROR;
 	}
     }
@@ -4295,7 +4423,7 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv)
  */
 
 static char *
-CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
+CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, resultTypePtr)
     Interp *iPtr;		/* Interpreter containing variable. */
     register Var *arrayPtr;	/* Pointer to array variable that contains
 				 * the variable, or NULL if the variable
@@ -4308,6 +4436,8 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
 				 * plus other stuff like TCL_GLOBAL_ONLY,
 				 * TCL_NAMESPACE_ONLY, and
 				 * TCL_INTERP_DESTROYED. */
+    int *resultTypePtr;		/* Report what kind of result was generated
+				 * from the trace to this location. */
 {
     register VarTrace *tracePtr;
     ActiveVarTrace active;
@@ -4377,7 +4507,14 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
 	    result = (*tracePtr->traceProc)(tracePtr->clientData,
 		    (Tcl_Interp *) iPtr, part1, part2, flags);
 	    if (result != NULL) {
+		*resultTypePtr = tracePtr->flags &
+			(TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT);
 		if (flags & TCL_TRACE_UNSETS) {
+		    if (tracePtr->flags & TCL_TRACE_RESULT_DYNAMIC) {
+			ckfree(result);
+		    } else if (tracePtr->flags & TCL_TRACE_RESULT_OBJECT) {
+			Tcl_DecrRefCount((Tcl_Obj *) result);
+		    }
 		    result = NULL;
 		} else {
 		    goto done;
@@ -4403,7 +4540,14 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
 	result = (*tracePtr->traceProc)(tracePtr->clientData,
 		(Tcl_Interp *) iPtr, part1, part2, flags);
 	if (result != NULL) {
+	    *resultTypePtr = tracePtr->flags &
+		    (TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT);
 	    if (flags & TCL_TRACE_UNSETS) {
+		if (tracePtr->flags & TCL_TRACE_RESULT_DYNAMIC) {
+		    ckfree(result);
+		} else if (tracePtr->flags & TCL_TRACE_RESULT_OBJECT) {
+		    Tcl_DecrRefCount((Tcl_Obj *) result);
+		}
 		result = NULL;
 	    } else {
 		goto done;
@@ -4730,11 +4874,21 @@ TclDeleteVars(iPtr, tablePtr)
 	 */
 
 	if (varPtr->tracePtr != NULL) {
+	    char *msg;
+	    int resultType;
+
 	    objPtr = Tcl_NewObj();
 	    Tcl_IncrRefCount(objPtr); /* until done with traces */
 	    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
-	    (void) CallTraces(iPtr, (Var *) NULL, varPtr,
-		    Tcl_GetString(objPtr), (char *) NULL, flags);
+	    msg = CallTraces(iPtr, (Var *) NULL, varPtr,
+		    Tcl_GetString(objPtr), (char *) NULL, flags, &resultType);
+	    if (msg != NULL) {
+		if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		    ckfree(msg);
+		} else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		    Tcl_DecrRefCount((Tcl_Obj *) msg);
+		}
+	    }
 	    Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
 
 	    while (varPtr->tracePtr != NULL) {
@@ -4859,8 +5013,18 @@ TclDeleteCompiledLocalVars(iPtr, framePtr)
 	 */
 
 	if (varPtr->tracePtr != NULL) {
-	    (void) CallTraces(iPtr, (Var *) NULL, varPtr,
-		    varPtr->name, (char *) NULL, flags);
+	    char *msg;
+	    int resultType;
+
+	    msg = CallTraces(iPtr, (Var *) NULL, varPtr,
+		    varPtr->name, (char *) NULL, flags, &resultType);
+	    if (msg != NULL) {
+		if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		    ckfree(msg);
+		} else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		    Tcl_DecrRefCount((Tcl_Obj *) msg);
+		}
+	    }
 	    while (varPtr->tracePtr != NULL) {
 		VarTrace *tracePtr = varPtr->tracePtr;
 		varPtr->tracePtr = tracePtr->nextPtr;
@@ -4946,9 +5110,20 @@ DeleteArray(iPtr, arrayName, varPtr, flags)
 	}
 	elPtr->hPtr = NULL;
 	if (elPtr->tracePtr != NULL) {
+	    char *msg;
+	    int resultType;
+
 	    elPtr->flags &= ~VAR_TRACE_ACTIVE;
-	    (void) CallTraces(iPtr, (Var *) NULL, elPtr, arrayName,
-		    Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags);
+	    msg = CallTraces(iPtr, (Var *) NULL, elPtr, arrayName,
+		    Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags,
+		    &resultType);
+	    if (msg != NULL) {
+		if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		    ckfree(msg);
+		} else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		    Tcl_DecrRefCount((Tcl_Obj *) msg);
+		}
+	    }
 	    while (elPtr->tracePtr != NULL) {
 		VarTrace *tracePtr = elPtr->tracePtr;
 		elPtr->tracePtr = tracePtr->nextPtr;
@@ -5102,8 +5277,18 @@ TclVarTraceExists(interp, varName)
 
     if ((varPtr->tracePtr != NULL)
 	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
-	CallTraces((Interp *)interp, arrayPtr, varPtr, varName,
-		(char *) NULL, TCL_TRACE_READS);
+	char *msg;
+	int resultType;
+
+	msg = CallTraces((Interp *)interp, arrayPtr, varPtr, varName,
+		(char *) NULL, TCL_TRACE_READS, &resultType);
+	if (msg != NULL) {
+	    if (resultType & TCL_TRACE_RESULT_DYNAMIC) {
+		ckfree(msg);
+	    } else if (resultType & TCL_TRACE_RESULT_OBJECT) {
+		Tcl_DecrRefCount((Tcl_Obj *) msg);
+	    }
+	}
     }
 
     /*