[Haskell-cafe] QuickCheck subsumes unit testing

[Donald Bruce Stewart]

Just to walk the walk, and not just talk the talk, here's a quick unit
testing 'diff' driver I hacked up for QuickCheck.

When run, it 'diffs' (well, just prints ;-) the incorrect values from
the unit test:

    $ runhaskell T.hs
    sort unit test           : Falsifiable after 0 tests:
    - [1,2,3]
    + [1,3,2]

>From a normal QC specification like:

   prop0 = (sort [3,2,1], [1,3,2])

   main = mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests
     where
       n = 100
       tests = [("sort unit test", mytest prop0)]

The full driver code is attached. It is just proof of concept, but you
can see how to extend it to be smarter/prettier.

Note that we actually probably want to use SmallCheck here, to prevent
bogus repetition of the test. (I.e. 500 tests all passed, for a unit test).
Note also, the driver would need further extending, since we've changed
the structure of the Testable values.

Cheers,
  Don
-------------- next part --------------
import Data.List
import Text.Printf
import System.IO
import System.Random
import Test.QuickCheck

prop0 = (sort [3,2,1], [1,3,2])

main = mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests
 where
   n = 100
   tests = [("sort unit test", mytest prop0)]




------------------------------------------------------------------------
-- And a custom driver that `diff's the output

mytest :: (Show a, Eq a) => (a,a) -> Int -> IO ()
mytest (a,b) n = mycheck defaultConfig
    { configMaxTest=n
    , configEvery= \n args -> [] } a b

mycheck :: (Show a , Eq a) => Config -> a -> a -> IO ()
mycheck config a b =
  do rnd <- newStdGen
     mytests config (evaluate (a == b)) a b rnd 0 0 []

mytests :: (Show a , Eq a)
        => Config -> Gen Result -> a -> a -> StdGen -> Int -> Int -> [[String]] -> IO ()
mytests config gen a b rnd0 ntest nfail stamps
  | ntest == configMaxTest config = do done "OK," ntest stamps
  | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps
  | otherwise               =
      do putStr (configEvery config ntest (arguments result)) >> hFlush stdout
         case ok result of
           Nothing    ->
             mytests config gen a b rnd1 ntest (nfail+1) stamps
           Just True  ->
             mytests config gen a b rnd1 (ntest+1) nfail (stamp result:stamps)
           Just False ->
             putStr ( "Falsifiable after "
                   ++ show ntest
                   ++ " tests:\n"
                   ++ "- " ++ show a
                   ++ "\n"
                   ++ "+ " ++ show b
                   ++ "\n"
                    ) >> hFlush stdout
     where
      result      = generate (configSize config ntest) rnd2 gen
      (rnd1,rnd2) = split rnd0

done :: String -> Int -> [[String]] -> IO ()
done mesg ntest stamps =
  do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )
 where
  table = display
        . map entry
        . reverse
        . sort
        . map pairLength
        . group
        . sort
        . filter (not . null)
        $ stamps

  display []  = ".\n"
  display [x] = " (" ++ x ++ ").\n"
  display xs  = ".\n" ++ unlines (map (++ ".") xs)

  pairLength xss@(xs:_) = (length xss, xs)
  entry (n, xs)         = percentage n ntest
                       ++ " "
                       ++ concat (intersperse ", " xs)

  percentage n m        = show ((100 * n) `div` m) ++ "%"