Category Archives: Tcl

tcltest Part 9: Provides Exit Code

The Problem

One of the complains against tcltest is the fact that it does not return an exit code to communicate test pass/fail status.

Consider a simple scenario. In a directory, we have two files: all.tcl, which drives all the tests, and test1.test, which contains the actual tests. The contents of all.tcl is:

package require tcltest
tcltest::runAllTests

And the contents of test1.test is:

package require tcltest
namespace import ::tcltest::*

test fail_me {} -body { set foo 1 } -result 0
test pass_me {} -body { set foo 1 } -result 1

cleanupTests

In the scenario above, one of the tests will fail, but all.tcl will always return with exit code 0. It would be more useful if it returns 0 when all tests passed and 1 when not all tests passed.

The Solution

We looked into the tcltest source code and found an array, tcltest::numTests, which looks what we need. So, we modified all.tcl to see if we can use it:

package require tcltest
tcltest::runAllTests
parray tcltest::numTests

The result is disappointing:

(irrelevant output omitted)
tcltest::numTests(Failed)  = 0
tcltest::numTests(Passed)  = 0
tcltest::numTests(Skipped) = 0
tcltest::numTests(Total)   = 0

With one failed tests, we thought tcltest::numTests(Failed) should be 1, but it was not. we went back to the source code and dug a little deeper and found tcltest::cleanupTests resets these numbers after it finishes reporting.

Just when we was about to give up, we thought of asking Mr. Google for help. Sure enough, tcltest provides a hook into its tcltest::cleanupTests, which gives us access to the statistics variables before it resets them. Here is the final all.tcl:

package require tcltest

# Hook to determine if any of the tests failed. Then we can exit with
# proper exit code: 0=all passed, 1=one or more failed
proc tcltest::cleanupTestsHook {} {
    variable numTests
    set ::exitCode [expr {$numTests(Failed) > 0}]
}

tcltest::runAllTests
exit $exitCode

Discussion

The trick is to write a hook, tcltest::cleanupTestsHook. Before resetting the test statistics, tcltest::cleanupTests calls the hook function, which gives us the opportunity to access these statistics, and use them to determine the exit code.

Now that all.tcl returns the proper exit code, we can use it to determine pass/fail. Here is an example using the bash shell in Unix-like systems:

#!/bin/bash
if tclsh all.tcl; then
    echo Tests passed
else
    echo One or more tests failed
fi

For Windows environment:

tclsh all.tcl
if errorlevel 1 echo One or more tests failed

Conclusion

We wish tcltest automatically returns the correct exit code, but it does not. For now, we will stick with this solution and hope that whoever working on tcltest won’t make our code obsolete.

Advertisements

Tcl: A Custom For Loop

The Problem

I often need to loop through a list of items and need both the index position, and the item itself. Typically:

set names {John Paul George Ringo}
set i 0
foreach name $names {
    puts "$i - $name"
    incr i
} 

Output:

0 - John
1 - Paul
2 - George
3 - Ringo

Initial Solution

Since I frequently do this, I decided to implement my own loop and call it for_item_index for lack of creativity. Here is my loop and a short code segment to test it:

proc for_index_item {index item iterable body } {
    uplevel 1 set $index 0
    foreach x $iterable {
        uplevel 1 set $item $x
        uplevel 1 $body
        uplevel 1 incr $index
    }
}

# Test it
set names {John Paul George Ringo}
for_index_item i name $names {
    puts "$i - $name"
}

I have tested it with break, and continue and found my new loop performs as expected. My concern is the excessive use of uplevel command in the code.

Here are my own review of my code:

  • Excessive use of uplevel – I don’t know what to do about it. If you have an idea, please send it my way.
  • The index always starts at zero. There are times when I want it to start at 1 or some other values. To add that feature, I will probably introduce another parameter, startValue
  • Likewise, the index always get incremented by 1. The user might want to increment it by a different values such as 2, or –1 to count backward. Again, introducing another parameter, step might help, but at this point, the loop is getting complicated.

Revised Solution

Shortly after the initial solution, I posted it on StackExchange’s CodeReview site. While waiting for comments, I started to revise the initial solution to include the start- and increment values. Here is the revised solution and code snippets to demonstrate:

proc for_index_item {indexexpr itemvar iterable body} {
    # Break down indexexpr
    set step 1
    set start 0
    if {[llength $indexexpr] == 3} {
        set step [lindex $indexexpr 2]
    }
    if {[llength $indexexpr] >= 2} {
        set start [lindex $indexexpr 1]
    }
    upvar 1 [lindex $indexexpr 0] index
    set index $start

    upvar 1 $itemvar item

    # Actual loop
    foreach item $iterable {
        uplevel 1 $body
        incr index $step
    }
}

#
# Test
#

puts "\nDefault, start with 0"
set names {John Paul George Ringo}
for_index_item i name $names {
    puts "  $i - $name"
}

puts "\nStarts from 1"
set names {John Paul George Ringo}
for_index_item {i 1} name $names {
    puts "  $i - $name"
}

puts "\nWith start value and increment"
set names {John Paul George Ringo}
for_index_item {i 110 10} name $names {
    puts "  $i - $name"
}

Output:

Default, start with 0
  0 - John
  1 - Paul
  2 - George
  3 - Ringo

Starts from 1
  1 - John
  2 - Paul
  3 - George
  4 - Ringo

With start value and increment
  110 - John
  120 - Paul
  130 - George
  140 - Ringo

A few comments:

  • I took in a suggestion and used upvar instead of uplevel, which makes the logic a little cleanner.
  • Half of my code is now devoted to parsing
  • The word index is miss-leading: it has nothing to do with the index as in a list index. It is just part of a sequence of numbers. In the future, I might rename it to remove confusion.

Tcl: Making Complex Regular Expression Easier to Read

The Problem

I often need to deal with complex regular expression while scripting in Tcl (or other languages, for that matter.) The problem is, the expression syntax is terse, cryptic and hard to understand and debug. There must be a better way to deal with regular expression, a way to add comments would be nice.

For example, below is the expression to extract email addresses:

set email_pattern {[a-z0-9._%-]+@[a-z0-9.-]+\.[a-z]{2,4}}

Below is some code to demonstrate the use of this pattern to extract email from a block of text:

set test_data {
	This is a bunch of text
	within it, there are some emails such as foo@bar.com
	or one@two.three.net
	What about mixed case: John.Doe@services.company.ws...
	Let see if we can extract them out
}

set email_pattern {[a-z0-9._%-]+@[a-z0-9.-]+\.[a-z]{2,4}}

puts "START"
set result [regexp -inline -all -nocase $email_pattern $test_data]
puts [join $result "\n"]
puts "END"

The output:

START
foo@bar.com
one@two.three.net
John.Doe@services.company.ws
END

While this code gets the job done, the lack of document on the regular expression makes it hard to debug the code. Don’t you wish you could include comments to make it easier to read?

The Solutions

My first instinct was to break up the regular expression into parts, then glue them together:

set pre_ampersand {[a-z0-9._%-]+}
set domain {[a-z0-9.-]+}
set tld {\.[a-z]{2,4}}
set email_pattern ""
append email_pattern $pre_ampersand @ $domain $tld

That’s better, the code is now self-documented and I have broken up the long expression into manageable pieces. The drawback is I have to use so many variables to accomplish my goal.

After digging into the Tcl’s regex documentation, I discovered the -expanded flag which will do what I want: It allows me to add white space and comments to the regular expression. Now the code becomes:

set test_data {
	This is a bunch of text
	within it, there are some emails such as foo@bar.com
	or one@two.three.net
	What about mixed case: John.Doe@services.company.ws...
	Let see if we can extract them out
}

set email_pattern {
	# The part before the @
	[a-z0-9._%-]+

	# The ampersand itself
	@

	# The domain, not including the last dot
	[a-z0-9.-]+

	# The last dot
	\.

	# The top-level domain (TLD), which ranges from 2 to 4 characters
	[a-z]{2,4}
}

puts "START"
set result [regexp -expanded -inline -all -nocase $email_pattern $test_data]
puts [join $result "\n"]
puts "END"

The above code accomplished the same goal as before. While it is longer it is better documented and easier to understand and debug. For those who code in Python, a similar feature exists: it is called the re.VERBOSE flag.

Tcl Print CSV File

When scripting in Tcl, I often need to process CSV files, including printing it out. Since I often found myself in need of printing, I wrote two helper procedures: load_matrix, which loads a matrix (a table) from CSV file; and print_matrix, which prints a text presentation of the matrix. The end result is the ability for me to print out the contents of a CSV file.

Usage

In order to print a CSV file, I first load it up into a matrix using load_matrix, then print it out using print_matrix:

set mx [load_matrix "users.csv"]
print_matrix $mx

Sample CSV File

ID,alias,Full Name
45,alexd,Alexander Dunn
992,alicek,Alice Kim

Sample Output

+===+======+==============+
|ID |alias |Full Name     |
+---+------+--------------+
|45 |alexd |Alexander Dunn|
|992|alicek|Alice Kim     |
+===+======+==============+

Discussion

In my solution, I use three Tcllib packages: csv, struct::matrix, and report. I don’t have to use struct::matrix or report, but they perform the heavy lifting tasks, so I don’t have to.

The Tcl matrix, which really is a table structure with rows, columns, and cells of data; is a great structure for storing the contents of a CSV file. The report package makes it easy to print out the contents of the matrix. The two packages work together seamlessly.

The code at this state works without any error checking, or fancy options. I intentionally keep it simple to demonstrate how it works. I have a few improvements in mind, which I will implement when the need arise:

  • Turn the code into a package
  • Add error checking (i.e. file does not exist)
  • Define different printing styles (HTML table, for example)

Getting The Code

I posted my code at the Tickler Wiki. In the future, I might host it under gitorious, github, or Google Code.

Better Font and Color for tkcon in Linux Mint 11

The Problem

In Linux Mint, the default font and background color for tkcon is terrible. I want to change that to something easier to read.

The Solution

Here is my ~/.tkconrc, which fixes it by choosing a better font and background color:

set ::tkcon::COLOR(bg) ivory
set ::tkcon::OPT(font) "{Liberation Mono} 10"

Discussion

The default font in Linux Mint is terrible: it is hard to read and pixelated. I found the Liberation Mono font works best for me; your mileage may vary. Also, the default background of gray is somewhat dark and drepressing, therefore I changed it to ivory, which is an off-white color (at least on my old laptop).