Attachment "trace-8.5.diff" to
ticket [1348775fff]
added by
dkf
2005-11-08 21:56:26.
Index: tclTrace.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTrace.c,v
retrieving revision 1.29
retrieving revision 1.30
diff -c -r1.29 -r1.30
--- tclTrace.c 2 Nov 2005 00:55:06 -0000 1.29
+++ tclTrace.c 8 Nov 2005 14:24:55 -0000 1.30
@@ -11,13 +11,13 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTrace.c,v 1.29 2005/11/02 00:55:06 dkf Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.30 2005/11/08 14:24:55 dkf Exp $
*/
#include "tclInt.h"
/*
- * Structure used to hold information about variable traces:
+ * Structures used to hold information about variable traces:
*/
typedef struct {
@@ -31,6 +31,11 @@
* bytes. */
} TraceVarInfo;
+typedef struct {
+ VarTrace traceInfo;
+ TraceVarInfo traceCmdInfo;
+} CombinedTraceVarInfo;
+
/*
* Structure used to hold information about command traces:
*/
@@ -132,6 +137,8 @@
int objc, Tcl_Obj *CONST objv[]);
static void StringTraceDeleteProc(ClientData clientData);
static void DisposeTraceResult(int flags, char *result);
+static int TraceVarEx(Tcl_Interp *interp, CONST char *part1,
+ CONST char *part2, register VarTrace *tracePtr);
/*
* The following structure holds the client data for string-based
@@ -893,21 +900,25 @@
command = Tcl_GetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
- TraceVarInfo *tvarPtr;
- tvarPtr = (TraceVarInfo *) ckalloc((unsigned)
- (sizeof(TraceVarInfo) - sizeof(tvarPtr->command)
- + length + 1));
- tvarPtr->flags = flags;
+ CombinedTraceVarInfo *ctvarPtr;
+
+ ctvarPtr = (CombinedTraceVarInfo *) ckalloc((unsigned)
+ (sizeof(CombinedTraceVarInfo) + length + 1
+ - sizeof(ctvarPtr->traceCmdInfo.command)));
+ ctvarPtr->traceCmdInfo.flags = flags;
if (objv[0] == NULL) {
- tvarPtr->flags |= TCL_TRACE_OLD_STYLE;
+ ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
}
- tvarPtr->length = length;
+ ctvarPtr->traceCmdInfo.length = length;
flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
- strcpy(tvarPtr->command, command);
+ strcpy(ctvarPtr->traceCmdInfo.command, command);
+ ctvarPtr->traceInfo.traceProc = TraceVarProc;
+ ctvarPtr->traceInfo.clientData = (ClientData)
+ &ctvarPtr->traceCmdInfo;
+ ctvarPtr->traceInfo.flags = flags;
name = Tcl_GetString(objv[3]);
- if (Tcl_TraceVar(interp, name, flags, TraceVarProc,
- (ClientData) tvarPtr) != TCL_OK) {
- ckfree((char *) tvarPtr);
+ if (TraceVarEx(interp,name,NULL,(VarTrace*)ctvarPtr) != TCL_OK) {
+ ckfree((char *) ctvarPtr);
return TCL_ERROR;
}
} else {
@@ -930,7 +941,6 @@
Tcl_UntraceVar2(interp, name, NULL,
flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
TraceVarProc, clientData);
- Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC);
break;
}
}
@@ -1941,8 +1951,6 @@
* it is not freed while we still need it.
*/
- Tcl_Preserve((ClientData) tvarPtr);
-
result = NULL;
if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)
&& !Tcl_LimitExceeded(interp)) {
@@ -2006,16 +2014,12 @@
Tcl_DStringFree(&cmd);
}
}
- if (destroy) {
- if (result != NULL) {
- register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
+ if (destroy && result != NULL) {
+ register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
- Tcl_DecrRefCount(errMsgObj);
- result = NULL;
- }
- Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC);
+ Tcl_DecrRefCount(errMsgObj);
+ result = NULL;
}
- Tcl_Release((ClientData) tvarPtr);
return result;
}
@@ -3017,8 +3021,59 @@
* invoked upon varName. */
ClientData clientData) /* Arbitrary argument to pass to proc. */
{
- Var *varPtr, *arrayPtr;
register VarTrace *tracePtr;
+ int result;
+
+ tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
+ tracePtr->traceProc = proc;
+ tracePtr->clientData = clientData;
+ tracePtr->flags = flags;
+
+ result = TraceVarEx(interp, part1, part2, tracePtr);
+
+ if (result != TCL_OK) {
+ ckfree((char *) tracePtr);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceVarEx --
+ *
+ * Arrange for reads and/or writes to a variable to cause a function to
+ * be invoked, which can monitor the operations and/or change their
+ * actions.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * A trace is set up on the variable given by part1 and part2, such that
+ * future references to the variable will be intermediated by the
+ * traceProc listed in tracePtr. See the manual entry for complete
+ * details on the calling sequence for proc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TraceVarEx(
+ Tcl_Interp *interp, /* Interpreter in which variable is to be
+ * traced. */
+ CONST char *part1, /* Name of scalar variable or array. */
+ CONST char *part2, /* Name of element within array; NULL means
+ * trace applies to scalar variable or array
+ * as-a-whole. */
+ register VarTrace *tracePtr)/* Structure containing flags, traceProc and
+ * clientData fields. Others should be left
+ * blank. Will be ckfree()d (eventually) if
+ * this function returns TCL_OK, and up to
+ * caller to free if this function returns
+ * TCL_ERROR. */
+{
+ Var *varPtr, *arrayPtr;
int flagMask;
/*
@@ -3030,7 +3085,7 @@
flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
varPtr = TclLookupVar(interp, part1, part2,
- (flags & flagMask) | TCL_LEAVE_ERR_MSG,
+ (tracePtr->flags & flagMask) | TCL_LEAVE_ERR_MSG,
"trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
return TCL_ERROR;
@@ -3041,7 +3096,8 @@
* because there should be no code path that ever sets both flags.
*/
- if ((flags&TCL_TRACE_RESULT_DYNAMIC) && (flags&TCL_TRACE_RESULT_OBJECT)) {
+ if ((tracePtr->flags&TCL_TRACE_RESULT_DYNAMIC)
+ && (tracePtr->flags&TCL_TRACE_RESULT_OBJECT)) {
Tcl_Panic("bad result flag combination");
}
@@ -3054,12 +3110,8 @@
#ifndef TCL_REMOVE_OBSOLETE_TRACES
flagMask |= TCL_TRACE_OLD_STYLE;
#endif
- tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
- tracePtr->traceProc = proc;
- tracePtr->clientData = clientData;
- tracePtr->flags = flags & flagMask;
+ tracePtr->flags = tracePtr->flags & flagMask;
tracePtr->nextPtr = varPtr->tracePtr;
-
varPtr->tracePtr = tracePtr;
return TCL_OK;
}
