TIP #348 IMPLEMENTATION - Substituted error stack

1 files changed, 42 insertions, 1 deletions

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index e32e0ba..41032d1 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.204 2010/03/05 14:34:04 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.205 2010/04/05 19:44:45 ferrieux Exp $
  */
 
 #include "tclInt.h"
@@ -4932,6 +4932,45 @@ Tcl_LogCommandInfo(
 		    TCL_GLOBAL_ONLY);
 	}
     }
+
+    /*
+     * TIP #348
+     */
+
+    if (Tcl_IsShared(iPtr->errorStack)) {
+        Tcl_Obj *newObj;
+            
+        newObj = Tcl_DuplicateObj(iPtr->errorStack);
+        Tcl_DecrRefCount(iPtr->errorStack);
+        Tcl_IncrRefCount(newObj);
+        iPtr->errorStack = newObj;
+    }
+    if (iPtr->resetErrorStack) {
+	int len;
+
+        iPtr->resetErrorStack = 0;
+	Tcl_ListObjLength(interp, iPtr->errorStack, &len);
+        /* reset while keeping the list intrep as much as possible */
+        Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
+    } 
+
+    if (iPtr->varFramePtr != iPtr->framePtr) {
+        /* uplevel case, [lappend errorstack UP $relativelevel] */
+        struct CallFrame *frame;
+        int n;
+
+        for (n=0, frame=iPtr->framePtr;
+		(frame && (frame != iPtr->varFramePtr));
+		n++, frame=frame->callerVarPtr);
+        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
+        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj(n));
+    } else if (iPtr->framePtr != iPtr->rootFramePtr) {
+        /* normal case, [lappend errorstack CALL [info level 0]] */
+        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
+        Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
+                                 Tcl_NewListObj(iPtr->varFramePtr->objc,
+                                                iPtr->varFramePtr->objv));
+    }
 }
 
 /*
@@ -4939,5 +4978,7 @@ Tcl_LogCommandInfo(
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
  * End:
  */