On occasion, I write Tcl programs that
don't work right the first time, and thus need to be “debugged”.
The easiest way to debug a Tcl program is with the
puts command.
puts stderr "Some useful information to print"
A few carefully placed
puts statements can
be used to ferret out most bugs. Unfortunately, it often seems the
bugs have a habit of returning as soon as the
puts statements are removed :-) .
The solution to the recurring bug problem is to wrap
puts in a procedure, called
dputs, so we can turn debug printing on or off
without changing the code:
proc dputs {args} {
global Debug
if {[info exists Debug]} {
puts stderr $args
}
}
This first version of
dputs checks to see
if the global variable
Debug is set (to
anything) before printing the arguments passed to
dputs. As a side benefit,
dputs lets us specify what to print as multiple
arguments. The
args parameter, which is special
in Tcl, automatically gathers all of the arguments of
dputs into a single string.
Although
dputs is an improvement over
puts, it doesn't take too long to discover the
limitation of this version. You have the choice of either too
little output or too much. What we would like to do is turn debug
printing on or off selectively, in different sections of the
program.
We can use the introspective capabilities of Tcl to determine
which procedure each
dputs is being called from,
and turn debug printing on or off for each procedure. We'll use the
info level command to look into the current
procedure stack and figure out the name of the procedure that
dputs is being called from. We can set
Debug to a glob-style pattern that will cause
only those
dputs statements in procedures that
match that pattern to print. As a bonus, we'll print the calling
procedure name as part of our output, so it doesn't have to be
included as an argument to
dputs.
proc dputs {args} {
global Debug
if {![info exists Debug]} return
set current [expr [info level] - 1]
set caller toplevel
catch {
set caller [lindex [info level $current] 0]
}
if {[string match $Debug $caller]} {
puts stderr "$caller: $args"
}
}
In this version of
dputs, as before, if
Debug is not set, no debugging output is
produced. The
info level command returns the
current nesting level of the procedure call stack, the
dputs procedure. Subtracting one from
$current is the stack level of
dputs's caller. The
info level
$current command returns a list of information about the
procedure stack at level
$current, whose first
element is the name of the procedure. If
dputs
is called at the global scope, the call to
info
level will fail (
current will be -1),
thus the
catch around
info
level, which will leave
$caller with
the pre-initialized value of
toplevel.
Now that we have the name of the procedure that
dputs was called from, it is a simple matter for
string match to compare the procedure name in
$caller with the pattern in
Debug, and only emit debugging output for the
desired procedures. The pattern in
Debug can be
changed interactively at the command prompt, or automatically under
program control.
Although this version of
dputs is better,
it requires the programmer know
in advance
what information to pass as arguments to
dputs
in order for the debug output to help locate the bug. Typically,
half the battle of debugging is determining what information needs
to be printed to find the bug, and what
dputs
prints is probably not right.
We can easily overcome this limitation by remembering that
Tcl is an interpreted language. Instead of simply printing canned
values that are passed as arguments to
dputs, we
can stop the program at any
dputs call and allow
the programmer to enter arbitrary Tcl commands to elicit
information about the current execution state of the
program.
The next procedure,
breakpoint, may be
inserted anywhere in a Tcl program to cause it to stop and allow
interactive execution of commands. For example, the Tcl moral
equivalent of the C
assert command is
implemented by calling
breakpoint any time an
invalid condition is detected. Alternately,
breakpoint can be inserted into
dputs so breakpoints can be turned on or off
selectively using the
Debug variable.
The
breakpoint procedure implements four
build-in commands:
+,
-,
? and
C. The
+ and
- commands allow the
user to move up and down the call stack. The
?
commands prints out useful information about the current stack
frame, and
C returns from
breakpoint, resuming execution of the program.
Any other command is passed to
uplevel to be
evaluated at the appropriate stack level.
proc breakpoint {} {
set max [expr [info level] - 2]
set current $max
show $current
while {1} {
puts -nonewline stderr "#$current: "
gets stdin line
while {![info complete $line]} {
puts -nonewline stderr "? "
append line \n[gets stdin]
}
switch -- $line {
+ {if {$current < $max} {show [incr current]}}
- {if {$current > 0} {show [incr current -1]}}
C {puts stderr "Resuming execution";return}
? {show $current}
default {
catch { uplevel #$current $line } result
puts stderr $result
}
}
}
}
The procedure
breakpoint demonstrates the
use of the Tcl commands
info level and
uplevel to examine the state of a running Tcl
program, and the
info complete command to read
and evaluate Tcl commands entered interactively.
First,
info level computes the depth of
the procedure call stack (in
$max). We need to
subtract two from
info level, one for the
breakpoint procedure, and one for
dputs. We then loop (
while
{1}) getting Tcl commands and running them. The variable
$current contains the current stack level, which
we'll print as part of the prompt to the user.
Getting a Tcl command from the console is a little tricky, as
a single command might span multiple input lines. We'll use
info complete, and
append
commands in the inner
while loop to gather up
enough lines of input to form a complete Tcl command. Once we have
the entire command, the
switch statement selects
either one of the built-in commands, or it calls
uplevel to run the command at the current stack
level, which may have been modified previously by
+ or
- commands. The
catch around
uplevel insures
that an errant command typed by the user doesn't terminate the
program with an error. We then print the result of the command (or
the error message if it failed), and loop back to get the next
command from the user.
The built-in commands
+ and
- are used to change the stack level that the
commands we enter will be evaluated in. They simply change the
value of
$current. The
?
command calls
show, and
C
returns, resuming execution of the program. The procedure
show, which we'll write next, displays useful
information about the current stack level.
proc show {current} {
if {$current > 0} {
set info [info level $current]
set proc [lindex $info 0]
puts stderr "$current: Procedure $proc \
{[info args $proc]}"
set index 0
foreach arg [info args $proc] {
puts stderr \
"\t$arg = [lindex $info [incr index]]"
}
} else {
puts stderr "Top level"
}
}
The procedure
show is a shortcut for
printing application-specific information while debugging, since
the user could type in the Tcl commands to achieve the same result.
This version of
show, which gets passed the
stack level
$current as an argument, prints the
procedure name, its arguments, and their values at the time the
procedure was called. In
dputs we used the first
element of
info level $current as the name of
the procedure in stack frame
$current. The
remaining elements contain the values of the arguments passed to
the procedure. The call to
info args returns the
names of the arguments, which we pair with their values in
info level $current, using the variable
index to step though the list of argument
values. Here is some sample output from
show,
taken from a debugging session of
HMtag_img,
part of a Tcl HTML library package.
4: Procedure HMtag_img {win param text}
win = .clone1.text
param = src=green_ball.gif
text = text
#4: info vars
var text param win
#4: set var(font)
font:courier:14:medium:r
#4: -
3: Procedure HMrender {win tag not param text}
win = .clone1.text
tag = img
not =
param = src=green_ball.gif
text = This is a good point
#3: C
Resuming Execution
In conclusion, we started with a simple
puts for program debugging, and in less than 50
lines of Tcl code, created a powerful debugging environment that
can be easily tailored to meet the debugging needs of most Tcl
applications.
Courtesy: www.linuxjournal.com