mirror of
https://github.com/iritmaximus/haskell.git
synced 2026-10-12 19:13:39 +03:00
140 lines
5.5 KiB
Haskell
140 lines
5.5 KiB
Haskell
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
|
|
|
|
module Set16aTest where
|
|
|
|
import Mooc.Test
|
|
import Mooc.Th
|
|
|
|
import Control.Monad
|
|
import Data.List
|
|
import Test.QuickCheck
|
|
import Test.QuickCheck.Monadic hiding (pick)
|
|
|
|
import Set16a
|
|
|
|
main = score tests
|
|
|
|
tests = [(1,"isSorted",[ex1_1, ex1_2])
|
|
,(2,"sumIsLength",[ex2])
|
|
,(3,"inputInOutput",[ex3])
|
|
,(4,"outputInInput",[ex4])
|
|
,(5,"frequenciesProp",[ex5_1, ex5_2, ex5_3, ex5_4])
|
|
,(6,"genList",[ex6_1,ex6_2])
|
|
,(7,"Arbitrary Expression",[ex7_arg_1, ex7_arg_2, ex7_exp])]
|
|
|
|
-- -- -- -- --
|
|
|
|
qPass p = monadicIO $ do
|
|
res <- run $ quickCheckWithResult quietArgs p
|
|
stop_ $
|
|
counterexample " Should pass" $
|
|
counterexample "quickCheck output:" $
|
|
counterexample (output res) $
|
|
isSuccess res
|
|
|
|
qFail p = monadicIO $ do
|
|
res <- run $ quickCheckWithResult quietArgs p
|
|
stop_ $
|
|
counterexample " Should fail" $
|
|
counterexample "quickCheck output:" $
|
|
counterexample (output res) $
|
|
case res of Failure{} -> True
|
|
_ -> False
|
|
|
|
letter = choose ('a','z')
|
|
|
|
ex1_1 = conjoin [$(testing [|isSorted [1,2,3]|]) qPass
|
|
,$(testing [|isSorted [1,3,2]|]) qFail
|
|
,$(testing [|isSorted ([]::[Int])|]) qPass]
|
|
|
|
ex1_2 = forAll (listOf1 (choose (-2,4::Integer))) $ \deltas ->
|
|
let inp = scanl (+) 3 deltas
|
|
in $(testing [|isSorted inp|]) (if all (>=0) deltas then qPass else qFail)
|
|
|
|
ex2 = forAllBlind (listOf (choose (0,3))) $ \ns ->
|
|
forAllBlind (vectorOf (length ns) letter) $ \cs ->
|
|
forAllBlind (vectorOf (sum ns) letter) $ \inp ->
|
|
let out = zip cs ns
|
|
in conjoin [$(testing [|sumIsLength inp out|]) qPass
|
|
,not (null inp) ==> forAllBlind (choose (1,length inp)) (\k -> $(testing [|sumIsLength (drop k inp) out|]) qFail)
|
|
,forAllBlind (choose (1,length out)) (\k -> sum (take k ns) /= 0 ==> $(testing [|sumIsLength inp (drop k out)|]) qFail)]
|
|
|
|
ex3 = forAllBlind (listOf1 letter) $ \inp ->
|
|
forAllBlind (vectorOf (length inp) (choose (0,100))) $ \ns ->
|
|
forAllBlind (shuffle (zip (nub inp) ns)) $ \out ->
|
|
forAllBlind (sublistOf inp `suchThat` (not.null)) $ \inp' ->
|
|
forAllBlind (sublistOf out) $ \out' ->
|
|
conjoin [$(testing [|inputInOutput inp' out|]) qPass
|
|
,out' /= out ==> $(testing [|inputInOutput inp out'|]) qFail]
|
|
|
|
outToIn = concatMap (\(c,i) -> replicate i c)
|
|
|
|
chg :: (a,Int) -> Gen (a,Int)
|
|
chg (c,i) = do j <- choose (1,5) `suchThat` (/=i)
|
|
return (c,j)
|
|
|
|
changeCount :: [(a,Int)] -> Gen [(a,Int)]
|
|
changeCount [p] = fmap (:[]) $ chg p
|
|
changeCount (p:ps) = oneof [fmap (p:) $ changeCount ps
|
|
,fmap (:ps) $ chg p]
|
|
|
|
ex4 = forAllBlind (choose (1,8)) $ \n ->
|
|
forAllBlind (vectorOf n letter) $ \cs ->
|
|
forAllBlind (vectorOf (length cs) (choose (1,5))) $ \ns ->
|
|
forAllBlind (shuffle (zip (nub cs) ns)) $ \out ->
|
|
forAllBlind (shuffle (outToIn out)) $ \inp ->
|
|
forAllBlind (sublistOf out `suchThat` (not.null)) $ \out' ->
|
|
forAllBlind (sublistOf inp) $ \inp' ->
|
|
conjoin [$(testing [|outputInInput inp out'|]) qPass
|
|
,inp' /= inp ==> $(testing [|outputInInput inp' out|]) qFail
|
|
,forAllBlind (changeCount out) $ \out2 ->
|
|
$(testing [|outputInInput inp out2|]) qFail]
|
|
|
|
ex5_1 = $(testing' [|frequenciesProp freq1|]) qFail
|
|
ex5_2 = $(testing' [|frequenciesProp freq2|]) qFail
|
|
ex5_3 = $(testing' [|frequenciesProp freq3|]) qFail
|
|
ex5_4 = $(testing' [|frequenciesProp frequencies|]) qPass
|
|
|
|
testGenMany :: (Show t) => Gen t -> Int -> ([t] -> Property) -> Property
|
|
testGenMany gen i k = monadicIO $ do
|
|
xs <- run $ replicateM i (generate gen)
|
|
monitor (counterexample ("Generated values: " ++ show xs))
|
|
stop_ $ k xs
|
|
|
|
testGen :: (Show t) => Gen t -> (t -> Property) -> Property
|
|
testGen gen k = monadicIO $ do
|
|
x <- run $ generate gen
|
|
monitor (counterexample ("Generated value: " ++ show x))
|
|
stop_ $ k x
|
|
|
|
ex6_1 = testGen genList $ \l ->
|
|
conjoin [counterexample " length should be 3-5" $ length l >= 3 && length l <= 5
|
|
,counterexample " all elements should be 0-10" $ all (\x -> x>=0 && x<=10) l
|
|
,counterexample " list should be sorted" $ sort l == l]
|
|
|
|
ex6_2 = once $ testGenMany genList 30 $ \ls ->
|
|
conjoin [counterexample " should have lists of all lengths" $ nub (sort (map length ls)) ?== [3,4,5]
|
|
,counterexample " should at least 7 different ints" $ length (nub (sort (concat ls))) >= 7
|
|
,counterexample " should have a list with differing elements" $ any ((>1).length.nub) ls]
|
|
|
|
ex7_arg_1 = counterexample "arbitrary :: Gen Arg" $
|
|
testGen (arbitrary :: Gen Arg) $ \a ->
|
|
case a of Number i -> counterexample " number should be in the range 0-10" $ i>=0 && i<=10
|
|
Variable c -> counterexample " variable should be one of abcxyz" $ elem c "abcxyz"
|
|
|
|
ex7_arg_2 = once $ counterexample "arbitrary :: Gen Arg" $
|
|
testGenMany (arbitrary :: Gen Arg) 20 $ \as ->
|
|
counterexample " should generate both Number and Variable values" $ any isVariable as && any (not.isVariable) as
|
|
where isVariable (Variable _) = True
|
|
isVariable _ = False
|
|
|
|
ex7_exp = once $ counterexample "arbitrary :: Gen Expression" $
|
|
testGenMany (arbitrary :: Gen Expression) 64 $ \es ->
|
|
counterexample " should generate all cases" $ nub (sort (map cla es)) ?==
|
|
["MinusNumberNumber","MinusNumberVariable","MinusVariableNumber","MinusVariableVariable"
|
|
,"PlusNumberNumber","PlusNumberVariable","PlusVariableNumber","PlusVariableVariable"]
|
|
where cl (Variable _) = "Variable"
|
|
cl (Number _) = "Number"
|
|
cla (Plus x y) = "Plus" ++ cl x ++ cl y
|
|
cla (Minus x y) = "Minus" ++ cl x ++ cl y
|