Index: library/init.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/init.tcl,v
retrieving revision 1.44
diff -u -r1.44 init.tcl
--- library/init.tcl	2000/12/11 04:17:38	1.44
+++ library/init.tcl	2001/04/06 07:21:07
@@ -200,19 +200,51 @@
 	if {$msg} {
 	    set errorCode $savedErrorCode
 	    set errorInfo $savedErrorInfo
-	    set code [catch {uplevel 1 $args} msg]
+	    namespace eval ::tcl {variable __tmpmsg ""}
+	    upvar 0 ::tcl::__tmpmsg tmpmsg
+	    set code [uplevel 1 [list catch $args ::tcl::__tmpmsg]]
 	    if {$code ==  1} {
 		#
-		# Strip the last five lines off the error stack (they're
-		# from the "uplevel" command).
+		# Compute stack trace contribution from the "eval" (catch)
+		# of $args
 		#
-
-		set new [split $errorInfo \n]
-		set new [join [lrange $new 0 [expr {[llength $new] - 6}]] \n]
+		set cinfo $args
+		if {[string length $cinfo] > 150} {
+		    set cinfo "[string range $cinfo 0 149]..."
+		}
+		#
+		# Try each possible form of the stack trace
+		# and trim the extra contribution from the matching case
+		#
+		set expect "$tmpmsg\n    while executing\n\"$cinfo\""
+		if {[string compare $errorInfo $expect] == 0} {
+		    #
+		    # The stack has only the eval from the expanded command
+		    # Do not generate any stack trace here.
+		    #
+		    return -code error -errorcode $errorCode $tmpmsg
+		}
+		#
+		# Stack trace is nested, trim off just the contribution
+		# from the extra "eval" of $args due to the "catch" above.
+		#
+		set expect "\n    invoked from within\n\"$cinfo\""
+		set exlen [string length $expect]
+		set eilen [string length $errorInfo]
+		set i [expr {$eilen - $exlen - 1}]
+		set einfo [string range $errorInfo 0 $i]
+		#
+		# For now verify that $errorInfo consists of what we are about
+		# to return plus what we expected to trim off.
+		#
+		if {[string compare $errorInfo "$einfo$expect"] != 0} {
+		    error "Tcl bug: unexpected stack trace in \"unknown\"" {} \
+			[list CORE UNKNOWN BADTRACE $expect $errorInfo"]
+		}
 		return -code error -errorcode $errorCode \
-			-errorinfo $new $msg
+		    -errorinfo $einfo $tmpmsg
 	    } else {
-		return -code $code $msg
+		return -code $code $::tcl::__tmpmsg
 	    }
 	}
     }
Index: tests/init.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/init.test,v
retrieving revision 1.7
diff -u -r1.7 init.test
--- tests/init.test	2000/05/03 00:14:36	1.7
+++ tests/init.test	2001/04/06 07:21:11
@@ -149,21 +149,61 @@
     foo:::bar::blah
 } 1
 
+# Tests that compare the error stack trace generated when autoloading
+# with that generated when no autoloading is necessary.  Ideally they
+# should be the same.
+
+set count 0
+foreach arg {
+		c
+                {argument
+                which spans
+                multiple lines}
+                {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
+                {argument which spans multiple lines
+                and is long enough to be truncated and
+"               <- includes a false lead in the prune point search
+                and must be longer still to force truncation}
+                {contrived example: rare circumstance 
+		where the point at which to prune the
+		error stack cannot be uniquely determined.
+		foo bar foo
+"}
+                {contrived example: rare circumstance 
+		where the point at which to prune the
+		error stack cannot be uniquely determined.
+		foo bar
+"}
+	} {
+
+    test init-4.$count.0 {::errorInfo produced by [unknown]} {
+	auto_reset
+	catch {parray a b $arg}
+	set first $::errorInfo
+	catch {parray a b $arg}
+	set second $::errorInfo
+	string equal $first $second
+    } 1
+
+    test init-4.$count.1 {::errorInfo produced by [unknown]} {
+	auto_reset
+	namespace eval junk [list array set $arg [list 1 2 3 4]]
+	trace variable ::junk::$arg r \
+		"[list error [subst {Variable \"$arg\" is write-only}]] ;# "
+	catch {parray ::junk::$arg}
+	set first $::errorInfo
+	catch {parray ::junk::$arg}
+	set second $::errorInfo
+	string equal $first $second
+    } 1
+
+    incr count
 }
 
+}	;#  End of [interp eval $testInterp]
+
 # cleanup
 interp delete $testInterp
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
 
