burned out of quick check for today, more later
This commit is contained in:
parent
fa2b16443f
commit
8d01d9a208
@ -52,6 +52,7 @@ library
|
|||||||
, Instructions.VectorStringInstructions
|
, Instructions.VectorStringInstructions
|
||||||
, Instructions.VectorLogicalInstructions
|
, Instructions.VectorLogicalInstructions
|
||||||
, Instructions.VectorCharInstructions
|
, Instructions.VectorCharInstructions
|
||||||
|
, LearnQuickCheck
|
||||||
|
|
||||||
-- Modules included in this library but not exported.
|
-- Modules included in this library but not exported.
|
||||||
-- other-modules:
|
-- other-modules:
|
||||||
@ -61,7 +62,7 @@ library
|
|||||||
|
|
||||||
-- Other library packages from which modules are imported.
|
-- Other library packages from which modules are imported.
|
||||||
build-depends:
|
build-depends:
|
||||||
base, containers, lens, split
|
base, containers, lens, split, QuickCheck
|
||||||
|
|
||||||
-- Directories containing source files.
|
-- Directories containing source files.
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
|
134
src/LearnQuickCheck.hs
Normal file
134
src/LearnQuickCheck.hs
Normal file
@ -0,0 +1,134 @@
|
|||||||
|
module LearnQuickCheck where
|
||||||
|
|
||||||
|
-- https://jesper.sikanda.be/posts/quickcheck-intro.html
|
||||||
|
|
||||||
|
import Test.QuickCheck
|
||||||
|
import Data.List (sort)
|
||||||
|
|
||||||
|
qsort :: Ord a => [a] -> [a]
|
||||||
|
qsort = sort
|
||||||
|
|
||||||
|
distance :: Int -> Int -> Int
|
||||||
|
distance x y = abs (x - y)
|
||||||
|
|
||||||
|
prop_dist35 :: Bool
|
||||||
|
prop_dist35 = distance 3 5 == 2
|
||||||
|
|
||||||
|
prop_dist_self :: Int -> Bool
|
||||||
|
prop_dist_self x = distance x x == 0
|
||||||
|
|
||||||
|
prop_dist_symmetric :: Int -> Int -> Bool
|
||||||
|
prop_dist_symmetric x y = distance x y == distance y x
|
||||||
|
|
||||||
|
bad_distance :: Int -> Int -> Int
|
||||||
|
bad_distance x y = y - x
|
||||||
|
|
||||||
|
prop_dist_symmetric_fail :: Int -> Int -> Bool
|
||||||
|
prop_dist_symmetric_fail x y = bad_distance x y == bad_distance y x
|
||||||
|
|
||||||
|
sorted :: Ord a => [a] -> Bool
|
||||||
|
sorted (x:y:ys) = x <= y && sorted (y:ys)
|
||||||
|
sorted _ = True
|
||||||
|
|
||||||
|
prop_sorted :: [Int] -> Bool
|
||||||
|
prop_sorted xs = sorted xs
|
||||||
|
|
||||||
|
-- roundtrip property
|
||||||
|
insert :: Int -> [Int] -> [Int]
|
||||||
|
insert x [] = [x]
|
||||||
|
insert x (y:ys) | x <= y = x:y:ys
|
||||||
|
| otherwise = y:insert x ys
|
||||||
|
|
||||||
|
delete :: Int -> [Int] -> [Int]
|
||||||
|
delete x [] = []
|
||||||
|
delete x (y:ys) | x == y = ys
|
||||||
|
| otherwise = y:delete x ys
|
||||||
|
|
||||||
|
prop_insert_delete :: [Int] -> Int -> Bool
|
||||||
|
prop_insert_delete xs x = delete x (insert x xs) == xs
|
||||||
|
|
||||||
|
-- Equivalent Property
|
||||||
|
prop_qsort_sort :: [Int] -> Bool
|
||||||
|
prop_qsort_sort xs = qsort xs == sort xs
|
||||||
|
|
||||||
|
-- can test this in ghci with verboseCheck
|
||||||
|
prop_qsort_sort' :: Ord a => [a] -> Bool
|
||||||
|
prop_qsort_sort' xs = qsort xs == sort xs
|
||||||
|
|
||||||
|
-- Algebraic Laws
|
||||||
|
vAdd :: (Int, Int) -> (Int, Int) -> (Int, Int)
|
||||||
|
vAdd tup0 tup1 = (fst tup0 + fst tup1, snd tup0 + snd tup1)
|
||||||
|
|
||||||
|
prop_vAdd_commutative :: (Int,Int) -> (Int,Int) -> Bool
|
||||||
|
prop_vAdd_commutative v w = vAdd v w == vAdd w v
|
||||||
|
|
||||||
|
prop_vAdd_associative :: (Int,Int) -> (Int,Int) -> (Int,Int) -> Bool
|
||||||
|
prop_vAdd_associative u v w = vAdd (vAdd u v) w == vAdd u (vAdd v w)
|
||||||
|
|
||||||
|
prop_vAdd_neutral_left :: (Int,Int) -> Bool
|
||||||
|
prop_vAdd_neutral_left u = vAdd (0,0) u == u
|
||||||
|
|
||||||
|
prop_vAdd_neutral_right :: (Int,Int) -> Bool
|
||||||
|
prop_vAdd_neutral_right u = vAdd u (0,0) == u
|
||||||
|
|
||||||
|
prop_qsort_idempotent :: [Int] -> Bool
|
||||||
|
prop_qsort_idempotent xs = qsort (qsort xs) == qsort xs
|
||||||
|
|
||||||
|
-- Testing with different distributions section
|
||||||
|
-- prop_replicate :: Int -> Int -> Int -> Bool
|
||||||
|
-- prop_replicate n x i = replicate n x !! i == x
|
||||||
|
|
||||||
|
prop_replicate :: Int -> Int -> Int -> Property
|
||||||
|
prop_replicate n x i =
|
||||||
|
(i >= 0 && i < n) ==> replicate n (x :: Int) !! i == x
|
||||||
|
|
||||||
|
prop_insert_sorted :: Int -> [Int] -> Property
|
||||||
|
prop_insert_sorted x xs = sorted xs ==> sorted (insert x xs)
|
||||||
|
|
||||||
|
-- Quantified properties
|
||||||
|
prop_insert_sorted' :: Int -> Property
|
||||||
|
prop_insert_sorted' x = forAll orderedList (\xs -> sorted (insert x xs))
|
||||||
|
|
||||||
|
-- Testing properties of functions
|
||||||
|
prop_filter :: Fun Int Bool -> [Int] -> Property
|
||||||
|
prop_filter p xs =
|
||||||
|
-- Filter elements not satisfying p.
|
||||||
|
let ys = [ x | x <- xs , applyFun p x ]
|
||||||
|
-- If any elements are left...
|
||||||
|
in ys /= [] ==>
|
||||||
|
-- ...generate a random index i...
|
||||||
|
forAll (choose (0,length ys-1))
|
||||||
|
-- ...and test if p (ys!!i) holds.
|
||||||
|
(\i -> applyFun p (ys!!i))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
prop_bananas :: Fun String Int -> Bool
|
||||||
|
prop_bananas f =
|
||||||
|
applyFun f "banana" == applyFun f "monkey" ||
|
||||||
|
applyFun f "banana" == applyFun f "elephant" ||
|
||||||
|
applyFun f "monkey" == applyFun f "elephant"
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
quickCheck prop_dist35
|
||||||
|
quickCheck prop_dist_self
|
||||||
|
quickCheck prop_dist_symmetric
|
||||||
|
-- Roundtrip tests
|
||||||
|
quickCheck prop_insert_delete
|
||||||
|
-- Equivalent tests
|
||||||
|
quickCheck prop_qsort_sort
|
||||||
|
-- quickCheck prop_qsort_sort'
|
||||||
|
-- Algebraic tests
|
||||||
|
quickCheck prop_vAdd_commutative
|
||||||
|
quickCheck prop_vAdd_associative
|
||||||
|
quickCheck prop_vAdd_neutral_left
|
||||||
|
quickCheck prop_vAdd_neutral_right
|
||||||
|
-- Testing with different distributions
|
||||||
|
quickCheck prop_replicate
|
||||||
|
quickCheck prop_insert_sorted
|
||||||
|
-- Quantified Properties
|
||||||
|
quickCheck prop_insert_sorted'
|
||||||
|
-- Testing properties of functions
|
||||||
|
quickCheck prop_filter
|
||||||
|
quickCheck prop_bananas
|
Loading…
x
Reference in New Issue
Block a user