From 0b08e74e656c6bfb65c6f38657be05bb463f54e6 Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Thu, 18 May 2023 15:34:26 +1000
Subject: core: Display errors in a more "pythonesque" way

A typical error message now looks like this:

    t4.tcl:2: Error: syntax error in expression: "blah"
    Traceback (most recent call last):
      File "t4.tcl", line 14
        c 1 2 3
      File "t4.tcl", line 10, in c
        b a c
      File "t4.tcl", line 6, in b
        a A14
      File "t4.tcl", line 2, in a
        expr blah

This is produced by stackdump (that can be replaced), called by errorInfo.

Note that now stacktraces (stacktrace, info stacktrace, $opts(-errorinfo)) include
the running command at each level in addition to proc, file, line. In order for
scripts to detect this new format, a new entry tcl_platform entry has been added:
tcl_platform(stackFormat) = 4 (to signify 4 elements per frame)

In addition, instead of building the error stack frame as the stack
is unwound in response to an error, instead the entire current stack trace
is captured by stacktrace. This means that the trace extends beyond the try/catch
right back to the initial interpreter command.

The 'stacktrace' command is now implemented in C based on the same
code that generates the error stacktrace.

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 stdlib.tcl | 39 +++++++++++++--------------------------
 1 file changed, 13 insertions(+), 26 deletions(-)

(limited to 'stdlib.tcl')

diff --git a/stdlib.tcl b/stdlib.tcl
index 5945185..289acbf 100644
--- a/stdlib.tcl
+++ b/stdlib.tcl
@@ -33,39 +33,28 @@ proc function {value} {
 	return $value
 }
 
-# Returns a live stack trace as a list of proc filename line ...
-# with 3 entries for each stack frame (proc),
-# (deepest level first)
-proc stacktrace {{skip 0}} {
-	set frames {}
-	loop level $skip+1 [info frame] {
-		set frame [info frame -$level]
-		if {[dict exists $frame proc]} {
-			lappend frames $frame(proc) $frame(file) $frame(line)
-		}
-	}
-	return $frames
-}
-
 # Returns a human-readable version of a stack trace
 proc stackdump {stacktrace} {
 	set lines {}
-	foreach {l f p} [lreverse $stacktrace] {
+	lappend lines "Traceback (most recent call last):"
+	foreach {cmd l f p} [lreverse $stacktrace] {
 		set line {}
-		if {$p ne ""} {
-			append line "in procedure '$p' "
-			if {$f ne ""} {
-				append line "called "
-			}
-		}
 		if {$f ne ""} {
-			append line "at file \"$f\", line $l"
+			append line "  File \"$f\", line $l"
+		}
+		if {$p ne ""} {
+			append line ", in $p"
 		}
 		if {$line ne ""} {
 			lappend lines $line
+			if {$cmd ne ""} {
+				lappend lines "    $cmd"
+			}
 		}
 	}
-	join $lines \n
+	if {[llength $lines] > 1} {
+		return [join $lines \n]
+	}
 }
 
 # Add the given script to $jim::defer, to be evaluated when the current
@@ -81,10 +70,8 @@ proc errorInfo {msg {stacktrace ""}} {
 	if {$stacktrace eq ""} {
 		# By default add the stack backtrace and the live stacktrace
 		set stacktrace [info stacktrace]
-		# omit the procedure 'errorInfo' from the stack
-		lappend stacktrace {*}[stacktrace 1]
 	}
-	lassign $stacktrace p f l
+	lassign $stacktrace p f l cmd
 	if {$f ne ""} {
 		set result "$f:$l: Error: "
 	}
-- 
cgit v1.1