[Haskell] ANN: SmallCheck 0.1

Donald Bruce Stewart dons at cse.unsw.edu.au
Wed Sep 13 13:34:12 EDT 2006


colin:
> SmallCheck: another lightweight testing library in Haskell.
> 
> Folk-law: if there is any case in which a program fails, there is almost
> always a simple one.
> 
> SmallCheck is similar to QuickCheck (Claessen and Hughes 2000-)
> but instead of a sample of randomly generated values, SmallCheck
> tests properties for all the finitely many values up to some depth,
> progressively increasing the depth used.  For data values, depth means
> depth of construction.  For functional values, it is a measure combining
> the depth to which arguments may be evaluated and the depth of possible
> results.
> 
> Other possible sales pitches:
> * write test generators for your own types more easily
> * be sure any counter-examples found are minimal
> * write properties using existentials as well as universals
> * establish complete coverage of a defined test-space
> * display counter-examples of functional type
> 
> A new version of SmallCheck can be obtained from:
> http://www.cs.york.ac.uk/fp/smallcheck0.1.tar
> The differences from 0.0 are two fixes (space-fault, output buffering),
> an 'unsafe' but sometimes useful Testable (IO a) instance and additional
> examples.
> 
> Comments and suggestions welcome.

I've written a lambdabot plugin for SmallCheck, to go with the existing
one for QuickCheck. It's running on #haskell now (after removing that
pesky Testable IO instance (not good for security...).

Let's run QuickCheck (check) head to head with SmallCheck (scheck): 

    $ ./lambdabot
    Initialising plugins ................................................. done.

    lambdabot> check True
     OK, passed 500 tests.

    lambdabot> scheck True
     Completed 1 test(s) without failure.

    lambdabot> check \s -> (s :: [Int]) == (reverse . reverse) s
     OK, passed 500 tests.

    lambdabot> scheck \s -> (s :: [Int]) == (reverse . reverse) s
     Completed 623530 test(s) without failure.

    lambdabot> check \s -> not (null s) ==> minimum (s :: [Int]) == (head . sort) s
     OK, passed 500 tests.

    lambdabot> scheck \s -> not (null s) ==> minimum (s :: [Int]) == (head . sort) s
     Completed 623530 test(s) without failure.  But 1 did not meet ==> condition.

    lambdabot> scheck \s -> not (null s) ==> minimum (s :: [Int]) == (last . sort) s
      Failed test no. 10. Test values follow.: [-1,-1,-1,-1,-1,-1,-1,0]

    lambdabot> check \s -> not (null s) ==> minimum (s :: [Int]) == (last . sort) s
     Falsifiable, after 1 tests: [2,1]

One thing needed for online use: some more instances for the various numeric
types might be useful, Float, Double, Ratio, Complex etc.

-- Don


More information about the Haskell mailing list