diff options
author | Steve Bennett <steveb@workware.net.au> | 2014-01-05 08:42:21 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2014-01-15 07:46:32 +1000 |
commit | afe074ccf68410addadb5e30d928b05fc02fdff6 (patch) | |
tree | db6b2853cf252b6f0ae73470cc6d7023f97f97e0 /stdlib.tcl | |
parent | 4454f2a3aaa7ee629b70274687d3cb4dbf1107dd (diff) | |
download | jimtcl-afe074ccf68410addadb5e30d928b05fc02fdff6.zip jimtcl-afe074ccf68410addadb5e30d928b05fc02fdff6.tar.gz jimtcl-afe074ccf68410addadb5e30d928b05fc02fdff6.tar.bz2 |
stdlib: errorInfo includes the live stacktrace
Rather than just the error backtrace ([info stacktrace]),
include the live stacktrace. This means it is possible to do:
if {[catch $script msg]}
puts [errorInfo $msg]
}
to output the stack trace from the top level, not just from the point of capture.
It is still possible to pass a stacktrace to errorInfo to override this behaviour.
Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'stdlib.tcl')
-rw-r--r-- | stdlib.tcl | 32 |
1 files changed, 17 insertions, 15 deletions
@@ -24,45 +24,47 @@ proc function {value} { return $value } -# Returns a list of proc filename line ... +# 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 {} { +proc stacktrace {{skip 0}} { set trace {} - foreach level [range 1 [info level]] { - lassign [info frame -$level] p f l - lappend trace $p $f $l + incr skip + foreach level [range $skip [info level]] { + lappend trace {*}[info frame -$level] } return $trace } # Returns a human-readable version of a stack trace proc stackdump {stacktrace} { - set result {} - set count 0 + set lines {} foreach {l f p} [lreverse $stacktrace] { - if {$count} { - append result \n - } - incr count + set line {} if {$p ne ""} { - append result "in procedure '$p' " + append line "in procedure '$p' " if {$f ne ""} { - append result "called " + append line "called " } } if {$f ne ""} { - append result "at file \"$f\", line $l" + append line "at file \"$f\", line $l" + } + if {$line ne ""} { + lappend lines $line } } - return $result + join $lines \n } # Sort of replacement for $::errorInfo # Usage: errorInfo error ?stacktrace? 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 if {$f ne ""} { |