package require tclunit
Adds these words to the global namespace ...
- zource - a single verb to facilitate quickly resetting the test environment.
- test - verb. takes a glob pattern which is matched against the names of the defined testsuites. Uses zource.
- testsuite - use this in your source file or in a separate file, to describe collections of tests.
- s/b - verb. The primary test. Takes 2 arguments. A cmd, which is valid Tcl inside braces. And an expected value.
- s/nb - the negated version of s/b.
Sample interaction.
$ source mything.test
mything-test
$ test *
==============================================
testsuite 'cannon' : results : 11/11 : 100%
==============================================
testsuite 'cursor' : results : 11/11 : 100%
==============================================
testsuite 'makes' : results : 1/1 : 100%
========================================================
testsuite 'namespacequestions' : results : 1/1 : 100%
========================================================
testsuite 'rat' : results : 5/5 : 100%
==========================================
testsuite 'ratv' : results : 5/5 : 100%
===========================================
testsuite 'trans' : results : 2/2 : 100%
===========================================
========================================================
testsuite 'generic' : results : 14/15 : 1 test failed.
========================================================
test 'new' failed
s/b [generic::color {kin 8}] ...
...Blue...
Yellow
=======================================================
testsuite 'command' : results : 7/9 : 2 tests failed.
=======================================================
test 'arithmetic' failed
s/b [command::+ 3] ...
...nsdate {1966 6 4}...
invalid command name "command::+"
test 'parse' failed
s/b [command::kin 10 25 2014] ...
......
100- testsuites organize tests.
- the '...' ellipsis is used to delimit the expected result - accenting leading and trailing white space.
- the actual result is indented by 3 white space, aligning exactly w/ the ellipsis to facilitate a copy/paste workflow.
Example zource:
zource {
package forget mytestingenvthing
source "abs/path/to/file1"
source "abs/path/to/file2"
source "path/to/this/file"
}Called w/ one argument, means "this is my reset script". Called w/ no argument, means "reset my environment".
Used to reset/re-source everything necessary for testing.
Example testsuite:
package require tclunit
zource {
source "~/path/projectsrc.tcl"
source "~/path/projectsrc.test"
namespace path ::projectns
}
testsuite ratv {
test ns {
s/b {ratv -ns 1 30 12 3} {nsdate {-ns 1 30 12 3}}
s/b {ratv NS 1 26 13 16} {nsdate {NS 1 26 13 16}}
s/b {ratv NS 1 24 8 20 leapday} {nsdate {NS 1 24 8 20 leapday}}
}
test execdate {
s/b {lindex [ratv {*}[exec date]] 0} {gcdate}
s/b {lindex [ratv [exec date]] 0} {gcdate}
}
-test execdate2 {
s/b {ratv {*}[exec date]} {gcdate {2014 7 12}}
s/b {ratv [exec date]} {gcdate {2014 7 12}}
}
}
testsuite rat {
test ns {
s/b {rat {-ns 1 30 12 3}} {nsdate -ns 1 30 12 3}
s/b {rat {NS 1 26 13 16}} {nsdate NS 1 26 13 16}
}
test execdate {
s/b {lindex [rat [exec date]] 0} {gcdate}
}
-test execdate2 {
s/b {rat [exec date]} {gcdate 2014 7 12}
}
}A testsuite has a title and a collection of tests
A test has a title and a body (collection of statements)
A body is arbitrary tcl code
Example s/b.
testsuite equations {
test quadratic {
s/b {quadratic_eq 1 0 -16} {4 -4}
s/nb {quadratic_eq 1 0 -16} 4
s/b {quadratic_eq 1 0 -9} {3 -3}
}
}s/b and s/nb perform the testing,
- eval 1st phrase in the global scope, generating a result
- compare result with 2nd phrase.
tclunit.tcl edit
# tclunit
# a featherweight test harness
namespace eval tclunit {
set version 0.3
variable lastsuiteglob ""
variable suites
variable successcount
variable failcount
variable testcount
variable msglog
variable echoonrepeat 1
variable logsuccess 0
variable zourcevalue ""
variable zourcestate uninitialized
array set suites {}
namespace export testsuite s/b s/nb
}
namespace eval tclunitcmds {
namespace export zource test
}
# [ zource ]
# a proc/parameter.
# w/ a value; make an assignment
# w/o no value; eval assignment in global namespace
proc tclunitcmds::zource {args} {
variable ::tclunit::zourcestate
variable ::tclunit::zourcevalue
if { [llength $args] == 0 } {
if {$zourcestate eq "uninitialized"} {
puts "zource uninitialized."
return
}
catch {uplevel #0 $zourcevalue} res
return
} else {
set zourcestate ""
set zourcevalue {*}$args
}
}
# [ test ]
# w/o args; resets env and repeats last set of tests
# w/ args; globs against the names of currently defined testsuites
proc tclunitcmds::test {args} {
zource
::tclunit::testrunner $args
}
# [s/b]
# cmd is presumed to be a statement in tcl
# expected is matched against return value
# s/b 'expects' them to match
# s/nb 'expects' them to not match
proc tclunit::s/b {cmd expected} {
catch {uplevel 1 $cmd} res
if {$res != $expected} {
return -code error "s/b \[$cmd\] ...\n...$expected...\n $res"
}
}
proc tclunit::s/nb {cmd expected} {
catch {uplevel 1 $cmd} res
if {$res == $expected} {
return -code error "s/nb \[$cmd\] ...\n...$expected...\n $res"
}
}
proc tclunit::test {title body} {
incr ::tclunit::testcount
if { [catch {uplevel #0 $body} res opts] } {
incr ::tclunit::failcount
lappend ::tclunit::msglog "test '$title' failed\n$res"
} {
incr ::tclunit::successcount
if { $::tclunit::logsuccess } {
lappend ::tclunit::msglog "...success : $res"
}
}
}
proc tclunit::-test {title body} {
# consumes test, does nothing, use to disable a test
}
proc tclunit::testsuite {title tests} {
# use first testsuite as initial glob value
if { $::tclunit::lastsuiteglob eq "" } {
set ::tclunit::lastsuiteglob $title
}
set ::tclunit::suites($title) $tests
}
proc tclunit::testrunner {suiteglob} {
variable ::tclunit::lastsuiteglob
variable ::tclunit::suites
variable ::tclunit::successcount
variable ::tclunit::failcount
variable ::tclunit::msglog
variable ::tclunit::testcount
variable ::tclunit::echoonrepeat
if {$suiteglob eq "" || $suiteglob eq {}} {
if { ![info exists lastsuiteglob] || $lastsuiteglob eq "" } {
puts "yawn."
return
}
set suiteglob $lastsuiteglob
if {$echoonrepeat} {
puts "testing: $suiteglob"
}
}
set lastsuiteglob $suiteglob
set results [list ]
set hbar0 ""
set q00 ""
foreach suite [lsort [array names suites $suiteglob]] {
set tests $suites($suite)
set msglog ""
set failcount 0
set successcount 0
set testcount 0
# run tests
foreach {test title body} $tests {
eval [list $test $title $body]
}
# collect results
if {$failcount} {
lappend results [list $suite $testcount $successcount $failcount $msglog]
} {
# print succeesses right away.
set q0 "testsuite '$suite' : results : $successcount/$testcount : "
set q "$q0 100% "
set p [string repeat = [string length $q]]
if { [string length $p] > [string length $hbar0] } { set hbar0 $p }
if { [string length $hbar0] > [string length $q00] } { set hbar0 $p }
set q00 $q
puts $hbar0
puts $q
}
}
# sort fail results
foreach r [lsort -increasing -integer -index 3 $results] {
lassign $r suite testcount successcount failcount msglog
if { $hbar0 ne "" } {
puts $hbar0
set hbar0 ""
}
set q0 "testsuite '$suite' : results : $successcount/$testcount : "
if { $failcount == 1 } {
set q2 "test failed."
} {
set q2 "tests failed."
}
set q "$q0 $failcount $q2"
set p [string repeat = [string length $q]]
puts $p
puts $q
puts $p
if { $msglog ne "" } {
puts [join $msglog \n]
}
}
if { $hbar0 ne "" } { puts $hbar0 }
}
proc tclunit::? {} {lsort [info procs ::tclunit::*]}
namespace import -force tclunit::*
namespace import -force tclunitcmds::*
package provide tclunit $tclunit::version
