14 Property-Based Testing: Enumeration

14.1 Overview

This code is taken from Sections 1, 2, 3, and 5 of this paper. Overall I believe the paper to be a better resource than the code below, but I have provided the code.

../code/Test.hs

-- sort :: Ord a => [a] -> [a]


sortTests :: [Bool]
sortTests = [ sort ([] :: [Int])     == ([] :: [Int])
           , sort [1,2,(3 :: Int) ] == [1,2,(3 :: Int)]
           , sort [3,2,(1 :: Int)] == [1,2, (3 :: Int)]
           ]


-- If sort is correct, all elements of the resulting list
-- will be in ascending order

-- The elements of the resulting list should be present in
-- both lists

-- The resulting list must be the same length as the input
-- list

-- propOrdered :: Ord a => [a] -> Bool
-- propOrdered xs = ordered (sort xs)
-- 
-- propCount :: Ord a => a -> [a] -> Bool
-- propCount x xs = count x (sort xs) == count x xs


class Listable a where
  tiers :: [[a]]

list :: Listable a => [a]
list = concat tiers

instance Listable Bool where
  tiers = [[False, True]]


instance Listable Word where
  tiers = map (\x -> [x]) [0..]






(\/) :: [[a]] -> [[a]] -> [[a]]
xss      \/ []       = xss
[]       \/ yss      = yss
(xs:xss) \/ (ys:yss) = (xs ++ ys) : xss \/ yss


interleave :: [a] -> [a] -> [a]
interleave []     ys = ys
interleave (x:xs) ys = x:(interleave ys xs)











(><) :: [[a]] -> [[b]] -> [[(a,b)]]
_        >< []  = []
[]       >< _   = []
(xs:xss) >< yss = map (\ys -> xs ** ys) yss
               \/ delay (xss >< yss)
  where
    xs ** ys = [ (x,y) | x <- xs, y <- ys]


delay xs = []:xs







instance (Listable a, Listable b) => Listable (a,b) where
  tiers = tiers >< tiers


-- counterExamples :: Listable a => Int -> (a -> Bool) -> [a]
-- counterExamples n p = [ x | x <- take n list, not (p x)]
-- 
-- 
data Expr = Val Word
          | Add Expr Expr
  deriving (Show, Eq)



cons0 :: a -> [[a]]
cons0 c = [[c]]

cons1 :: Listable a => (a -> b) -> [[b]]
cons1 c =  delay (map' c tiers)

map' = map . map





cons2 :: (Listable a, Listable b) => (a -> b -> c) -> [[c]]
cons2 c = delay (map' (uncurry c) tiers)

-- 
-- cons3 :: (Listable a, Listable b, Listable c) =>
--          (a -> b -> c -> d) -> [d]
-- cons3 c = [c x y z | (x, (y,z)) <- list]
-- 
instance Listable Expr where
  tiers = cons1 Val
       \/ cons2 Add
-- 
-- instance Listable a => Listable [a] where
--   -- list :: [[a]]
--   list =  cons0 []
--        \/ cons2 (:)
-- 
-- eval :: Expr -> Integer
-- eval (Val i)     = i
-- eval (Add e1 e2) = eval e1 + eval e2
-- 
-- -- eval (Add e1 e2) == eval (Add e2 e1)
-- 
-- checkFor :: (Show a, Listable a)
--          => Int -> (a -> Bool) -> IO ()
-- checkFor n p =
--   case counterExamples n p of
--     []     -> putStrLn ("You did alright")
--     (x:_)  -> putStrLn ("You failed! Look at this: " ++ show x)
-- 
-- 
-- check :: (Show a, Listable a) => (a -> Bool) -> IO ()
-- check = checkFor 200
-- 









































sort [] = []
sort (x:xs) = filter (< x) xs ++ [x] ++ filter (> x) xs