Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.186
diff -u -r1.186 tclBasic.c
--- generic/tclBasic.c	27 Dec 2005 20:14:08 -0000	1.186
+++ generic/tclBasic.c	9 Jan 2006 17:36:18 -0000
@@ -3510,66 +3510,6 @@
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_LogCommandInfo --
- *
- *	This function is invoked after an error occurs in an interpreter. It
- *	adds information to iPtr->errorInfo field to describe the command that
- *	was being executed when the error occurred.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Information about the command is added to errorInfo and the line
- *	number stored internally in the interpreter is set.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_LogCommandInfo(
-    Tcl_Interp *interp,		/* Interpreter in which to log information. */
-    CONST char *script,		/* First character in script containing
-				 * command (must be <= command). */
-    CONST char *command,	/* First character in command that generated
-				 * the error. */
-    int length)			/* Number of bytes in command (-1 means use
-				 * all bytes up to first null byte). */
-{
-    register CONST char *p;
-    Interp *iPtr = (Interp *) interp;
-    int overflow, limit = 150;
-
-    if (iPtr->flags & ERR_ALREADY_LOGGED) {
-	/*
-	 * Someone else has already logged error information for this command;
-	 * we shouldn't add anything more.
-	 */
-
-	return;
-    }
-
-    /*
-     * Compute the line number where the error occurred.
-     */
-
-    iPtr->errorLine = 1;
-    for (p = script; p != command; p++) {
-	if (*p == '\n') {
-	    iPtr->errorLine++;
-	}
-    }
-
-    overflow = (length > limit);
-    TclFormatToErrorInfo(interp, "\n    %s\n\"%.*s%s\"",
-	    ((iPtr->errorInfo == NULL)
-	    ? "while executing" : "invoked from within"),
-	    (overflow ? limit : length), command, (overflow ? "..." : ""));
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_EvalTokensStandard --
  *
  *	Given an array of tokens parsed from a Tcl command (e.g., the tokens
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.89
diff -u -r1.89 tclNamesp.c
--- generic/tclNamesp.c	27 Nov 2005 02:33:49 -0000	1.89
+++ generic/tclNamesp.c	9 Jan 2006 17:36:19 -0000
@@ -6632,6 +6632,87 @@
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LogCommandInfo --
+ *
+ *      This function is invoked after an error occurs in an interpreter. It
+ *      adds information to iPtr->errorInfo field to describe the command that
+ *      was being executed when the error occurred.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      Information about the command is added to errorInfo and the line
+ *      number stored internally in the interpreter is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_LogCommandInfo(
+    Tcl_Interp *interp,         /* Interpreter in which to log information. */
+    CONST char *script,         /* First character in script containing
+                                 * command (must be <= command). */
+    CONST char *command,        /* First character in command that generated
+                                 * the error. */
+    int length)                 /* Number of bytes in command (-1 means use
+                                 * all bytes up to first null byte). */
+{
+    register CONST char *p;
+    Interp *iPtr = (Interp *) interp;
+    int overflow, limit = 150;
+    Var *varPtr, *arrayPtr;
+
+    if (iPtr->flags & ERR_ALREADY_LOGGED) {
+	/*
+	 * Someone else has already logged error information for this command;
+	 * we shouldn't add anything more.
+	 */
+
+        return;
+    }
+
+    /*
+     * Compute the line number where the error occurred.
+     */
+
+    iPtr->errorLine = 1;
+    for (p = script; p != command; p++) {
+	if (*p == '\n') {
+	    iPtr->errorLine++;
+	}
+    }
+
+    overflow = (length > limit);
+    TclFormatToErrorInfo(interp, "\n    %s\n\"%.*s%s\"",
+	    ((iPtr->errorInfo == NULL)
+	    ? "while executing" : "invoked from within"),
+	    (overflow ? limit : length), command, (overflow ? "..." : ""));
+
+    varPtr = TclObjLookupVar(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
+	    NULL, 0, 0, &arrayPtr);
+    if ((varPtr == NULL) || (varPtr->tracePtr == NULL)) {
+	/* Should not happen */
+	return;
+    }
+    if (varPtr->tracePtr->traceProc != EstablishErrorInfoTraces) {
+	/*
+	 * The most recent trace set on ::errorInfo is not the one
+	 * the core itself puts on last.  This means some other code
+	 * is tracing the variable, and the additional trace(s) might
+	 * be write traces that expect the timing of writes to ::errorInfo
+	 * that existed Tcl releases before 8.5.  To satisfy that
+	 * compatibility need, we write the current -errorinfo value
+	 * to the ::errorInfo variable.
+	 */
+	Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
+		iPtr->errorInfo, TCL_GLOBAL_ONLY);
+    }
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
Index: tests/error.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/error.test,v
retrieving revision 1.13
diff -u -r1.13 error.test
--- tests/error.test	28 Jul 2005 18:42:28 -0000	1.13
+++ tests/error.test	9 Jan 2006 17:36:21 -0000
@@ -220,6 +220,25 @@
     list $errorCode
 } {NONE}
 
+namespace eval ::tcl::test::error {
+    test error-7.0 {Bug 1397843} -body {
+	variable cmds
+	proc EIWrite args {
+	    variable cmds
+	    lappend cmds [lindex [info level -2] 0]
+	}
+	proc BadProc {} {
+	    set i a
+	    incr i
+	}
+	trace add variable ::errorInfo write [namespace code EIWrite]
+	catch BadProc
+	trace remove variable ::errorInfo write [namespace code EIWrite]
+	set cmds
+    } -match glob -result {*BadProc*}
+}
+namespace delete ::tcl::test::error
+
 # cleanup
 catch {rename p ""}
 ::tcltest::cleanupTests
