diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclBasic.c | 19 | ||||
| -rw-r--r-- | generic/tclExecute.c | 66 |
3 files changed, 28 insertions, 66 deletions
@@ -1,3 +1,12 @@ +2002-03-22 Miguel Sofer <msofer@users.sourceforge.net> + + * generic/tclBasic.c (Tcl_EvalObjEx): + * generic/tclExecute.c (TclCompEvalObj): fixed the errorInfo for + return codes other than (TCL_OK, TCL_ERROR) to runLevel 0 + [Bug 533758]. Removed the static RecordTracebackInfo(), as its + functionality is easily replicated by Tcl_LogCommandInfo. Bug + and redundancy noted by Don Porter. + 2002-03-21 Donal K. Fellows <fellowsd@cs.man.ac.uk> * doc/expr.n: Improved documentation for ceil and floor [Bug 350535] diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 003851b..b3da352 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -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: tclBasic.c,v 1.50 2002/03/01 06:22:48 hobbs Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.51 2002/03/22 22:54:35 msofer Exp $ */ #include "tclInt.h" @@ -3818,6 +3818,7 @@ Tcl_EvalObjEx(interp, objPtr, flags) * TCL_EVAL_DIRECT. */ { register Interp *iPtr = (Interp *) interp; + char *script; int numSrcBytes; int result; CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr @@ -3848,9 +3849,8 @@ Tcl_EvalObjEx(interp, objPtr, flags) result = Tcl_EvalObjv(interp, listRepPtr->elemCount, listRepPtr->elements, flags); } else { - register char *p; - p = Tcl_GetStringFromObj(objPtr, &numSrcBytes); - result = Tcl_EvalEx(interp, p, numSrcBytes, flags); + script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); + result = Tcl_EvalEx(interp, script, numSrcBytes, flags); } } else { /* @@ -3877,6 +3877,17 @@ Tcl_EvalObjEx(interp, objPtr, flags) && ((iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS) == 0)) { ProcessUnexpectedResult(interp, result); result = TCL_ERROR; + + /* + * If an error was created here, record information about + * what was being executed when the error occurred. + */ + + if (!(iPtr->flags & ERR_ALREADY_LOGGED)) { + script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); + Tcl_LogCommandInfo(interp, script, script, numSrcBytes); + iPtr->flags &= ~ERR_ALREADY_LOGGED; + } } } iPtr->evalFlags = 0; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 1745650..92e345f 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.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: tclExecute.c,v 1.49 2002/02/28 13:03:53 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.50 2002/03/22 22:54:35 msofer Exp $ */ #include "tclInt.h" @@ -353,11 +353,6 @@ static void InitByteCodeExecution _ANSI_ARGS_(( Tcl_Interp *interp)); #ifdef TCL_COMPILE_DEBUG static void PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr)); -#endif -static void RecordTracebackInfo _ANSI_ARGS_(( - Tcl_Interp *interp, Tcl_Obj *objPtr, - int numSrcBytes)); -#ifdef TCL_COMPILE_DEBUG static char * StringForResultCode _ANSI_ARGS_((int result)); static void ValidatePcAndStackTop _ANSI_ARGS_(( ByteCode *codePtr, unsigned char *pc, @@ -836,6 +831,7 @@ TclCompEvalObj(interp, objPtr, engineCall) register ByteCode* codePtr; /* Tcl Internal type of bytecode. */ int oldCount = iPtr->cmdCount; /* Used to tell whether any commands * at all were executed. */ + char *script; int numSrcBytes; int result; Namespace *namespacePtr; @@ -964,7 +960,8 @@ TclCompEvalObj(interp, objPtr, engineCall) */ if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { - RecordTracebackInfo(interp, objPtr, numSrcBytes); + script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); + Tcl_LogCommandInfo(interp, script, script, numSrcBytes); } /* @@ -993,61 +990,6 @@ TclCompEvalObj(interp, objPtr, engineCall) /* *---------------------------------------------------------------------- * - * RecordTracebackInfo -- - * - * Procedure called by Tcl_EvalObj to record information about what was - * being executed when the error occurred. - * - * Results: - * None. - * - * Side effects: - * Appends information about the script being evaluated to the - * interpreter's "errorInfo" variable. - * - *---------------------------------------------------------------------- - */ - -static void -RecordTracebackInfo(interp, objPtr, numSrcBytes) - Tcl_Interp *interp; /* The interpreter in which the error - * occurred. */ - Tcl_Obj *objPtr; /* Points to object containing script whose - * evaluation resulted in an error. */ - int numSrcBytes; /* Number of bytes compiled in script. */ -{ - Interp *iPtr = (Interp *) interp; - char buf[200]; - char *ellipsis, *bytes; - int length; - - /* - * Decide how much of the command to print in the error message - * (up to a certain number of bytes). - */ - - bytes = Tcl_GetStringFromObj(objPtr, &length); - length = TclMin(numSrcBytes, length); - - ellipsis = ""; - if (length > 150) { - length = 150; - ellipsis = " ..."; - } - - if (!(iPtr->flags & ERR_IN_PROGRESS)) { - sprintf(buf, "\n while executing\n\"%.*s%s\"", - length, bytes, ellipsis); - } else { - sprintf(buf, "\n invoked from within\n\"%.*s%s\"", - length, bytes, ellipsis); - } - Tcl_AddObjErrorInfo(interp, buf, -1); -} - -/* - *---------------------------------------------------------------------- - * * TclExecuteByteCode -- * * This procedure executes the instructions of a ByteCode structure. |