[EKB] Simple test is a basic test suite designed to use [test-driven development] (TDD) with [namespace]s. The approach was inspired by [e.g.], but has some bells and whistles that I wanted, such as tracking test suites by namespace, allowing for approximate comparison, and separating the test definition physically from the proc declaration. (This last bit is very useful with TDD. While e.g. doesn't require procs and tests to be next to each other programatically, it "reads" better that way.) Most of the TDD literature is focused on [object oriented] programming. But the basic idea of TDD is to write tests for the procs that are exposed in an interface. They could be object methods (as is commonly assumed), but they could also be procedures made available via the [namespace export] command. '''Demo''' The code for the library is given below. First, here's an example of use. In this example, the conscientious TDD programmer has declared two procedures, ''mult'' and ''sum'', using "st::addproc". The general call is: st::addproc name annotation WORD tests where "WORD" can be anything that helps with clarity, and annotation is a free-form entry, again for clarity. In the example below, the word "where" is used, but you might use "tests", "e.g.", or another word. At this stage, only one of the procs has been implemented, mult. Unfortunately, it has been implemented incorrectly, such that only one of the tests passes (2 * 2 = 4, but so does 2 + 2). The other proc, sum, hasn't been implemented yet. Here is the complete code creating the namespace, the tests, the proc, and the code calling the test: console show namespace eval demo { #st::off st::addproc mult { x ;# first variable y ;# second variable } where { {{2 3} -> 6} {{3.00000001 2.999999999} ~ 9} {{2 2} -> 4} {{2 7} -> 14} } st::addproc sum { x ;# first variable y ;# second variable } where { {{1 2} -> 3} {{0 -1} -> -1} {{3 1} -> 4} } } proc demo::mult {x y} { expr {$x + $y} } namespace eval demo { st::print } Some things to note: * Everything is namespace-specific. In fact, simple test keeps track of test suites by namespace. * There are two ways to represent desired outputs: * -> means an exact match * ~ means agreement within a user-modifiable tolerance * The commented-out "st::off", if uncommented, would prevent the test suite being read in, which can save memory when not running in test mode. Here are the results from running the tests: 7 tests run 1 test passed 14.3% pass rate All tests: Call: ::demo::mult 2 3 Error: Result did not match expected value Result: 5 Expected: 6 Call: ::demo::mult 3.00000001 2.999999999 Error: Result disagrees with expected value within tolerance of 1.0e-7 Result: 6.000000009 Expected: 9 ± 1.0e-7 Call: ::demo::mult 2 2 Error: PASSED Result: 4 Expected: 4 Call: ::demo::mult 2 7 Error: Result did not match expected value Result: 9 Expected: 14 Call: ::demo::sum 1 2 Error: invalid command name "sum" Result: NA Expected: 3 Call: ::demo::sum 0 -1 Error: invalid command name "sum" Result: NA Expected: -1 Call: ::demo::sum 3 1 Error: invalid command name "sum" Result: NA Expected: 4 The errors stating 'invalid command name "sum"' are somewhat redundant, but they are repeated so that the programmer can get visual feedback about how many more tests must pass, and also to show the individual calls. After fixing "mult" and adding "sum", proc demo::mult {x y} { expr {$x * $y} } proc demo::sum {x y} { expr {$x + $y} } the results are much nicer: 7 tests run 7 tests passed 100.0% pass rate All tests: Call: ::demo::mult 2 3 Error: PASSED Result: 6 Expected: 6 Call: ::demo::mult 3.00000001 2.999999999 Error: PASSED Result: 9.000000026999999 Expected: 9 ± 1.0e-7 Call: ::demo::mult 2 2 Error: PASSED Result: 4 Expected: 4 Call: ::demo::mult 2 7 Error: PASSED Result: 14 Expected: 14 Call: ::demo::sum 1 2 Error: PASSED Result: 3 Expected: 3 Call: ::demo::sum 0 -1 Error: PASSED Result: -1 Expected: -1 Call: ::demo::sum 3 1 Error: PASSED Result: 4 Expected: 4 '''The Library''' Here's the code itself: namespace eval st { variable collect true ;# Flag to say whether to run tests variable tests ;# Array of lists of tests to run, indexed on namespace variable tol 1.0e-7 ;# Tolerance } # name is the name of the proc # annot is a free-form annotation area # WORD is ignored and could be, for example: # tests # e.g. # where # # tests are of the form args -> result proc st::addproc {name annot WORD testlist} { variable tests variable collect set ns [uplevel 1 {namespace current}] if {$collect} { lappend tests($ns) [list $name $testlist] } } proc st::off {} { variable collect set collect false } proc st::on {} { variable collect set collect true } # This will default to the default of 1.0e-7 if not specified proc st::tolerance {{v 1.0e-7}} { variable tol set tol $v } proc st::print {} { lassign [uplevel 1 st::run] Ntest Nfail errors if {$Ntest == 1} { set ntests "test" } else { set ntests "tests" } puts [format "%d %s run" $Ntest $ntests] if {$Ntest - $Nfail == 1} { set ptests "test" } else { set ptests "tests" } puts [format "%d %s passed" [expr {$Ntest - $Nfail}] $ptests] if {$Ntest != 0} { puts [format "%.1f%% pass rate" [expr {100 * (1 - double($Nfail)/$Ntest)}]] } puts "\nAll tests:" foreach error $errors { lassign $error error call res expected puts " Call: $call" puts " Error: $error" puts " Result: $res" puts " Expected: $expected" puts "" } } proc st::run {} { variable tests variable tol lassign {0 0} Ntest Nfail set ns [uplevel 1 {namespace current}] set errors {} if [info exists tests($ns)] { foreach testset $tests($ns) { lassign $testset name testlist foreach testitem $testlist { # R is a "relationship" lassign $testitem arglist R expected if [catch {uplevel 1 $name {*}$arglist} res] { lappend errors [list \ $res \ "$ns\:\:$name $arglist" \ "NA" \ $expected ] incr Nfail } else { switch -- $R { -> { if {$res ne $expected} { lappend errors [list \ "Result did not match expected value" \ "$ns\:\:$name $arglist" \ $res \ $expected \ ] incr Nfail } else { lappend errors [list \ "PASSED" \ "$ns\:\:$name $arglist" \ $res \ $expected \ ] } } ~ { if {![string is double $res] || ![string is double $expected]} { lappend errors [list \ "For ~, result and expected value should both be numbers" \ "$ns\:\:$name $arglist" \ $res \ "$expected \u00B1 $tol" \ ] incr Nfail } elseif {abs($res - $expected) >= $tol} { lappend errors [list \ "Result disagrees with expected value within tolerance of $tol" \ "$ns\:\:$name $arglist" \ $res \ "$expected \u00B1 $tol" \ ] incr Nfail } else { lappend errors [list \ "PASSED" \ "$ns\:\:$name $arglist" \ $res \ "$expected \u00B1 $tol" \ ] } } } } incr Ntest } } } return [list $Ntest $Nfail $errors] } Note that the proc st::run does not print anything. If you want to process the list of errors yourself, then use st::run. Otherwise, st::print will print them to a console. ---- !!!!!! %| [Category Testing] |% !!!!!!