diff options
author | dgp <dgp@users.sourceforge.net> | 2007-05-07 19:45:32 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2007-05-07 19:45:32 (GMT) |
commit | da6c10f827c3825c5cdd1f0f8d1af2acba0a0ef3 (patch) | |
tree | 29ed64b0e7e0caaaf8f2c0f26ced6a0aaa35d4fa /generic/tclTrace.c | |
parent | 95748a33387880fba794dc3e9db352a218b1f84e (diff) | |
download | tcl-da6c10f827c3825c5cdd1f0f8d1af2acba0a0ef3.zip tcl-da6c10f827c3825c5cdd1f0f8d1af2acba0a0ef3.tar.gz tcl-da6c10f827c3825c5cdd1f0f8d1af2acba0a0ef3.tar.bz2 |
[Tcl Bug 1706140]
* generic/tclLink.c (LinkTraceProc): Update Tcl_VarTraceProcs so that
* generic/tclNamesp.c (Error*Read): they call Tcl_InterpDeleted()
* generic/tclTrace.c (Trace*Proc): for themselves, and do not rely
* generic/tclUtil.c (TclPrecTraceProc): on (frequently buggy) setting
of the TCL_INTERP_DESTROYED flag by the trace core.
* generic/tclVar.c: Update callers of TclCallVarTraces to not
pass in the TCL_INTERP_DESTROYED flag. Also apply filters so that
public routines only pass documented flag values down to lower level
routines.
* generic/tclTrace.c (TclCallVarTraces): The setting of the
TCL_INTERP_DESTROYED flag is now done entirely within the
TclCallVarTraces routine, the only place it can be done right.
Diffstat (limited to 'generic/tclTrace.c')
-rw-r--r-- | generic/tclTrace.c | 27 |
1 files changed, 19 insertions, 8 deletions
diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 56a165d..a575f04 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.36 2007/04/10 14:47:17 dkf Exp $ + * RCS: @(#) $Id: tclTrace.c,v 1.37 2007/05/07 19:45:33 dgp Exp $ */ #include "tclInt.h" @@ -1269,7 +1269,7 @@ TraceCommandProc( tcmdPtr->refCount++; - if ((tcmdPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED) + if ((tcmdPtr->flags & flags) && !Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { /* * Generate a command to execute by appending list elements for the @@ -1750,7 +1750,7 @@ TraceExecutionProc( return traceCode; } - if (!(flags & TCL_INTERP_DESTROYED) && !Tcl_LimitExceeded(interp)) { + if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { /* * Check whether the current call is going to eval arbitrary Tcl code * with a generated trace, or whether we are only going to setup @@ -1958,7 +1958,7 @@ TraceVarProc( */ result = NULL; - if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED) + if ((tvarPtr->flags & flags) && !Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { if (tvarPtr->length != (size_t) 0) { /* @@ -2457,10 +2457,8 @@ TclCallVarTraces( CONST char *part1, CONST char *part2, /* Variable's two-part name. */ int flags, /* Flags passed to trace functions: indicates - * what's happening to variable, plus other - * stuff like TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY, and - * TCL_INTERP_DESTROYED. */ + * what's happening to variable, plus maybe + * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */ int leaveErrMsg) /* If true, and one of the traces indicates an * error, then leave an error message and * stack trace information in *iPTr. */ @@ -2524,6 +2522,13 @@ TclCallVarTraces( } /* + * Ignore any caller-provided TCL_INTERP_DESTROYED flag. Only we can + * set it correctly. + */ + + flags &= ~TCL_INTERP_DESTROYED; + + /* * Invoke traces on the array containing the variable, if relevant. */ @@ -2543,6 +2548,9 @@ TclCallVarTraces( if (state == NULL) { state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code); } + if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) { + flags |= TCL_INTERP_DESTROYED; + } result = (*tracePtr->traceProc)(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { @@ -2582,6 +2590,9 @@ TclCallVarTraces( if (state == NULL) { state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code); } + if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) { + flags |= TCL_INTERP_DESTROYED; + } result = (*tracePtr->traceProc)(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { |