# leepike/SmartCheck

leepike committed Feb 10, 2013
1 parent 9b7f65f commit c6516f697d4f0e4ea8879a8163e030ac75ea55e0
Showing with 334 additions and 263 deletions.
1. +3 −3 examples/Div0.hs
2. +18 −8 paper/Example/InitEx2.hs
3. +2 −2 paper/Example/Makefile
4. +3 −4 paper/Paper.hs
5. +22 −0 paper/paper.bib
6. +286 −246 paper/paper.tex
 @@ -38,9 +38,9 @@ instance Arbitrary Exp where , liftM2 Div mkM' mkM' ] where mkM' = mkM =<< choose (0,n-1) - shrink (C i) = map C (shrink i) - shrink (Add e0 e1) = [e0, e1] - shrink (Div e0 e1) = [e0, e1] + -- shrink (C i) = map C (shrink i) + -- shrink (Add e0 e1) = [e0, e1] + -- shrink (Div e0 e1) = [e0, e1] -- property: so long as 0 isn't in the divisor, we won't try to divide by 0. -- It's false: something might evaluate to 0 still.
 @@ -84,7 +84,14 @@ instance Arbitrary T where #if defined(qcNone) || defined(sc) || defined(feat) shrink _ = [] -#else +#endif +#ifdef qcjh + shrink (T w i0 i1 i2 i3) = + let xs = shrink (w, i0, i1, i2, i3) in + let go (w', i0', i1', i2', i3') = T w' i0' i1' i2' i3' in + map go xs +#endif +#if defined(qc10) || defined(qc20) shrink (T w i0 i1 i2 i3) = [ T a b c d e | a <- tk w , b <- tk i0, c <- tk i1 @@ -135,18 +142,21 @@ test rnds run = do let app str = appendFile logFile (str ++ "\n") let avg vals = sum vals / fromIntegral rnds' let med vals = sort vals !! (rnds' `div` 2) + let stdDev vals = sqrt (avg distances) + where + distances = map (\x -> (x - m)^2) vals + m = avg vals app "***************" print res let times = fst \$ unzip res' let szs :: [Double] szs = map fromIntegral (snd \$ unzip res') - app \$ "Num : " ++ show rnds' - app \$ "Max : " ++ show (maximum times) ++ ", " ++ show (maximum szs) - app \$ "Avg : " ++ show (avg times) ++ ", " ++ show (avg szs) - app \$ "Med : " ++ show (med times) ++ ", " ++ show (med szs) - -- app \$ "Size : " ++ show (fromIntegral (sum szs) / - -- fromIntegral rnds' :: Double) + app \$ "Num : " ++ show rnds' + app \$ "std dev : " ++ show (stdDev \$ map (fromRational . toRational) times) + ++ ", " ++ show (stdDev szs) + app \$ "Avg : " ++ show (avg times) ++ ", " ++ show (avg szs) + app \$ "Med : " ++ show (med times) ++ ", " ++ show (med szs) app "" app "" @@ -189,7 +199,7 @@ main = do #ifdef sc test rnds runSC #endif -#if defined(qcNone) || defined(qc10) || defined(qc20) +#if defined(qcNone) || defined(qc10) || defined(qc20) || defined(qcjh) test rnds (runQC stdArgs prop) #endif
 @@ -1,5 +1,5 @@ -#TARGETS=qcNone.out qc10.out qc20.out feat.out sc.out -TARGETS=qcNone.out #qc10.out feat.out sc.out +#TARGETS=qcNone.out qc10.out qc20.out feat.out qcjh.out sc.out +TARGETS=qcjh.out sc.out LOG=init.log RNDS=100 SRC=InitEx2
 @@ -62,7 +62,7 @@ class Arbitrary a => SubTypes a where subVals :: a -> Tree SubVal constr :: a -> String constrs :: a -> [String] --- baseType :: a -> Bool + baseType :: a -> Bool -------------------------------------------------------------------------------- @@ -218,13 +218,12 @@ matchesShapes :: SubTypes a => a -> [(a,[Idx])] -> Bool matchesShapes d = any (matchesShape d) --------------------------------------------------------------------------------- - -- | At each index that we generalize (either value generalization or -- constructor generalization), we replace that value from b into a. At this -- point, we check for constructor equality between the two values, decending -- their structures. -matchesShape :: SubTypes a => a -> (a, [Idx]) -> Bool +matchesShape :: SubTypes a + => a -> (a, [Idx]) -> Bool matchesShape a (b, idxs) | constr a /= constr b = False | Just a' <- aRepl
 @@ -19,6 +19,28 @@ @inproceedings{feat year = 2012 } +@inproceedings{telecom, + author = {Thomas Arts and + John Hughes and + Joakim Johansson and + Ulf T. Wiger}, + title = {Testing telecoms software with quviq QuickCheck}, + booktitle = {ACM SIGPLAN Workshop on Erlang Erlang Workshop}, + year = {2006}, + publisher = {ACM}, + pages = {2-10} +} + +@inproceedings{qcjh, + author = {John Hughes}, + title = {Software Testing with QuickCheck}, + booktitle = {Central European Functional Programming School (CEFP)}, + year = {2010}, + publisher = {Springer}, + volume = {6299}, + series = {LNCS}, + pages = {183-223} +} @Misc{ghc, key = {GHC},