Index: generic/tclTrace.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTrace.c,v
retrieving revision 1.18
diff -u -r1.18 tclTrace.c
--- generic/tclTrace.c	25 Oct 2004 01:06:51 -0000	1.18
+++ generic/tclTrace.c	3 Nov 2004 17:03:47 -0000
@@ -2554,19 +2554,33 @@
     if (code == TCL_ERROR) {
 	if (leaveErrMsg) {
 	    CONST char *type = "";
+	    Tcl_Obj *options = TclGetReturnOptions((Tcl_Interp *)iPtr, code);
+	    Tcl_Obj *errorInfoKey = Tcl_NewStringObj("-errorinfo", -1);
+	    Tcl_Obj *errorInfo;
+
+	    Tcl_IncrRefCount(errorInfoKey);
+	    Tcl_DictObjGet(NULL, options, errorInfoKey, &errorInfo);
+	    Tcl_IncrRefCount(errorInfo);
+	    Tcl_DictObjRemove(NULL, options, errorInfoKey);
+	    if (Tcl_IsShared(errorInfo)) {
+		Tcl_DecrRefCount(errorInfo);
+		errorInfo = Tcl_DuplicateObj(errorInfo);
+		Tcl_IncrRefCount(errorInfo);
+	    }
+	    Tcl_AppendToObj(errorInfo, "\n    (", -1);
 	    switch (flags&(TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_ARRAY)) {
-		case TCL_TRACE_READS: {
+		case TCL_TRACE_READS:
 		    type = "read";
+		    Tcl_AppendToObj(errorInfo, type, -1);
 		    break;
-		}
-		case TCL_TRACE_WRITES: {
+		case TCL_TRACE_WRITES:
 		    type = "set";
+		    Tcl_AppendToObj(errorInfo, "write", -1);
 		    break;
-		}
-		case TCL_TRACE_ARRAY: {
+		case TCL_TRACE_ARRAY:
 		    type = "trace array";
+		    Tcl_AppendToObj(errorInfo, "array", -1);
 		    break;
-		}
 	    }
 	    if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
 		TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, type,
@@ -2574,6 +2588,19 @@
 	    } else {
 		TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, type, result);
 	    }
+	    Tcl_AppendToObj(errorInfo, " trace on \"", -1);
+	    Tcl_AppendToObj(errorInfo, part1, -1);
+	    if (part2 != NULL) {
+		Tcl_AppendToObj(errorInfo, "(", -1);
+		Tcl_AppendToObj(errorInfo, part1, -1);
+		Tcl_AppendToObj(errorInfo, ")", -1);
+	    }
+	    Tcl_AppendToObj(errorInfo, "\")", -1);
+	    Tcl_DictObjPut(NULL, options, errorInfoKey, errorInfo);
+	    Tcl_DecrRefCount(errorInfoKey);
+	    Tcl_DecrRefCount(errorInfo);
+	    code = TclSetReturnOptions((Tcl_Interp *)iPtr, options);
+	    iPtr->flags &= ~(ERR_ALREADY_LOGGED);
 	    TclDiscardInterpState(state);
 	} else {
 	    (void) TclRestoreInterpState((Tcl_Interp *)iPtr, state);
Index: tests/incr-old.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/incr-old.test,v
retrieving revision 1.7
diff -u -r1.7 incr-old.test
--- tests/incr-old.test	27 Mar 2003 13:19:15 -0000	1.7
+++ tests/incr-old.test	3 Nov 2004 17:03:48 -0000
@@ -16,7 +16,7 @@
 # RCS: @(#) $Id: incr-old.test,v 1.7 2003/03/27 13:19:15 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
@@ -65,13 +65,14 @@
     (reading increment)
     invoked from within
 "incr x 1a"}}
-test incr-old-2.6 {incr errors} {
+test incr-old-2.6 {incr errors} -body {
     proc readonly args {error "variable is read-only"}
     set x 123
     trace var x w readonly
     list [catch {incr x 1} msg] $msg $errorInfo
-} {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
+} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
     while executing
+*
 "incr x 1"}}
 catch {unset x}
 test incr-old-2.7 {incr errors} {
Index: tests/incr.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/incr.test,v
retrieving revision 1.10
diff -u -r1.10 incr.test
--- tests/incr.test	26 Sep 2004 16:36:06 -0000	1.10
+++ tests/incr.test	3 Nov 2004 17:03:48 -0000
@@ -221,13 +221,14 @@
 } -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}}
-test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} {
+test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} -body {
     proc readonly args {error "variable is read-only"}
     set x 123
     trace var x w readonly
     list [catch {incr x 1} msg] $msg $errorInfo
-} {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
+} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
     while executing
+*
 "incr x 1"}}
 catch {unset x}
 test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
@@ -478,14 +479,15 @@
 } -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}}
-test incr-2.28 {incr command (not compiled): runtime error, readonly variable} {
+test incr-2.28 {incr command (not compiled): runtime error, readonly variable} -body {
     set z incr
     proc readonly args {error "variable is read-only"}
     set x 123
     trace var x w readonly
     list [catch {$z x 1} msg] $msg $errorInfo
-} {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
+} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
     while executing
+*
 "$z x 1"}}
 catch {unset x}
 test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
Index: tests/set.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/set.test,v
retrieving revision 1.8
diff -u -r1.8 set.test
--- tests/set.test	10 Apr 2000 17:19:04 -0000	1.8
+++ tests/set.test	3 Nov 2004 17:03:48 -0000
@@ -13,7 +13,7 @@
 # RCS: @(#) $Id: set.test,v 1.8 2000/04/10 17:19:04 ericm Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
@@ -247,13 +247,14 @@
     set a(6) 44
     list [catch {set a(18)} msg] $msg
 } {1 {can't read "a(18)": no such element in array}}
-test set-2.4 {set command: runtime error, readonly variable} {
+test set-2.4 {set command: runtime error, readonly variable} -body {
     proc readonly args {error "variable is read-only"}
     set x 123
     trace var x w readonly
     list [catch {set x 1} msg] $msg $errorInfo
-} {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
+} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
     while executing
+*
 "set x 1"}}
 test set-2.5 {set command: runtime error, basic array operations} {
     list [catch {set a(other)} msg] $msg
@@ -492,14 +493,15 @@
     $z a(6) 44
     list [catch {$z a(18)} msg] $msg
 } {1 {can't read "a(18)": no such element in array}}
-test set-4.4 {uncompiled set command: runtime error, readonly variable} {
+test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
     set z set
     proc readonly args {error "variable is read-only"}
     $z x 123
     trace var x w readonly
     list [catch {$z x 1} msg] $msg $errorInfo
-} {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
+} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
     while executing
+*
 "$z x 1"}}
 test set-4.5 {uncompiled set command: runtime error, basic array operations} {
     set z set
Index: tests/trace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/trace.test,v
retrieving revision 1.34
diff -u -r1.34 trace.test
--- tests/trace.test	1 Mar 2004 17:33:45 -0000	1.34
+++ tests/trace.test	3 Nov 2004 17:03:48 -0000
@@ -2197,6 +2197,21 @@
     set result
 } [list [list delete foo]]
 
+test trace-33.1 {527164: Keep -errorinfo of traces} {
+    unset -nocomplain x y
+    trace add variable x write {error foo;#}
+    trace add variable y write {set x 2;#}
+    list [catch {set y 1} msg opts] $msg [dict get $opts -errorinfo]
+} {1 {can't set "y": can't set "x": foo} {foo
+    while executing
+"error foo"
+    (write trace on "x")
+    invoked from within
+"set x 2"
+    (write trace on "y")
+    invoked from within
+"set y 1"}}
+
 # Delete procedures when done, so we don't clash with other tests
 # (e.g. foobar will clash with 'unknown' tests).
 catch {rename foobar {}}
