QuickCheck: A Lightweight Random Test Tool

Introduction

NEM 2009-11-19: This is a partial port of the Haskell QuickCheck library that provides lightweight random testing [L1 ]. The package allows you to annotate your code with simple specification laws that your procedures should obey, along with a description of the types of arguments it expects. The quickcheck package will then automatically generate random test data to verify the property holds. This provides a simple way of testing your code on a wide variety of input data without having to labouriously enter individual test cases.

Examples

As an example, suppose that we (for some reason) had to write our own sort function for sorting lists of integers. We will write a simple quick-sort style implementation:

proc sort xs {
    if {[llength $xs] == 0} { return $xs } ;# base case
    set x [lindex $xs 0]
    set xs [lrange $xs 1 end]
    list {*}[sort [filter "< $x" $xs]] $x {*}[sort [filter ">= $x" $xs]]
}
proc filter {p xs} {
    set ys [list]
    foreach x $xs { if "$x $p" { lappend ys $x } }
    return $ys
}

We can now write our specification as a quickcheck assertion as follows:

quickcheck forall xs {List Int} => { [sort $xs] eq [lsort -integer $xs] }

This declaration says that for all xs that are of type list of integer, the property should hold that the result of sorting the list is the same as the result of calling [lsort -integer] on it. When this statement is encountered, quickcheck will automatically generate a number of random lists of random integers and check that the property holds for each input data. If it encounters a counter-example then an error is thrown showing the input data that caused the check to fail.

In this way you can concentrate on specifying the laws that your code should obey and let quickcheck come up with test data to try it against. The more times you run your tests, the greater the range of inputs that are checked. Essentially, you are running a simple non-exhaustive model checker against your code. The laws can be written out directly in your code after each procedure, helping to document the code.

Laws are written, as we've seen with the quickcheck forall command, which has the syntax:

  quickcheck forall var domain ?var domain...? => expression

Where var is a variable name, domain is the domain over which that variable should range, and the expression is an arbitrary boolean expression (as interpreted by expr). The package currently provides the following built-in domain generators:

  • Bool: uses elements of the set {0,1,on,off,yes,no,true,false} as input
  • Nat: generates a random integer in the range [0,2^64)
  • Int: generates integers in the range [-2^64,2^64)
  • Double: generates doubles in the range [-2^1023,2^1023)
  • Char: generates characters in the range [#u0010,\u00FF]
  • Enum xs: picks random elements from the list given
  • Range low high: generates random integers in the range [low,high)
  • String: generates random strings of length [0,256)
  • List elem: generates random lists of length [0,256) where the elements are generated by elem

Each domain is itself just a procedure that returns random data in that domain, so you can add your own domains by creating new procedures. For instance, to generate random person records to test an employee database, you could use:

proc Person {} {
    dict create name [::quickcheck::String] age [::quickcheck::Range 0 120]
}

You can enable and disable the tests by using quickcheck status ?on|off?. When disabled, the forall command is replaced with a stub so there should be zero overhead in a byte-compiled context. You can also configure the package using the quickcheck configure command that accepts the following options:

  • -numtests: the number of tests to run for each law (default: 100)
  • -outputchan: where to send test output info (default: stdout)
  • -verbose 0|1: how much output to produce (default: 0, just a summary, 1 means every test).

TODO

There are a number of areas that require improvement: better random data generation, more built-in domain generators, better error reporting, etc. Improvements welcome.

Code

# quickcheck.tcl --
#
#       Tcl approximation of Haskell's QuickCheck library for automated
#       property checking.
#

package require Tcl         8.5
package provide quickcheck  0.1

namespace eval ::quickcheck {
    namespace export {[a-z]*}
    namespace ensemble create -map {
        status          ::quickcheck::status
        configure       ::quickcheck::configure
        forall          ::quickcheck::forall
    }

    variable options {
        -numtests       100
        -outputchan     stdout
        -verbose        0
    }
    variable status     1

    proc configure args {
        variable options
        if {[llength $args] == 0} {
            return $options
        } elseif {[llength $args] == 1} {
            return [dict get $options [lindex $args 0]]
        } elseif {[llength $args] % 2 == 0} {
            set options [dict merge $options $args]
        } else {
            set usage "quickcheck configure ?-option ?value ...??"
            error "wrong # args: should be \"$usage\""
        }
    }

    proc status args {
        variable status
        if {[llength $args] > 1} { error "wrong # args" }
        if {[llength $args] == 0} { return $status }
        # Normalise boolean before storing
        set status [expr {!![lindex $args 0]}]
        # Optimise implementation
        set map [namespace ensemble configure ::quickcheck -map]
        if {$status} {
            namespace ensemble configure ::quickcheck -map \
                [dict merge $map {forall ::quickcheck::forall}]
        } else {
            namespace ensemble configure ::quickcheck -map \
                [dict merge $map {forall ::quickcheck::noop}]
        }
        return $status
    }

    proc noop args {}
    proc forall args {
        variable options
        set usage "forall var domain ?...? => expression"
        if {[llength $args] < 4 || [lindex $args end-1] ne "=>"} {
            error "invalid syntax: should be \"$usage\""
        }
        output 1 "checking $args"
        set body [lindex $args end]
        set params [list]
        set domains [list]
        foreach {var domain} [lrange $args 0 end-2] {
            lappend params $var
            lappend domains $domain
        }
        set prop [list $params [list expr $body]]
        # Generate test data from the domain generators and call the property
        for {set i 0} {$i < [dict get $options -numtests]} {incr i} {
            set data [list]
            foreach domain $domains {
                lappend data [{*}$domain]
            }
            output 1 "Test: $data"
            set check [apply $prop {*}$data]
            if {!$check} {
                output 0 "FAIL! $data ($args)"
                error "check failure: $data (while checking $args)"
            }
        }
        output 0 "PASS: [dict get $options -numtests] OK"
    }

    proc output {level message} {
        variable options
        if {$level <= [dict get $options -verbose]} {
            puts [dict get $options -outputchan] $message
        }
    }

    # Random test data generators
    # Pick a random element from a list
    proc element xs { lindex $xs [irand 0 [llength $xs]] }
    # Generate a random floating point number in the range [low,high)
    proc rand {low high} { expr {rand()*($high-$low)+$low} }
    # Generate a random integer in the range [low,high)
    proc irand {low high} { expr {int([rand $low $high])} }

    # Domain generators:
    proc Bool {} { element {0 1 on off true false yes no} }
    proc Nat {} { irand 0 [expr {2**64}] }
    proc Int {} { irand [expr {-(2**64)}] [expr {2**64}] }
    proc Enum elements { element $elements }
    proc Range {low high} { irand $low $high }
    proc Double {} { rand [expr {-pow(2,1023)}] [expr {pow(2,1023)}] }
    proc Char {} { format %c [irand 10 256] } ;# TODO: Generate UTF8
    proc String {} { join [List Char] "" }
    # Compound domain generators
    proc List elemgen {
        set xs [list]
        set len [irand 0 256]
        for {set i 0} {$i < $len} {incr i} { lappend xs [{*}$elemgen] }
        return $xs
    }
}