aboutsummaryrefslogtreecommitdiff
path: root/stdlib.tcl
diff options
context:
space:
mode:
authorSteve Bennett <steveb@workware.net.au>2023-05-04 12:20:59 +1000
committerSteve Bennett <steveb@workware.net.au>2023-05-06 12:43:47 +1000
commit4e0e776b2b722302c9e3d622340599ea1f9e4fe0 (patch)
treef1db98efef0ed9e3cca4ce6fbc9f28ed4d608cfd /stdlib.tcl
parentfcbb4499a6b46ef69e7a95da53e30796e20817f0 (diff)
downloadjimtcl-4e0e776b2b722302c9e3d622340599ea1f9e4fe0.zip
jimtcl-4e0e776b2b722302c9e3d622340599ea1f9e4fe0.tar.gz
jimtcl-4e0e776b2b722302c9e3d622340599ea1f9e4fe0.tar.bz2
jim: info frame improvements
always include 'proc' even if introspection disabled correctly set 'proc' at the eval frame level that is currently running in the given proc. This makes it easier to produce an accurate level stacktrace even across uplevel, etc. Update stacktrace to use the new info frame. Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'stdlib.tcl')
-rw-r--r--stdlib.tcl28
1 files changed, 5 insertions, 23 deletions
diff --git a/stdlib.tcl b/stdlib.tcl
index cd82419..804a499 100644
--- a/stdlib.tcl
+++ b/stdlib.tcl
@@ -37,32 +37,14 @@ proc function {value} {
# with 3 entries for each stack frame (proc),
# (deepest level first)
proc stacktrace {{skip 0}} {
- set trace {}
- # Need to skip info frame 0 and this (stacktrace) level
- incr skip 2
- loop level $skip [info level]+1 {
+ set frames {}
+ loop level 2 [info frame]+1 {
set frame [info frame -$level]
- lappend trace [lindex [dict getdef $frame cmd {}] 0] [dict get $frame file] [dict get $frame line]
- }
- return $trace
-}
-proc stacktrace {{skip 0}} {
- set trace {}
- # skip the internal frames
- incr skip 1
- set last 0
- loop level $skip [info frame]+1 {
- set frame [info frame -$level]
- set file [dict get $frame file]
- set line [dict get $frame line]
- set lev [dict get $frame level]
- if {$lev != $last && $lev > $skip} {
- set proc [lindex [dict get $frame cmd] 0]
- lappend trace $proc $file $line
+ if {$frame(level) > $skip && [dict exists $frame proc]} {
+ lappend frames $frame(proc) $frame(file) $frame(line)
}
- set last $lev
}
- return $trace
+ return $frames
}
# Returns a human-readable version of a stack trace