summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog9
-rw-r--r--generic/tclBasic.c19
-rw-r--r--generic/tclExecute.c66
3 files changed, 28 insertions, 66 deletions
diff --git a/ChangeLog b/ChangeLog
index 6ff0cb2..8e64db6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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.