The following will list the entire call stack at entry to a proc or method.
proc x {a} {
puts "Entered x, args $a"
set distanceToTop [info level]
for {set i 1} {$i < $distanceToTop} {incr i} {
set callerlevel [expr {$distanceToTop - $i}]
puts "CALLER $callerlevel: [info level $callerlevel]"
}
# ...
return
}KPV Here's another version which prints out argument values (even default one). (See also
Pstack.)
proc stacktrace {} {
set stack "Stack trace:\n"
for {set i 1} {$i < [info level]} {incr i} {
set lvl [info level -$i]
set pname [lindex $lvl 0]
append stack [string repeat " " $i]$pname
foreach value [lrange $lvl 1 end] arg [info args $pname] {
if {$value eq ""} {
info default $pname $arg value
}
append stack " $arg='$value'"
}
append stack \n
}
return $stack
}
# Testing code
proc A { } {
B 3
}
proc B { x } {
C [incr x] 2
}
proc C { x y {z 5} } {
D [incr x] [incr y] $z
}
proc D { x y z} {
E [incr x] [incr y] [incr z]
}
proc E {x y z } {
stacktrace
}
ANapier notes that the above solutions will not work if you are using TclOO as
[info args my
] will result in an error.
DKF: Yes, there's other mechanisms for introspecting TclOO methods on the stack. The
self class/
self method command
when run in the right stack scope will be useful, as will
info class definition and/or
info object definition:
self class and
self method say what is running, and
info class definition is like
info args and
info body rolled into one. (Methods aren't
quite procedures. They're just very similar.)
Martyn Smith Notes that this does not work for namespace procedures either which are not qualified when called, the
[info args $pname
] generates an error because pname is not qualified.
namespace eval ns {
proc a {} {
puts ns::a
b hello
}
proc b {x} {
puts ns::b
puts "=========\n[stacktrace]\n=========="
}
}
ns::aCRN: For solving namespace issue you can use
info frame. Here a small exemple :
proc callstack {} {
set stack [list "Stacktrace:"]
for {set i 1} {$i < [info level]} {incr i} {
set level [info level -$i]
set frame [info frame -$i]
if {[dict exists $frame proc]} {
set pname [dict get $frame proc]
set pargs [lrange $level 1 end]
lappend stack " - $pname"
foreach arg $pargs {
lappend stack " * $arg"
}
} else {
lappend stack " - **unknown stack item**: $level $frame"
}
}
return [join $stack "\n"]
}
