From 74e8aca31568a164df74e751b0db90b6bc169d79 Mon Sep 17 00:00:00 2001 From: Stevan Andjelkovic Date: Sat, 28 Sep 2024 14:54:53 +0200 Subject: [PATCH] More structure and code snippets. --- README-unprocessed.md | 69 ++++++++++++------ README.md | 163 ++++++++++++++++++++++++++++++++---------- src/QuickCheckV1.hs | 40 ++++++++--- 3 files changed, 205 insertions(+), 67 deletions(-) diff --git a/README-unprocessed.md b/README-unprocessed.md index a5054ae..5e5714e 100644 --- a/README-unprocessed.md +++ b/README-unprocessed.md @@ -9,7 +9,7 @@ testing wasn't a thing. In this post I'll survey the coverage-guided landscape, looking at what was there before Dan's post and what has happened since. -The short version is: imperative languages seem to be in the forefront of +The short version is: today imperative languages seem to be in the forefront of combining coverage-guidance and property-based testing. In an effort to try to help functional programming languages catch up, I'll @@ -210,24 +210,37 @@ note](https://github.com/HypothesisWorks/hypothesis/pull/1564/commits/dcbea9148b As far as I can tell, it hasn't been reintroduced since. +However it's possible to hook Hypothesis up to [use external +fuzzers](https://hypothesis.readthedocs.io/en/latest/details.html#use-with-external-fuzzers). + +XXX: how does this work? like in Crowbar? What are the disadvantages? Why isn't +this the default? + What else has happenend since Dan's post? -* > "Note: AFL hasn't been updated for a couple of years; while it should still - > work fine, a more complex fork with a variety of improvements and additional - > features, known as AFL++, is available from other members of the community - > and is worth checking out." -- https://lcamtuf.coredump.cx/afl/ +One of the first things I noticed is that AFL is no longer +[maintained](https://lcamtuf.coredump.cx/afl/): + +> "Note: AFL hasn't been updated for a couple of years; while it should still +> work fine, a more complex fork with a variety of improvements and additional +> features, known as AFL++, is available from other members of the community +> and is worth checking out." - + [AFL++](https://www.usenix.org/system/files/woot20-paper-fioraldi.pdf) - (2020) incorporates all of - [AFLFast](https://mboehme.github.io/paper/CCS16.pdf)'s [power - schedules](https://aflplus.plus/docs/power_schedules/) and adds some news - ones - + https://github.com/mboehme/aflfast +[AFL++](https://www.usenix.org/system/files/woot20-paper-fioraldi.pdf) (2020) + - incorporates all of + [AFLFast](https://mboehme.github.io/paper/CCS16.pdf)'s [power + schedules](https://aflplus.plus/docs/power_schedules/) and adds some new + ones + - explain what power schedules are? + - https://github.com/mboehme/aflfast * When you search for "coverage-guided property-based testing" in the academic literature -* [FuzzChick](https://dl.acm.org/doi/10.1145/3360607) (2019). Not released, lives in - an [unmaintained +* [*Coverage guided, property based + testing*](https://dl.acm.org/doi/10.1145/3360607) by Leonidas Lampropoulos, + Michael Hicks, Benjamin C. Pierce (2019) +* FuzzChick Coq/Rocq library +* Not released, lives in an [unmaintained branch](https://github.com/QuickChick/QuickChick/compare/master...FuzzChick) that [doesn't compile](https://github.com/QuickChick/QuickChick/issues/277)? - coverage info is [same as in AFL](https://youtu.be/RR6c_fiMfJQ?t=2226) @@ -270,6 +283,7 @@ version, based on the original property-based testing implementation. One key question we need to answer in order to be able to implement anything that's coverage-guided is: where do we get the coverage information from? +### Getting the coverage information AFL and `go-fuzz` both get it from the compiler. @@ -314,23 +328,26 @@ very first version[^2]! So the question is: can we implement coverage-guided property-based testing using the internal notion of coverage that property-based testing already has? +### The first version of QuickCheck * QuickCheck as defined in the appendix of the original [paper](https://dl.acm.org/doi/10.1145/351240.351266) (ICFP, 2000) - - Extended monadic properties - -* Edsko de Vries' - [Mini-QuickCheck](https://www.well-typed.com/blog/2019/05/integrated-shrinking/) ``` {.haskell include=src/QuickCheckV1.hs snippet=Gen} ``` +Footnote: We'll not talk about the coarbitrary, which is used to generate +functions. + ``` {.haskell include=src/QuickCheckV1.hs snippet=rand} ``` ``` {.haskell include=src/QuickCheckV1.hs snippet=sized} ``` +``` {.haskell include=src/QuickCheckV1.hs snippet=Arbitrary} +``` + ``` {.haskell include=src/QuickCheckV1.hs snippet=Property} ``` @@ -346,17 +363,27 @@ using the internal notion of coverage that property-based testing already has? ``` {.haskell include=src/QuickCheckV1.hs snippet=evaluate} ``` -``` {.haskell include=src/QuickCheckV1.hs snippet=coverCheck} +``` {.haskell include=src/QuickCheckV1.hs snippet=classify} ``` -``` {.haskell include=src/QuickCheckV1.hs snippet=testsC} +``` {.haskell include=src/QuickCheckV1.hs snippet=Config} ``` -``` {.haskell include=src/QuickCheckV1.hs snippet=testsCPrime} +``` {.haskell include=src/QuickCheckV1.hs snippet=quickCheck} ``` -``` {.haskell include=src/QuickCheckV1.hs snippet=classify} +### The extension to add coverage-guidance + + +``` {.haskell include=src/QuickCheckV1.hs snippet=coverCheck} ``` + +``` {.haskell include=src/QuickCheckV1.hs snippet=testsC1} +``` + +``` {.haskell include=src/QuickCheckV1.hs snippet=testsC2} +``` + The full source code is available [here](https://github.com/stevana/coverage-guided-pbt). diff --git a/README.md b/README.md index 5c43145..7350a15 100644 --- a/README.md +++ b/README.md @@ -10,8 +10,8 @@ property-based testing wasn't a thing. In this post I'll survey the coverage-guided landscape, looking at what was there before Dan's post and what has happened since. -The short version is: imperative languages seem to be in the forefront -of combining coverage-guidance and property-based testing. +The short version is: today imperative languages seem to be in the +forefront of combining coverage-guidance and property-based testing. In an effort to try to help functional programming languages catch up, I'll show how coverage-guidence can be added to the first version of the @@ -218,26 +218,44 @@ note](https://github.com/HypothesisWorks/hypothesis/pull/1564/commits/dcbea9148b As far as I can tell, it hasn't been reintroduced since. +However it's possible to hook Hypothesis up to [use external +fuzzers](https://hypothesis.readthedocs.io/en/latest/details.html#use-with-external-fuzzers). + +XXX: how does this work? like in Crowbar? What are the disadvantages? +Why isn't this the default? + What else has happenend since Dan's post? -- "Note: AFL hasn't been updated for a couple of years; while it should - > still work fine, a more complex fork with a variety of improvements - > and additional features, known as AFL++, is available from other - > members of the community and is worth checking out." -- - > +One of the first things I noticed is that AFL is no longer +[maintained](https://lcamtuf.coredump.cx/afl/): + +> "Note: AFL hasn't been updated for a couple of years; while it should +> still work fine, a more complex fork with a variety of improvements +> and additional features, known as AFL++, is available from other +> members of the community and is worth checking out." + +[AFL++](https://www.usenix.org/system/files/woot20-paper-fioraldi.pdf) +(2020) + +- incorporates all of + [AFLFast](https://mboehme.github.io/paper/CCS16.pdf)'s [power + schedules](https://aflplus.plus/docs/power_schedules/) and adds some + new ones +- explain what power schedules are? +- - - [AFL++](https://www.usenix.org/system/files/woot20-paper-fioraldi.pdf) (2020) - incorporates all of - [AFLFast](https://mboehme.github.io/paper/CCS16.pdf)'s [power - schedules](https://aflplus.plus/docs/power_schedules/) and adds some - news ones - - + - When you search for "coverage-guided property-based testing" in the academic literature -- [FuzzChick](https://dl.acm.org/doi/10.1145/3360607) (2019). Not - released, lives in an [unmaintained +- [*Coverage guided, property based + testing*](https://dl.acm.org/doi/10.1145/3360607) by Leonidas + Lampropoulos, Michael Hicks, Benjamin C. Pierce (2019) + +- FuzzChick Coq/Rocq library + +- Not released, lives in an [unmaintained branch](https://github.com/QuickChick/QuickChick/compare/master...FuzzChick) that [doesn't compile](https://github.com/QuickChick/QuickChick/issues/277)? @@ -296,6 +314,8 @@ One key question we need to answer in order to be able to implement anything that's coverage-guided is: where do we get the coverage information from? +### Getting the coverage information + AFL and `go-fuzz` both get it from the compiler. AFL injects code into every [basic @@ -346,14 +366,11 @@ So the question is: can we implement coverage-guided property-based testing using the internal notion of coverage that property-based testing already has? +### The first version of QuickCheck + - QuickCheck as defined in the appendix of the original [paper](https://dl.acm.org/doi/10.1145/351240.351266) (ICFP, 2000) - - Extended monadic properties - -- Edsko de Vries' - [Mini-QuickCheck](https://www.well-typed.com/blog/2019/05/integrated-shrinking/) - ``` haskell newtype Gen a = Gen (Int -> StdGen -> a) @@ -363,6 +380,9 @@ generate n rnd (Gen m) = m size rnd' (size, rnd') = randomR (0, n) rnd ``` +Footnote: We'll not talk about the coarbitrary, which is used to +generate functions. + ``` haskell rand :: Gen StdGen rand = Gen (\_n r -> r) @@ -373,6 +393,25 @@ sized :: (Int -> Gen a) -> Gen a sized fgen = Gen (\n r -> let Gen m = fgen n in m n r) ``` +``` haskell +class Arbitrary a where + arbitrary :: Gen a + +instance Arbitrary Bool where + arbitrary = elements [True, False] + +instance Arbitrary Char where + -- Avoids generating control characters. + arbitrary = choose (32,126) >>= \n -> return (chr n) + +instance Arbitrary Int where + arbitrary = sized $ \n -> choose (-n,n) + +instance Arbitrary a => Arbitrary [a] where + arbitrary = sized (\n -> choose (0,n) >>= vector) + +``` + ``` haskell newtype Property = Prop (Gen Result) @@ -424,6 +463,74 @@ evaluate :: Testable a => a -> Gen Result evaluate a = gen where Prop gen = property a ``` +``` haskell +label :: Testable a => String -> a -> Property +label s a = Prop (add `fmap` evaluate a) + where + add res = res{ stamp = s : stamp res } + +classify :: Testable a => Bool -> String -> a -> Property +classify True name = label name +classify False _ = property +``` + +``` haskell +data Config = Config + { maxTest :: Int + , maxFail :: Int + , size :: Int -> Int + , every :: Int -> [String] -> String + } + +quick :: Config +quick = Config + { maxTest = 100 + , maxFail = 1000 + , size = (+ 3) . (`div` 2) + , every = \n args -> let s = show n in s ++ [ '\b' | _ <- s ] + } + +verbose :: Config +verbose = quick + { every = \n args -> show n ++ ":\n" ++ unlines args + } +``` + +``` haskell +test, quickCheck, verboseCheck :: Testable a => a -> IO () +test = check quick +quickCheck = check quick +verboseCheck = check verbose + +check :: Testable a => Config -> a -> IO () +check config a = + do rnd <- newStdGen + tests config (evaluate a) rnd 0 0 [] + +tests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO () +tests config gen rnd0 ntest nfail stamps + | ntest == maxTest config = do done "OK, passed" ntest stamps + | nfail == maxFail config = do done "Arguments exhausted after" ntest stamps + | otherwise = + do putStr (every config ntest (arguments result)) + case ok result of + Nothing -> + tests config gen rnd1 ntest (nfail+1) stamps + Just True -> + tests config gen rnd1 (ntest+1) nfail (stamp result:stamps) + Just False -> + putStr ( "Falsifiable, after " + ++ show ntest + ++ " tests:\n" + ++ unlines (arguments result) + ) + where + result = generate (size config ntest) rnd2 gen + (rnd1,rnd2) = split rnd0 +``` + +### The extension to add coverage-guidance + ``` haskell coverCheck :: (Arbitrary a, Show a) => Config -> ([a] -> Property) -> IO () coverCheck config prop = do @@ -432,11 +539,6 @@ coverCheck config prop = do ``` ``` haskell -testsC' :: Show a => Config -> Gen a -> ([a] -> Property) -> StdGen -> Int -> Int -> [[String]] -> IO () -testsC' config gen prop = tests config genResult - where - Prop genResult = forAll (genList gen) prop - genList gen = sized $ \len -> replicateM len gen testsC :: Show a => Config -> Gen a -> ([a] -> Property) -> [a] -> Int -> StdGen -> Int -> Int -> [[String]] -> IO () testsC config gen prop xs cov rnd0 ntest nfail stamps @@ -477,17 +579,6 @@ testsC' config gen prop = tests config genResult genList gen = sized $ \len -> replicateM len gen ``` -``` haskell -label :: Testable a => String -> a -> Property -label s a = Prop (add `fmap` evaluate a) - where - add res = res{ stamp = s : stamp res } - -classify :: Testable a => Bool -> String -> a -> Property -classify True name = label name -classify False _ = property -``` - The full source code is available [here](https://github.com/stevana/coverage-guided-pbt). diff --git a/src/QuickCheckV1.hs b/src/QuickCheckV1.hs index 9c80050..fbe06e8 100644 --- a/src/QuickCheckV1.hs +++ b/src/QuickCheckV1.hs @@ -151,28 +151,41 @@ four m = liftM4 (,,,) m m m m -------------------------------------------------------------------- -- Arbitrary +-- start snippet Arbitrary class Arbitrary a where - arbitrary :: Gen a + arbitrary :: Gen a + +-- end snippet coarbitrary :: a -> Gen b -> Gen b instance Arbitrary () where - arbitrary = return () + arbitrary = return () coarbitrary _ = variant 0 +-- start snippet Arbitrary instance Arbitrary Bool where - arbitrary = elements [True, False] + arbitrary = elements [True, False] + +-- end snippet coarbitrary b = if b then variant 0 else variant 1 +-- start snippet Arbitrary instance Arbitrary Char where - arbitrary = choose (32,126) >>= \n -> return (chr n) + -- Avoids generating control characters. + arbitrary = choose (32,126) >>= \n -> return (chr n) + +-- end snippet coarbitrary n = variant (ord n) +-- start snippet Arbitrary instance Arbitrary Int where - arbitrary = sized $ \n -> choose (-n,n) + arbitrary = sized $ \n -> choose (-n,n) + +-- end snippet coarbitrary n = variant (if n >= 0 then 2*n else 2*(-n) + 1) instance Arbitrary Integer where - arbitrary = sized $ \n -> choose (-toInteger n, toInteger n) + arbitrary = sized $ \n -> choose (-toInteger n, toInteger n) coarbitrary n = variant (fromInteger (if n >= 0 then 2*n else 2*(-n) + 1)) instance Arbitrary Float where @@ -200,13 +213,16 @@ instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) coarbitrary (a, b, c, d) = coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d +-- start snippet Arbitrary instance Arbitrary a => Arbitrary [a] where - arbitrary = sized (\n -> choose (0,n) >>= vector) + arbitrary = sized (\n -> choose (0,n) >>= vector) + +-- end snippet coarbitrary [] = variant 0 coarbitrary (a:as) = coarbitrary a . variant 1 . coarbitrary as instance (Arbitrary a, Arbitrary b) => Arbitrary (a -> b) where - arbitrary = promote (`coarbitrary` arbitrary) + arbitrary = promote (`coarbitrary` arbitrary) coarbitrary f gen = arbitrary >>= ((`coarbitrary` gen) . f) -------------------------------------------------------------------- @@ -287,6 +303,7 @@ collect v = label (show v) -------------------------------------------------------------------- -- Testing +-- start snippet Config data Config = Config { maxTest :: Int , maxFail :: Int @@ -306,7 +323,9 @@ verbose :: Config verbose = quick { every = \n args -> show n ++ ":\n" ++ unlines args } +-- end snippet +-- start snippet quickCheck test, quickCheck, verboseCheck :: Testable a => a -> IO () test = check quick quickCheck = check quick @@ -337,6 +356,7 @@ tests config gen rnd0 ntest nfail stamps where result = generate (size config ntest) rnd2 gen (rnd1,rnd2) = split rnd0 +-- end snippet done :: String -> Int -> [[String]] -> IO () done mesg ntest stamps = @@ -366,7 +386,7 @@ done mesg ntest stamps = -------------------------------------------------------------------- -- the end. --- start snippet testsCPrime +-- start snippet testsC2 testsC' :: Show a => Config -> Gen a -> ([a] -> Property) -> StdGen -> Int -> Int -> [[String]] -> IO () testsC' config gen prop = tests config genResult where @@ -381,7 +401,7 @@ coverCheck config prop = do testsC config arbitrary prop [] 0 rnd 0 0 [] -- end snippet --- start snippet testsC +-- start snippet testsC1 testsC :: Show a => Config -> Gen a -> ([a] -> Property) -> [a] -> Int -> StdGen -> Int -> Int -> [[String]] -> IO () testsC config gen prop xs cov rnd0 ntest nfail stamps