# package require tcltest
source tcltest.tcl ;# we use a modified tcltest
set keywords {}
foreach {kw field descr default clearaftertest} {
Name: name "Name for this test" test-1.1 1
Author: author "Author of this test" {} 0
Ask: ask "Ask a question of a human to check output" {} 1
Project: project "Project for these tests" {} 0
Remarks: remarks "Remarks about this test" {} 1
Description: description "Brief description of the test" {} 1
Only: -constraints "Only run this test if ..." {} 1
Setup: -setup "Run this before the test" {} 1
AlwaysSetup: always_setup "Run this before the test" {} 0
Output: -output "Expect this output" {} 1
Result: -result "Expect this result" {} 1
Cleanup: -cleanup "Code to cleanup afterwards" {} 1
AlwaysCleanup: always_cleanup "Code to cleanup afterwards" {} 0
Match: -match "Matching method exact|glob|regexp|ask" exact 0
} {
lappend keywords $kw
lappend keywords $field
set descriptions($kw) $descr
set defaults($kw) $default
set clearaftertests($kw) $clearaftertest
}
foreach {c k} $keywords {
set ::_($k) $defaults($c)
proc $c {args} "set ::_($k) \$args"
}
proc AskProc {expected actual} {
# puts "AskProc '$expected' '$actual'"
if {$expected == {} &&
$actual == {}} {
return 1
} elseif {$expected == $actual} {
return 1
} else {
# have to ask the operator
ask $expected $actual
}
}
tcltest::customMatch ask AskProc
proc Test: {cmd} {
set ::_(-body) $cmd
puts ""
puts "* $::_(name) - $::_(description)"
foreach {v k} $::keywords {
if {$k != "name" && $k != "description"} {
if {$::_($k) != $::defaults($v)} {
puts "** $v $::_($k)"
}
}
}
puts "** Test: [list $::_(-body)]"
if {$::_(ask) != {}} {
set ::_(-match) ask
}
if {[catch $::options(always_setup) err]} {
puts "AlwaySetup: $::options(always_setup) failed with $err"
}
uplevel \#0 {
tcltest::test $::_(name) \
$::_(description) \
[array get ::_ -*]
}
if {[catch $::options(always_cleanup) err]} {
puts "AlwaySetup: $::options(always_cleanup) failed with $err"
}
foreach {v k} $::keywords {
if {$::clearaftertests($v)} {
set ::_($k) {}
}
}
}