Arjen Markus (10 december 2004) Here is a little script that will generate tests with random data. It is far from complete, but it could be a nice start for a more general tool.
Note: One thing I noticed implementing mathematical packages for Tcllib is that it is necessary to use proper integers at times instead of doubles, because that can reveal mistakes in using [expr]. Just a note I wanted to post somewhere ...
See also quickcheck.
# randomtest.tcl --
# A first shot at generating and interpreting random test cases
#
# Inspired by Andreas Kupries who mentioned <http://arxiv.org/abs/cs.PL/0412012>
#
namespace eval ::randomtesting {
namespace eval work {
# Provide the working environment
}
namespace export randomtest
variable error
variable precond
}
# randomtest --
# Provide the framework for generating and interpreting random tests
#
# Arguments:
# title Title for the test case
# count Number of cases to generate
# code Code to run
#
# Result:
# None
#
proc randomtesting::randomtest {title count code} {
variable error
variable precond
set error_count 0
for { set i 0 } { $i < $count } { incr i } {
set error 0
set precond 0
#
# TODO: Should clean the variables in "work"!
# TODO: report the failing cases in more detail
#
namespace eval work $code
incr error_count $error
}
if { $error_count != 0 } {
puts "$title: $error_count failures in $count test cases"
}
}
# precond --
# Check the preconditions - so failure can be properly dealt with,
# as can non-failure
#
# Arguments:
# cond Precondition to be checked
#
# Result:
# None
#
proc randomtesting::work::precond {cond} {
if { ! [uplevel [list expr $cond]] } {
set ::randomtesting::precond 1
}
}
# postcond --
# Check the postconditions - so results can be properly checked
#
# Arguments:
# cond Postcondition to be checked
#
# Result:
# None
#
proc randomtesting::work::postcond {cond} {
if { ! [uplevel [list expr $cond]] } {
set ::randomtesting::error 1
}
}
# run --
# Run the actual code under test
#
# Arguments:
# code Code to be run
#
# Result:
# None
#
# Note:
# By allowing more than one fragment of code we could generate test
# cases that run multiple "methods" in any random order. This is
# a TODO ...
#
proc randomtesting::work::run {code} {
set error [catch [list uplevel $code] msg]
if { $error != 0 } {
#
# An error occurred, was this expected?
#
if { $::randomtesting::precond == 0 } {
set ::randomtesting::error 1
puts $msg
}
} else {
#
# No error occurred, was this expected?
#
if { $::randomtesting::precond == 1 } {
set ::randomtesting::error 1
puts "Code ran smoothly, despite violation of precondition"
}
}
}
# old --
# Return the old value of a variable
#
# Arguments:
# name Name of the variable
#
# Result:
# Old value (before running the code under test)
#
# Note:
# This is a TODO
#
proc randomtesting::work::old {name} {
error "old not implemented yet"
}
# randomfloat --
# Return a random floating-point number within a given range
#
# Arguments:
# min Minimum value
# max Maximum value
#
# Result:
# A random number within the given range
#
proc randomtesting::work::randomfloat {min max} {
expr {($max-$min)*rand()+$min}
}
# Now a small example:
# addlog is supposed to add the logarithms of two numbers,
# so its preconditions are x > 0 and y > 0. If these are
# met it returns a float value.
#
proc addlog {x y} {
expr {log($x*$y)} ;# More permissive than the description above!
}
namespace import ::randomtesting::*
randomtest "addlog" 100 {
set x [randomfloat -100.0 100.0]
set y [randomfloat -100.0 100.0]
precond { $x > 0 }
precond { $y > 0 }
#
# Make sure the variable result has a value ... TODO
set result {}
run { set result [addlog $x $y] }
postcond { $x <= 0.0 || $y <= 0.0 || [string is double -strict $result] }
}