SEH Sometimes I just want to step quickly through a new script without the overhead and learning curve of a full GUI IDE. So I wrote this command-line quickie debugger. Use ::stepsource::StepSource <filename> instead of source <filename> and the file contents will be instrumented and run line-by-line (advance by hitting carriage return). Breakpoints, advancing to a line number and advancing to end of current procedure are also supported.
Here's the minimal help text:
<line#> run until line number <return> run next line a list array values b run until next breakpoint b ? list breakpoints b <line#> set breakpoint b -<line#> unset breakpoint b - unset all breakpoints c list changed variable values e run to end of current procedure g list global variables h help l list all instrumented lines l <line#> [<line#>] list line numbers v list variable values x abort execution <anything else> execute as tcl command
At each step a list of the local variables will be dumped to the console, followed by the next line to be executed. Note variable values changed since the last step are denoted with a -> symbol. At the prompt hit carriage return or one of the commands above. Using 'c' toggles the display so that only changed variables are displayed at each step. Use 'v' to toggle back to default.
After the script is "sourced" the instrumented procedures remain, and can be interacted with individually by calling them on the command line as you would ordinarily, or use ::ss <procedure call> to force stepping variable resets.
Sourcing multiple files in one session is supported. In theory (though I haven't tried it) you could replace source with StepSource and debug an entire project, or debug a script from within a starkit.
Input and output channel can be re-targeted from stdin and stdout to any valid file or socket id, so you could debug a server or embedded app remotely as it runs in situ (again, not tried by me).
namespace eval ::stepsource {
proc StepCommand {stepcommand} {
switch -regexp -- $stepcommand {
^\[0-9\]+$ {
set ::stepsource::currentBreakPoint $stepcommand
return
}
^b\ *-*[0-9?]*$ {
if {$stepcommand == "b -"} {set ::stepsource::breakPoints {} ; return}
set bOption [lindex $stepcommand 1]
if {$bOption == "?"} {puts $::stepsource::outChannel "breakpoints: $::stepsource::breakPoints" ; return}
if {![string first - $bOption]} {
set eraseBreakPoint [lsearch $::stepsource::breakPoints [expr abs($bOption)]]
if {$eraseBreakPoint > -1} {
set ::stepsource::breakPoints [lreplace $::stepsource::breakPoints $eraseBreakPoint $eraseBreakPoint]
}
puts $::stepsource::outChannel "breakpoints: $::stepsource::breakPoints"
return
}
set ::stepsource::breakPoints "$::stepsource::breakPoints $bOption"
set ::stepsource::breakPoints [lsort -unique $::stepsource::breakPoints]
if {$bOption == {}} {set ::stepsource::currentBreakPoint $bOption}
return
}
^l\ *[0-9]*\ *[0-9]*$ {
regexp {l ([0-9]+) *([0-9]*)} $stepcommand trash listStart listEnd
if ![info exists listStart] {
set listStart 1
set listEnd $::stepsource::lineCount
} else {
if {(![string is integer -strict $listEnd]) || ($listEnd < $listStart)} {set listEnd $listStart}
}
for {set i $listStart} {$i <= $listEnd} {incr i} {
if ![info exists ::stepsource::lineArray($i)] {return}
puts -nonewline $::stepsource::outChannel "$::stepsource::lineArray($i)"
}
return
}
}
switch -- $stepcommand {
a {
foreach var [uplevel 3 info vars] {
if ![uplevel 3 array exists [list $var]] {continue}
puts $::stepsource::outChannel "-----------------------------------"
uplevel 3 parray [list $var]
}
}
c {
foreach var [lsort [uplevel 3 info vars]] {
if {$var == "errorInfo"} {continue}
if ![uplevel 3 info exists [list $var]] {continue}
if [uplevel 3 array exists [list $var]] {continue}
set changeIcon "=="
catch {if {$::stepsource::varValues($var) != [uplevel 3 set [list $var]]} {set changeIcon "->"}}
if {![info exists ::stepsource::varValues($var)]} {set changeIcon "->"}
if {$changeIcon == "->"} {puts $::stepsource::outChannel [format "%-30s %s %s" $var $changeIcon "[uplevel 3 set [list $var]]"]}
set varrayadd $var ; lappend varrayadd [uplevel 3 set [list $var]] ; array set ::stepsource::currentValues $varrayadd
}
set ::stepsource::varDefault c
}
e {
set level [expr [info level] - 1]
set ::stepsource::watchLevel $level
if {$level <= $::stepsource::highestLevel} {unset ::stepsource::watchLevel}
}
g {
foreach var [lsort [info globals]] {
if [array exists ::$var] {puts $::stepsource::outChannel [format "%-27s %s" $var Array:] ; continue}
set changeIcon "=="
catch {if {$::stepsource::varValues($var) != [set $var]} {set changeIcon "->"}}
puts $::stepsource::outChannel [format "%-30s %s %s" $var $changeIcon "[set ::$var]"]
set varrayadd $var ; lappend varrayadd [set ::$var] ; array set ::stepsource::currentValues $varrayadd
}
}
h {
puts $::stepsource::outChannel {\
<line#> run until line number
<return> run next line
a list array values
b run until next breakpoint
b ? list breakpoints
b <line#> set breakpoint
b -<line#> unset breakpoint
b - unset all breakpoints
c list changed variable values
e run to end of current procedure
g list global variables
h help
l list all instrumented lines
l <line#> [<line#>] list line numbers
v list variable values
x abort execution
<anything else> execute as tcl command
}
}
v {
foreach var [lsort [uplevel 3 info vars]] {
if ![uplevel 3 info exists [list $var]] {continue}
if [uplevel 3 array exists [list $var]] {puts $::stepsource::outChannel [format "%-27s %s" $var Array:] ; continue}
set changeIcon "=="
catch {if {$::stepsource::varValues($var) != [uplevel 3 set [list $var]]} {set changeIcon "->"}}
if {![info exists ::stepsource::varValues($var)]} {set changeIcon "->"}
puts $::stepsource::outChannel [format "%-30s %s %s" $var $changeIcon "[uplevel 3 set [list $var]]"]
set varrayadd $var ; lappend varrayadd [uplevel 3 set [list $var]] ; array set ::stepsource::currentValues $varrayadd
}
set ::stepsource::varDefault v
}
x {
error "abort"
}
{} {
set ::stepsource::currentBreakPoint 0
}
default {
catch {uplevel 3 $stepcommand} result
puts $::stepsource::outChannel $result
}
}
}
proc StepNumber {linenumber} {
set level [info level]
if ![info exists ::stepsource::highestLevel] {set ::stepsource::highestLevel $level}
if {$level < $::stepsource::highestLevel} {set $::stepsource::highestLevel $level}
if ![info exists ::stepsource::currentBreakPoint] {set ::stepsource::currentBreakPoint 0}
if {$::stepsource::currentBreakPoint > $::stepsource::lineCount} {set ::stepsource::currentBreakPoint $::stepsource::lineCount}
set returnOK 1
catch {
if {[info level] < $::stepsource::watchLevel} {
unset ::stepsource::watchLevel
set returnOK 0
} else {
set ::stepsource::currentBreakPoint {}
}
}
if {$::stepsource::currentBreakPoint == 0} {set returnOK 0}
if {$linenumber == $::stepsource::currentBreakPoint} {unset ::stepsource::currentBreakPoint ; set returnOK 0}
if {[lsearch -exact $::stepsource::breakPoints $linenumber] > -1} {set returnOK 0}
if $returnOK {return}
catch {
set currentProcedure [lindex [info level -2] 0]
if {[uplevel 2 info procs $currentProcedure] == {}} {set currentProcedure {}}
}
if ![info exists ::stepsource::lastProcedure] {set ::stepsource::lastProcedure {}}
if ![info exists currentProcedure] {set currentProcedure {}}
if {($level != $::stepsource::highestLevel) && ($::stepsource::lastProcedure != $currentProcedure)} {puts $::stepsource::outChannel "||||current procedure: $currentProcedure"}
set ::stepsource::lastProcedure $currentProcedure
set stepCommand $::stepsource::varDefault
StepCommand $stepCommand
while {$stepCommand != {}} {
puts $::stepsource::outChannel "\n-----------------------------------"
puts $::stepsource::outChannel $::stepsource::lineArray($linenumber)\n
puts -nonewline $::stepsource::outChannel >
set stepCommand [gets $::stepsource::inChannel]
StepCommand $stepCommand
if {([string is integer -strict $stepCommand]) || ($stepCommand == "b") || ($stepCommand == {}) || ($stepCommand == "e")} {
catch {array set ::stepsource::varValues [array get ::stepsource::currentValues]}
catch {array unset ::stepsource::currentValues}
break
}
}
}
proc StepSource {filename} {
namespace eval ::stepsource {}
set ::stepsource::filename $filename
namespace eval ::stepsource {
if {[info procs original_unknown] == {}} {
rename ::unknown original_unknown
proc ::unknown {args} {
if [string is integer -strict $args] {
::stepsource::StepNumber $args
} else {
set ::stepsource::unk_args $args
uplevel 1 ::stepsource::original_unknown $::stepsource::unk_args
}
}
}
if ![info exists inChannel] {set inChannel stdin}
if ![info exists outChannel] {set outChannel stdout}
if ![info exists breakPoints] {set breakPoints {}}
if ![info exists varDefault] {set varDefault v}
if ![info exists sourcedFiles] {set sourcedFiles {}}
if {[lsearch -exact $sourcedFiles $filename] < 0} {lappend sourcedFiles $filename}
if ![info exists ::stepsource::sourceProcs] {set ::stepsource::sourceProcs {}}
set mtime [file mtime $filename]
set oldMtime 0
catch {set oldMtime $mtimes($filename)}
array unset lineArray
set lineCount 1
foreach sF $sourcedFiles {
set $sF {}
set f [open $sF r]
set noNumberLine {}
while {![eof $f]} {
set line [gets $f]
set firstWord [string trim [string range [string trim $line] 0 [expr [string wordend [string trim $line] 0] - 1]]]
set secondWord [string trim [string range [string trim $line] [string length $firstWord] [string wordend [string trim $line] [expr [string length $firstWord] + 1]]]]
if ![regexp {(::[^ ]+)(\ |$)} $line trash firstNameSpace] {set firstNameSpace {}}
if {$firstWord == ":"} {set firstWord $firstNameSpace}
if {[string index $secondWord 0] == ":"} {set secondWord $firstNameSpace}
if {$firstWord == "proc"} {lappend ::stepsource::sourceProcs $secondWord}
if {([info commands $firstWord] != {}) || ([lsearch -exact $::stepsource::sourceProcs $firstWord] > -1)} {
set $sF "[set $sF]$noNumberLine[set lineCount]\;\t$line\n"
set arrayadd $lineCount ; lappend arrayadd $noNumberLine$lineCount\;\t$line\n ; array set lineArray $arrayadd
set noNumberLine {}
incr lineCount
} elseif {($firstWord == "\{") && (([info commands $secondWord] != {}) || ([lsearch -exact $::stepsource::sourceProcs $secondWord] > -1))} {
set arrayadd $lineCount ; lappend arrayadd $noNumberLine$lineCount\;\t$line\n ; array set lineArray $arrayadd
regsub {\{} $line "\{$lineCount\;" line
set $sF "[set $sF]$noNumberLine\t$line\n"
set noNumberLine {}
incr lineCount
} else {
set noNumberLine $noNumberLine\t$line\n
}
}
close $f
if {$noNumberLine != {}} {set $sF "[set $sF]$noNumberLine"}
}
}
set ::stepsource::sourceProcs {}
uplevel 1 eval \$\{::stepsource::$::stepsource::filename\}
}
}
# end namespace eval ::stepsource
proc ::ss {args} {
catch {unset ::stepsource::watchLevel}
catch {unset ::stepsource::currentBreakPoint}
catch {array unset ::stepsource::varValues}
uplevel 1 $args
}
StepSource instruments a line if its first word is a valid Tcl command, so it's possible to confuse it in some cases, for example:
switch [lindex [info commands] 0] {
string {puts "string"}
file {puts "file"}
scan {puts "scan"}
}would lead to an error. I've found such cases to be rare though, and you could rewrite as:
switch [lindex [info commands] 0] {string {
puts "string"
} file {
puts "file"
} scan {
puts "scan"
}
}and things would go fine.
AM (29 december 2006) I wrote something similar - though it is neither complete nor, possibly, useable in practical cases. I have posted it on this page: Quick-n-dirty debugger