From a90747f408664f3324867307342bafd1038b4ddc Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 10 Mar 2005 22:10:37 +0000 Subject: * generic/tclTrace.c (TclCheckInterpTraces): Corrected mistaken cast of ClientData to (TraceCommandInfo *) when not warranted. Thanks to Yuri Victorovich for the report. [Bug 1153871] * generic/tcl.h: Moved flag values TCL_TRACE_ENTER_EXEC and * generic/tclInt.h: TCL_TRACE_LEAVE_EXEC from public interface into private. Should be used only by internal workings of execution traces. --- ChangeLog | 10 ++++++++++ generic/tcl.h | 10 +--------- generic/tclInt.h | 17 ++++++++++++++++- generic/tclTrace.c | 27 +++++++++++++-------------- 4 files changed, 40 insertions(+), 24 deletions(-) diff --git a/ChangeLog b/ChangeLog index b46f237..033caec 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2005-03-10 Don Porter + + * generic/tclTrace.c (TclCheckInterpTraces): Corrected mistaken + cast of ClientData to (TraceCommandInfo *) when not warranted. + Thanks to Yuri Victorovich for the report. [Bug 1153871] + * generic/tcl.h: Moved flag values TCL_TRACE_ENTER_EXEC and + * generic/tclInt.h: TCL_TRACE_LEAVE_EXEC from public interface + into private. Should be used only by internal workings of + execution traces. + 2005-03-08 Jeff Hobbs * win/makefile.vc: clarify necessary defined vars that can come diff --git a/generic/tcl.h b/generic/tcl.h index a79e092..97e6d25 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -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: tcl.h,v 1.196 2005/01/27 00:22:58 andreas_kupries Exp $ + * RCS: @(#) $Id: tcl.h,v 1.197 2005/03/10 22:10:38 dgp Exp $ */ #ifndef _TCL @@ -1069,14 +1069,6 @@ typedef struct Tcl_DString { #define TCL_ALLOW_INLINE_COMPILATION 0x20000 /* - * Flag values passed to Tcl_CreateObjTrace, and used internally - * by command execution traces. Slots 4,8,16 and 32 are - * used internally by execution traces (see tclCmdMZ.c) - */ -#define TCL_TRACE_ENTER_EXEC 1 -#define TCL_TRACE_LEAVE_EXEC 2 - -/* * The TCL_PARSE_PART1 flag is deprecated and has no effect. * The part1 is now always parsed whenever the part2 is NULL. * (This is to avoid a common error when converting code to diff --git a/generic/tclInt.h b/generic/tclInt.h index 2f760d1..21cd333 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.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: tclInt.h,v 1.214 2005/01/27 00:23:26 andreas_kupries Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.215 2005/03/10 22:10:38 dgp Exp $ */ #ifndef _TCLINT @@ -747,6 +747,21 @@ typedef struct ActiveInterpTrace { } ActiveInterpTrace; /* + * Flag values designating types of execution traces. + * See tclTrace.c for related flag values. + * + * TCL_TRACE_ENTER_EXEC - triggers enter/enterstep traces. + * - passed to Tcl_CreateObjTrace to set up + * "enterstep" traces. + * TCL_TRACE_LEAVE_EXEC - triggets leave/leavestep traces. + * - passed to Tcl_CreateObjTrace to set up + * "leavestep" traces. + * + */ +#define TCL_TRACE_ENTER_EXEC 1 +#define TCL_TRACE_LEAVE_EXEC 2 + +/* * The structure below defines an entry in the assocData hash table which * is associated with an interpreter. The entry contains a pointer to a * function to call when the interpreter is deleted, and a pointer to diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 5059a60..f717c8d 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -11,7 +11,7 @@ * 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.21 2004/11/15 21:47:23 dgp Exp $ + * RCS: @(#) $Id: tclTrace.c,v 1.22 2005/03/10 22:10:38 dgp Exp $ */ #include "tclInt.h" @@ -62,8 +62,8 @@ typedef struct { /* * Used by command execution traces. Note that we assume in the code - * that the first two defines are exactly 4 times the - * 'TCL_TRACE_ENTER_EXEC' and 'TCL_TRACE_LEAVE_EXEC' constants. + * that TCL_TRACE_ENTER_DURING_EXEC == 4 * TCL_TRACE_ENTER_EXEC and + * that TCL_TRACE_LEAVE_DURING_EXEC == 4 * TCL_TRACE_LEAVE_EXEC. * * TCL_TRACE_ENTER_DURING_EXEC - Trace each command inside the command * currently being traced, before execution. @@ -1462,7 +1462,6 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, ActiveInterpTrace active; int curLevel; int traceCode = TCL_OK; - TraceCommandInfo* tcmdPtr; Tcl_InterpState state = NULL; if (command == NULL || iPtr->tracePtr == NULL || @@ -1516,16 +1515,16 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, if (tracePtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) { /* New style trace */ - if ((tracePtr->flags != TCL_TRACE_EXEC_IN_PROGRESS) && - ((tracePtr->flags & traceFlags) != 0)) { - tcmdPtr = (TraceCommandInfo*)tracePtr->clientData; - tcmdPtr->curFlags = traceFlags; - tcmdPtr->curCode = code; - traceCode = (tracePtr->proc)((ClientData)tcmdPtr, - (Tcl_Interp*)interp, - curLevel, command, - (Tcl_Command)cmdPtr, - objc, objv); + if (tracePtr->flags & traceFlags) { + if (tracePtr->proc == TraceExecutionProc) { + TraceCommandInfo* tcmdPtr = + (TraceCommandInfo *) tracePtr->clientData; + tcmdPtr->curFlags = traceFlags; + tcmdPtr->curCode = code; + } + traceCode = (tracePtr->proc)(tracePtr->clientData, + interp, curLevel, command, (Tcl_Command) cmdPtr, + objc, objv); } } else { /* Old-style trace */ -- cgit v0.12