summaryrefslogtreecommitdiffstats
path: root/generic/tclTrace.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2004-10-15 04:01:22 (GMT)
committerdgp <dgp@users.sourceforge.net>2004-10-15 04:01:22 (GMT)
commit0eb70513827981212a928f0a5b63afb70c53c960 (patch)
treea5072bb17646340c040c80672eeba059e8b393f0 /generic/tclTrace.c
parent2b7d6e025eefe41b48ec7f948602faf2d3bf7055 (diff)
downloadtcl-0eb70513827981212a928f0a5b63afb70c53c960.zip
tcl-0eb70513827981212a928f0a5b63afb70c53c960.tar.gz
tcl-0eb70513827981212a928f0a5b63afb70c53c960.tar.bz2
* generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp,
TclEvalObjvInternal,Tcl_LogCommandInfo,TclAddObjErrorInfo): * generic/tclCmdAH.c (Tcl_CatchObjCmd): * generic/tclEvent.c (BgError,ErrAssocData,Tcl_BackgroundError, HandleBgErrors,BgErrorDeleteProc): * generic/tclExecute.c (TclCreateExecEnv,TclDeleteExecEnv): * generic/tclIOUtil.c (comments only): * generic/tclInt.h (ExecEnv,Interp, ERR_IN_PROGRESS): * generic/tclInterp.c ([tclInit]): * generic/tclMain.c (comments only): * generic/tclNamesp.c (Tcl_CreateNamespace,Tcl_DeleteNamespace,TclTeardownNamespace): * generic/tclProc.c (TclUpdateReturnInfo): * generic/tclResult.c (Tcl_ResetResult,TclTransferResult): * generic/tclTrace.c (CallVarTraces): Reworked management of the "errorInfo" data of an interp. That information is now primarily stored in a new private (Tcl_Obj *) field of the Interp struct, rather than using a global variable ::errorInfo as the primary storage. The ERR_IN_PROGRESS flag bit value is no longer required to manage the value in its new location, and is removed. Variable traces are established to support compatibility for any code expecting the ::errorInfo variable to hold the information. ***POTENTIAL INCOMPATIBILITY*** Code that sets traces on the ::errorInfo variable may notice a difference in timing of the firing of those traces. Code that uses the value ERR_IN_PROGRESS.
Diffstat (limited to 'generic/tclTrace.c')
-rw-r--r--generic/tclTrace.c26
1 files changed, 19 insertions, 7 deletions
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 2b0f10f..b2067b3 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.15 2004/10/06 15:59:25 dgp Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.16 2004/10/15 04:01:33 dgp Exp $
*/
#include "tclInt.h"
@@ -2413,8 +2413,8 @@ TclVarTraceExists(interp, varName)
* Returns TCL_OK to indicate normal operation. Returns TCL_ERROR
* if invocation of a trace procedure indicated an error. When
* TCL_ERROR is returned and leaveErrMsg is true, then the
- * ::errorInfo variable of iPtr has information about the error
- * appended to it.
+ * errorInfo field of iPtr has information about the error
+ * placed in it.
*
* Side effects:
* Almost anything can happen, depending on trace; this procedure
@@ -2450,10 +2450,13 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
int copiedName;
int code = TCL_OK;
int disposeFlags = 0;
- int saveErrFlags = iPtr->flags
- & (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED);
+ int saveErrFlags = iPtr->flags & ERR_ALREADY_LOGGED;
+ Tcl_Obj *saveErrInfo = iPtr->errorInfo;
Tcl_Obj *saveErrCode = iPtr->errorCode;
+ if (saveErrInfo) {
+ Tcl_IncrRefCount(saveErrInfo);
+ }
if (saveErrCode) {
Tcl_IncrRefCount(saveErrCode);
}
@@ -2581,12 +2584,21 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
done:
if (code == TCL_OK) {
iPtr->flags |= saveErrFlags;
+ if (iPtr->errorInfo) {
+ Tcl_DecrRefCount(iPtr->errorInfo);
+ }
+ iPtr->errorInfo = saveErrInfo;
if (iPtr->errorCode) {
Tcl_DecrRefCount(iPtr->errorCode);
}
iPtr->errorCode = saveErrCode;
- } else if (saveErrCode) {
- Tcl_DecrRefCount(saveErrCode);
+ } else {
+ if (saveErrInfo) {
+ Tcl_DecrRefCount(saveErrInfo);
+ }
+ if (saveErrCode) {
+ Tcl_DecrRefCount(saveErrCode);
+ }
}
if (code == TCL_ERROR) {
if (leaveErrMsg) {