2007-09-08 Sarnold: I felt the need of a command-line debugger for some console scripts I wrote on Linux. Visiting the wiki brought me a sort of challenge: create a debugger in pure-Tcl, which, I would like to, would be easy to use, ideally:
tcldebug myapp.tcl args...
where myapp.tcl is an unmodified Tcl application.
Well, I could not win the challenge, and myapp.tcl has to be modified (just adding one line) to be inspected for. Indeed, my debugger tries to put traces on procs and variables, and just as any debugger, these procs and variables need to have been created before the user put traces.
Now, let the code speak...
Instead of the classical
tclsh myapp.tcl ?args...?
just type:
tclsh tcldebug myapp.tcl ?args...?
And insert in myapp.tcl:
catch {tcldebug::debug}after all your procs definitions.
tcldebug
#!/usr/bin/env tclsh
namespace eval ::tcldebug {
variable break ""
variable log ""
variable enter ""
variable step ""
variable argv
variable argv0
set argv $::argv
set argv0 $::argv0
proc var {name key} {
if {$key eq ""} {return $name}
return $name\($key\)
}
proc Log {name1 name2 op} {
switch -- $op {
read - write {
eputs "$op [var $name1 $name2]=[uplevel 1 set [var $name1 $name2]]"
}
unset {
eputs "unset [var $name1 $name2]"
if {[Unlog [var $name1 $name2]]<0} {
Unlog $name1
}
}
default {error "unknown $op"}
}
}
proc Unlog {name} {
variable log
set i [lsearch -exact $log $name]
if {$i<0} {return -1}
set log [lreplace $log $i $i]
catch {
trace remove variable $name {read write unset} ::tcldebug::Log
}
return 0
}
proc Store {list elt} {
if {[lsearch -exact $list $elt]>=0} {return $list}
lappend list $elt
return $list
}
proc Break {name1 name2 op} {
switch -- $op {
read - write {
eputs "$op [var $name1 $name2]=[uplevel 1 set [var $name1 $name2]]"
uplevel 1 ::tcldebug::debug
}
unset {
eputs "unset [var $name1 $name2]"
if {[Unbreak [var $name1 $name2]]<0} {
Unbreak $name1
}
}
default {error "unknown $op"}
}
}
proc Unbreak {name} {
variable break
set i [lsearch -exact $break $name]
if {$i<0} {return -1}
set break [lreplace $break $i $i]
catch {
trace remove variable $name {read write unset} ::tcldebug::Break
}
return 0
}
proc Enter {cmdstring op} {
switch -- $op {
enter {
eputs "entering [lindex $cmdstring 0]"
uplevel 1 ::tcldebug::debug [list $cmdstring]
}
default {error "unknown $op"}
}
}
proc Unenter {name} {
variable enter
set i [lsearch -exact $enter $name]
if {$i<0} {return -1}
set enter [lreplace $enter $i $i]
catch {
trace remove execution $name enter ::tcldebug::Enter
}
return 0
}
proc Step {cmdstring op} {
switch -- $op {
enterstep {
eputs $cmdstring
uplevel 1 ::tcldebug::debug [list $cmdstring]
}
default {error "unknown $op"}
}
}
proc Unstep {name} {
variable step
set i [lsearch -exact $step $name]
if {$i<0} {return -1}
set step [lreplace $step $i $i]
catch {
trace remove execution $name enterstep ::tcldebug::Step
}
return 0
}
proc assert {expr {message ""}} {
if {[uplevel 1 expr $expr]} {return}
if {$message eq ""} {set message "assertion failed: $expr"}
error $message
}
proc p {varname} {
if {[uplevel 1 array exists $varname]} {
uplevel 1 parray $varname
return
}
if {[uplevel 1 info exists $varname]} {
eputs "$varname = [uplevel 1 set $varname]"
} else {
eputs "variable $varname does not exist"
}
}
proc Prompt {} {
return {TclDebugger by S.Arnold. v0.1 2007-09-08}
}
proc eputs {str} {puts stderr $str}
proc Interact {{cmdstring ""}} {
debug $cmdstring
}
proc debug {{cmdstring ""}} {
set help {Commands are:
h or ? prints this message
a or > prints the command being executed
e or ! evals a command
p prints the content of each variable name
var watchs the modifications of some variables
log logs all modifications to stderr
break adds breakpoint for writes
info prints all variables being watched for
clear clears logging and breaks
cmd
enter set a break point for the entering of a command
step steps through the command
clear clear break points (using glob patterns)
c continue execution
r restarts the program
x or q exit the debugger}
set help [Prompt]\n$help
while 1 {
puts -nonewline stderr "dbg> "
flush stderr
gets stdin line
switch -- [lindex $line 0] {
h - ? {eputs $help}
e - ! {
if {[catch {eputs [uplevel 1 [lrange $line 1 end]]} msg]} {
eputs "error: $msg"
}
}
a - > {eputs $cmdstring}
p {
foreach var [lrange $line 1 end] {uplevel 1 ::tcldebug::p $var}
}
var {
assert {[llength $line]<=3} "bad syntax, $line has more than 3 tokens"
foreach {subcmd value} [lrange $line 1 end] {break}
switch -- $subcmd {
log {
variable log
set log [Store $log $value]
uplevel 1 [list trace add variable $value {read write unset} ::tcldebug::Log]
}
break {
variable break
set break [Store $break $value]
uplevel 1 [list trace add variable $value {read write unset} ::tcldebug::Break]
}
info {
foreach {n t} {log Logged break "Breaks at"} {
variable $n
eputs "=== $t: ==="
eputs [set $n]
eputs "----"
}
}
clear {
foreach {v t cmd} {log Logged Unlog break "Breaks at" Unbreak} {
eputs "clearing $t..."
variable $v
foreach i [set $v] {
if {[string match $value $i]]} {
eputs $i
# unlogs or unbreaks the variable
::tcldebug::$cmd $i
}
}
}
}
default {
error "no such subcommand: $subcmd"
}
}
}
cmd {
assert {[llength $line]<=3} "bad syntax, $line has more than 3 tokens"
foreach {subcmd value} [lrange $line 1 end] {break}
switch -- $subcmd {
enter {
variable enter
set enter [Store $enter $value]
trace add execution $value enter ::tcldebug::Enter
}
step {
variable step
set step [Store $step $value]
trace add execution $value enterstep ::tcldebug::Step
}
info {
foreach {n t} {enter Enters step Stepping} {
variable $n
eputs "=== $t: ==="
eputs [set $n]
eputs "----"
}
}
clear {
foreach {v t cmd} {enter Enters Unenter step Stepping Unstep} {
eputs "clearing $t..."
variable $v
foreach i [set $v] {
if {[string match $value $i]} {
eputs $i
# 'unenters' or 'unstep' the command
::tcldebug::$cmd $i
}
}
}
}
default {
error "no such subcommand: $subcmd"
}
}
}
c {
return
}
r {
variable argv0
variable argv
eval exec [list [info nameofexecutable] $argv0] $argv
exit
}
x - q {
exit
}
}
}
}
}
# Start the program!
set argv0 [lindex $argv 0]
set argv [lrange $argv 1 end]
# Prompts
puts stderr [tcldebug::Prompt]
puts stderr "type h to the prompt to get help"
source $argv0
Example usage:
# example.tcl
# let us define all procs
proc add {a b} {expr {$a+$b}}
proc main {} {
set a 1
set b 2
puts [add $a $b]
}
# this line allows the use of a debugger
catch {tcldebug::debug}
main
Note: : as Tcl's traces work on procedures, global-level code is out of the debugging area. This is common to most Tcl debuggers, and the workaround as usual is to put most if all of your code into procs.
Known bugs