diff options
author | dgp <dgp@users.sourceforge.net> | 2004-10-15 04:01:22 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2004-10-15 04:01:22 (GMT) |
commit | 0eb70513827981212a928f0a5b63afb70c53c960 (patch) | |
tree | a5072bb17646340c040c80672eeba059e8b393f0 /generic/tclResult.c | |
parent | 2b7d6e025eefe41b48ec7f948602faf2d3bf7055 (diff) | |
download | tcl-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/tclResult.c')
-rw-r--r-- | generic/tclResult.c | 58 |
1 files changed, 27 insertions, 31 deletions
diff --git a/generic/tclResult.c b/generic/tclResult.c index 9870501..9fd0bfc 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclResult.c,v 1.14 2004/10/06 15:59:25 dgp Exp $ + * RCS: @(#) $Id: tclResult.c,v 1.15 2004/10/15 04:01:33 dgp Exp $ */ #include "tclInt.h" @@ -732,12 +732,20 @@ Tcl_ResetResult(interp) iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; if (iPtr->errorCode) { - Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL, + /* Legacy support */ + Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL, iPtr->errorCode, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(iPtr->errorCode); iPtr->errorCode = NULL; } - iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS); + if (iPtr->errorInfo) { + /* Legacy support*/ + Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, + iPtr->errorInfo, TCL_GLOBAL_ONLY); + Tcl_DecrRefCount(iPtr->errorInfo); + iPtr->errorInfo = NULL; + } + iPtr->flags &= ~ERR_ALREADY_LOGGED; } /* @@ -794,26 +802,23 @@ ResetObjResult(iPtr) * None. * * Side effects: - * The errorCode global variable is modified to hold all of the + * The errorCode field of the interp is modified to hold all of the * arguments to this procedure, in a list form with each argument - * becoming one element of the list. A flag is set internally - * to remember that errorCode has been set, so the variable doesn't - * get set automatically when the error is returned. + * becoming one element of the list. * *---------------------------------------------------------------------- */ void Tcl_SetErrorCodeVA (interp, argList) - Tcl_Interp *interp; /* Interpreter in which to access the errorCode - * variable. */ + Tcl_Interp *interp; /* Interpreter in which to set errorCode */ va_list argList; /* Variable argument list. */ { Tcl_Obj *errorObj = Tcl_NewObj(); /* * Scan through the arguments one at a time, appending them to - * $errorCode as list elements. + * the errorCode field as list elements. */ while (1) { @@ -838,11 +843,9 @@ Tcl_SetErrorCodeVA (interp, argList) * None. * * Side effects: - * The errorCode global variable is modified to hold all of the + * The errorCode field of the interp is modified to hold all of the * arguments to this procedure, in a list form with each argument - * becoming one element of the list. A flag is set internally - * to remember that errorCode has been set, so the variable doesn't - * get set automatically when the error is returned. + * becoming one element of the list. * *---------------------------------------------------------------------- */ @@ -855,7 +858,7 @@ Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1) /* * Scan through the arguments one at a time, appending them to - * $errorCode as list elements. + * the errorCode field as list elements. */ interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList); @@ -876,10 +879,7 @@ Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1) * None. * * Side effects: - * The errorCode global variable is modified to be the new value. - * A flag is set internally to remember that errorCode has been - * set, so the variable doesn't get set automatically when the - * error is returned. + * The errorCode field of the interp is set to the new value. * *---------------------------------------------------------------------- */ @@ -917,9 +917,9 @@ Tcl_SetObjErrorCode(interp, errorObjPtr) * * Results: * The target interp's result is set to a copy of the source interp's - * result. The source's error information "$errorInfo" may be - * appended to the target's error information and the source's error - * code "$errorCode" may be stored in the target's error code. + * result. The source's errorInfo field may be transferred to the + * target's errorInfo field, and the source's errorCode field may be + * transferred to the target's errorCode field. * * Side effects: * None. @@ -963,17 +963,13 @@ TclTransferResult(sourceInterp, result, targetInterp) Tcl_ResetResult(targetInterp); - objPtr = Tcl_GetVar2Ex(sourceInterp, "errorInfo", NULL, - TCL_GLOBAL_ONLY); - if (objPtr) { - Tcl_SetVar2Ex(targetInterp, "errorInfo", NULL, objPtr, - TCL_GLOBAL_ONLY); - ((Interp *) targetInterp)->flags |= ERR_IN_PROGRESS; + if (iPtr->errorInfo) { + ((Interp *) targetInterp)->errorInfo = iPtr->errorInfo; + Tcl_IncrRefCount(((Interp *) targetInterp)->errorInfo); } - objPtr = ((Interp *) sourceInterp)->errorCode; - if (objPtr) { - Tcl_SetObjErrorCode(targetInterp, objPtr); + if (iPtr->errorCode) { + Tcl_SetObjErrorCode(targetInterp, iPtr->errorCode); } } |