PracTcl Programming Tips

 in
Stephen gives a thorough description of how to use puts and other techniques for tracking down and exterminating bugs in your Tcl scripts.

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.

Stephen Uhler is a researcher at Sun Microsystems Laboratories, where he works with John Ousterhout improving Tcl and Tk. Stephen is the author of the MGR window system and of PhoneStation, a Tcl-based personal telephony environment. He may be reached via email at Stephen.Uhler@Eng.Sun.COM.

______________________

White Paper
Linux Management with Red Hat Satellite: Measuring Business Impact and ROI

Linux has become a key foundation for supporting today's rapidly growing IT environments. Linux is being used to deploy business applications and databases, trading on its reputation as a low-cost operating environment. For many IT organizations, Linux is a mainstay for deploying Web servers and has evolved from handling basic file, print, and utility workloads to running mission-critical applications and databases, physically, virtually, and in the cloud. As Linux grows in importance in terms of value to the business, managing Linux environments to high standards of service quality — availability, security, and performance — becomes an essential requirement for business success.

Learn More

Sponsored by Red Hat

White Paper
Private PaaS for the Agile Enterprise

If you already use virtualized infrastructure, you are well on your way to leveraging the power of the cloud. Virtualization offers the promise of limitless resources, but how do you manage that scalability when your DevOps team doesn’t scale? In today’s hypercompetitive markets, fast results can make a difference between leading the pack vs. obsolescence. Organizations need more benefits from cloud computing than just raw resources. They need agility, flexibility, convenience, ROI, and control.

Stackato private Platform-as-a-Service technology from ActiveState extends your private cloud infrastructure by creating a private PaaS to provide on-demand availability, flexibility, control, and ultimately, faster time-to-market for your enterprise.

Learn More

Sponsored by ActiveState