Attachment "trace.diff" to
ticket [1693986fff]
added by
msofer
2007-04-04 09:13:25.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.241
diff -u -r1.241 tclBasic.c
--- generic/tclBasic.c 3 Apr 2007 01:34:35 -0000 1.241
+++ generic/tclBasic.c 4 Apr 2007 02:09:35 -0000
@@ -3404,10 +3404,9 @@
* the words that make up the command. */
const char *command, /* Points to the beginning of the string
* representation of the command; this is used
- * for traces. If the string representation of
- * the command is unknown, an empty string
- * should be supplied. If it is NULL, no
- * traces will be called. */
+ * for traces. NULL causes a string
+ * representation to be computed from
+ * objc/objv */
int length, /* Number of bytes in command; if -1, all
* characters up to the first null byte are
* used. */
@@ -3563,7 +3562,7 @@
* Call trace functions if needed.
*/
- if (checkTraces && (command != NULL)) {
+ if (checkTraces) {
int cmdEpoch = cmdPtr->cmdEpoch;
int newEpoch;
@@ -3700,37 +3699,11 @@
* currently supported. */
{
Interp *iPtr = (Interp *) interp;
- Trace *tracePtr;
- Tcl_DString cmdBuf;
- const char *cmdString = ""; /* A command string is only necessary for
- * command traces or error logs; it will be
- * generated to replace this default value if
- * necessary. */
- int cmdLen = 0; /* A non-zero value indicates that a command
- * string was generated. */
- int code = TCL_OK;
- int i;
+ int code;
int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
- for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) {
- if ((tracePtr->level == 0) || (iPtr->numLevels <= tracePtr->level)) {
- /*
- * The command may be needed for an execution trace. Generate a
- * command string.
- */
-
- Tcl_DStringInit(&cmdBuf);
- for (i = 0; i < objc; i++) {
- Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
- }
- cmdString = Tcl_DStringValue(&cmdBuf);
- cmdLen = Tcl_DStringLength(&cmdBuf);
- break;
- }
- }
-
iPtr->numLevels++;
- code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags);
+ code = TclEvalObjvInternal(interp, objc, objv, NULL, 0, flags);
iPtr->numLevels--;
/*
@@ -3754,20 +3727,16 @@
* error log: generate it now if it was not done previously.
*/
- if (cmdLen == 0) {
- Tcl_DStringInit(&cmdBuf);
- for (i = 0; i < objc; i++) {
- Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
- }
- cmdString = Tcl_DStringValue(&cmdBuf);
- cmdLen = Tcl_DStringLength(&cmdBuf);
- }
+ Tcl_Obj *listObjPtr;
+ const char *cmdString;
+ int cmdLen;
+
+ listObjPtr = Tcl_NewListObj(objc, objv);
+ cmdString = Tcl_GetStringFromObj(listObjPtr, &cmdLen);
Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
+ Tcl_DecrRefCount(listObjPtr);;
}
- if (cmdLen != 0) {
- Tcl_DStringFree(&cmdBuf);
- }
return code;
}
Index: generic/tclTrace.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTrace.c,v
retrieving revision 1.35
diff -u -r1.35 tclTrace.c
--- generic/tclTrace.c 2 Apr 2007 18:48:04 -0000 1.35
+++ generic/tclTrace.c 4 Apr 2007 02:09:37 -0000
@@ -1412,8 +1412,11 @@
int traceCode = TCL_OK;
TraceCommandInfo* tcmdPtr;
Tcl_InterpState state = NULL;
+ Tcl_Obj *commandPtr = NULL;
+ int nulTerminated = (command &&
+ ((numChars == -1) || (command[numChars] == '\0')));
- if (command == NULL || cmdPtr->tracePtr == NULL) {
+ if (cmdPtr->tracePtr == NULL) {
return traceCode;
}
@@ -1452,6 +1455,25 @@
if (state == NULL) {
state = Tcl_SaveInterpState(interp, code);
}
+
+ /*
+ * Insure that we have a nul-terminated 'command' string
+ */
+
+ if (nulTerminated) {
+ if (numChars == -1) {
+ numChars = strlen(command);
+ }
+ } else if (command) {
+ commandPtr = Tcl_NewStringObj(command, numChars);
+ command = Tcl_GetString(commandPtr);
+ nulTerminated = 1;
+ } else {
+ commandPtr = Tcl_NewListObj(objc, objv);
+ command = Tcl_GetStringFromObj(commandPtr, &numChars);
+ nulTerminated = 1;
+ }
+
traceCode = TraceExecutionProc((ClientData)tcmdPtr, interp,
curLevel, command, (Tcl_Command)cmdPtr, objc, objv);
if ((--tcmdPtr->refCount) <= 0) {
@@ -1467,6 +1489,10 @@
if (state) {
(void) Tcl_RestoreInterpState(interp, state);
}
+
+ if (commandPtr) {
+ Tcl_DecrRefCount(commandPtr);
+ }
return(traceCode);
}
@@ -1512,8 +1538,11 @@
int curLevel;
int traceCode = TCL_OK;
Tcl_InterpState state = NULL;
+ Tcl_Obj *commandPtr = NULL;
+ int nulTerminated = (command &&
+ ((numChars == -1) || (command[numChars] == '\0')));
- if (command == NULL || iPtr->tracePtr == NULL
+ if ((iPtr->tracePtr == NULL)
|| (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
return(traceCode);
}
@@ -1568,6 +1597,24 @@
state = Tcl_SaveInterpState(interp, code);
}
+ /*
+ * Insure that we have a nul-terminated 'command' string
+ */
+
+ if (nulTerminated) {
+ if (numChars == -1) {
+ numChars = strlen(command);
+ }
+ } else if (command) {
+ commandPtr = Tcl_NewStringObj(command, numChars);
+ command = Tcl_GetString(commandPtr);
+ nulTerminated = 1;
+ } else {
+ commandPtr = Tcl_NewListObj(objc, objv);
+ command = Tcl_GetStringFromObj(commandPtr, &numChars);
+ nulTerminated = 1;
+ }
+
if (tracePtr->flags &
(TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) {
/*
@@ -1615,6 +1662,10 @@
Tcl_DiscardInterpState(state);
}
}
+
+ if (commandPtr) {
+ Tcl_DecrRefCount(commandPtr);
+ }
return(traceCode);
}
