summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2002-03-22 22:54:35 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2002-03-22 22:54:35 (GMT)
commit5233c4e6917e720ac6a7859a68a6dc561ad2d40a (patch)
treeea73706051e17d544b90529f0c700d9dc3171f80 /generic
parent5650f82fd8c736c7cab9d1fb4a4bb100b64626de (diff)
downloadtcl-5233c4e6917e720ac6a7859a68a6dc561ad2d40a.zip
tcl-5233c4e6917e720ac6a7859a68a6dc561ad2d40a.tar.gz
tcl-5233c4e6917e720ac6a7859a68a6dc561ad2d40a.tar.bz2
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.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c19
-rw-r--r--generic/tclExecute.c66
2 files changed, 19 insertions, 66 deletions
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.