[Arjen Markus] (30 march 2009) As I am fascinated by all the possibilities that exist to automate testing 
(our tcltest package is a wonderful example of that), I thought I'd experiment a bit with the tabular format
of specifying tests as promoted by [FIT]. Here is the result.

Some notes:

   * Right now procedures are expected to behave as simple functions: they take arguments and return a value, without any side effects (relaxing that last condition would be quite problematic...)
   * Some details might be improved upon — there can be no values containing newlines now
   * There can be no argument to the proc under test that is called "expected"
   * There is no possibility to anticipate error conditions

Well, just a quick-and-dirty experiment, what do you expect?

----
======
# table-test.tcl --
#     Experiment with FIT
#
#

# table-test --
#     Generate tests based on a table of cases
#
# Arguments:
#     procname         Name of the procedure to test
#     varnames         List of variable names (arguments to the procedure
#                      and the expected result)
#     values           Values - each line is a test case
#     args             Arguments to be passed to the test command directly
#
# Result:
#     None
#
# Side effects:
#     Runs the individual test cases and thus influences the test
#     statistics
#
# Note:
#     The test that is generated is simply of the following form:
#     - set the arguments according to the line in the "values" argument
#     - run the procedure to be tested
#     - the expected result is the column "expected"
#     - the lines in the table "values" must form a valid list
#
proc table-test {procname varnames values args} {

    package require tcltest

    #
    # Examine the procedure under test and the variable names
    #
    if { [lsearch $varnames "expected"] < 0 } {
        return -code error "The table does not contain a column \"expected\" - the expected results"
    }
    if {[catch {set arglist [info args $procname]} msg] } {
        return -code error $msfg
    }

    set argtest ""
    foreach arg $arglist {
        if { [lsearch $varnames "expected"] < 0 } {
            return -code error "The table does not contain a column \"$arg\" - one of the arguments to procedure \"$procname\""
        }
        append argtest " \$$arg"
    }

    #
    # We are ready now ...
    #
    set testidx 0
    set nvars   [expr {[llength $varnames] - 1}]
    set expidx  [lsearch $varnames "expected"]
    foreach line [split $values \n] {
        if { [string trim $line] == "" } continue
        set body ""
        foreach var $varnames value [lrange $line 0 $nvars] {
            append body "set $var \"$value\"\n"
        }
        append body $procname $argtest

        set expected [lindex $line $expidx]
        ::tcltest::test $procname-$testidx "$procname-$testidx" -body $body -result "$expected" {*}$args

        incr testidx
    }
}

# main --
#     Test the whole idea
#

#
# Define a simple procedure
#
proc simpleProc {a b} {
    expr {$a*$b}
}

table-test simpleProc {
   a     b    expected} {
   1     1    1       # Okay
   2     2    4.0     # Not okay: we test strings!
   2     2    4       # Okay
}

::tcltest::cleanupTests
======

----

As another quick and dirty experiment, here’s a version using an external csv file:

======
proc csv-test {procname data args} {

    package require tcltest
    package require csv
    package require struct::matrix

    
    set f [open $data]
    ::struct::matrix m
    ::csv::read2matrix $f m {;} auto
    close $f


    #
    # Examine the procedure under test and the variable names
    #
    if { [::m search row 0 "expected"] eq {} } {
        return -code error "The table does not contain a column \"expected\" - the expected results"
    }
    if {[catch {set arglist [info args $procname]} msg] } {
        return -code error $msfg
    }

    set argtest ""
    foreach arg $arglist {
        if { [::m search row 0 $arg] eq {} } {
            return -code error "The table does not contain a column \"$arg\" - one of the arguments to procedure \"$procname\""
        }
        append argtest " \$$arg"
    }

    #
    # We are ready now ...
    #
    set rowsCount [expr {[m rows] - 1}]
    set expidx  [lindex {*}[::m search row 0 "expected"] 0]
    set varnames [lrange [m get row 0] 0 [expr {$expidx - 1}]]
    set nvars [expr {[llength $varnames] - 1}]
    for {set i 1} {$i <= $rowsCount } {incr i} {
        set line [m get row $i]
        if { [string trim $line] == "" } continue
        set body ""
        foreach var $varnames value [lrange $line 0 $nvars] {
            append body "set $var \"$value\"\n"
        }
        append body $procname $argtest

        set expected [lindex $line $expidx]
        ::tcltest::test $procname-$i "$procname-$i" -body $body -result "$expected" {*}$args

    }
    m destroy
}
======

I did something like this for testing a bunch of dns entries once.  what it did was generate a set of test files from a csv file, it was not as dynamic as yours.  Cool tool thanks for posting

marc

!!!!!!
%| [Category Testing] |%
!!!!!!