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.

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.