fuzzcheck (empty) → 0.1.1
raw patch · 6 files changed
+331/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, fuzzcheck, hspec, hspec-expectations, lifted-base, monad-control, random, transformers
Files
- LICENSE +20/−0
- README.md +115/−0
- Setup.hs +2/−0
- Test/FuzzCheck.hs +102/−0
- fuzzcheck.cabal +44/−0
- tests/Smoke.hs +48/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 FP Complete++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,115 @@+# FuzzCheck++FuzzCheck is a library much like QuickCheck, except that instead of test the+properties of pure functions, it tests the behavior of applicative or monadic+code.++For example, with QuickCheck you would check a property of a function as+follows:++ prop_reverse xs = xs == reverse (reverse xs)+ + >>> quickCheck prop_reverse++This would generate a list of random length and contents, and ensure that the+stated property is maintained for each instance.++FuzzCheck is for testing monadic (or applicative) code, which may only be+testable in the context of other operations. For example, let's test some+simple FFI code:++ prop_bs_ffi = do+ mem <- "allocate buffer" ?> pure malloc+ n <- "pick a number" ?> return <$> gen (choose (40::Int,100))+ "poke" ?> poke <$> arg mem <*> arg n+ x <- "peek at memory" ?> peek <$> arg mem+ "make sure it matches" ?> (@?=) <$> arg x <*> arg n+ "free the buffer" ?> free <$> arg mem++## FuzzCheck interface++There are just three special details introduced by FuzzCheck, the `?>`+operator, and the `arg`, `rand` and `gen` combinators.++ "label" ?> action+ +This runs a `Fuzz` action. If an exception occurs, the label is printed+along with the exception.++ let x = "Hello"+ "label" ?> f <$> arg x+ +This executes a *monadic* function `f`, passing it the argument `x`. This is+equivalent to using `f x` in the surrounding monad, except that if an+exception is generated, the error report looks like this:++ f "Hello": <text of actual exception here>++You may also use `rand`, which is just a shorter synonym for QuickCheck's+`arbitrary`, for generating a type-appropriate random value automatically:++ "label" ?> f <$> rand++Another option is to use `gen`, which takes for its argument any combinator+from QuickCheck that generates an appropriately typed `Gen` value. For+example:++ "label" ?> f <$> gen (choose (1,10))+ +This tests `f` by passing it a randomly chosen integer from the given range.+If an exception occurs, the actual integer that caused the problem is shown:++ f 9: <text of actual exception here>+ +That's it. To run the test, call `fuzzCheck` on the property:++ >>> fuzzCheck prop_bs_ffi2+ +++ OK, passed 100 tests.+ +You can use `fuzzCheck'` if you want to change the number of tests executed,+or if you want to associate cleanup code with the test after it runs, whether+or not it succeeds.++## Simplifying tests++The role of `?>` is to assign a label to each operation (to assist with error+reporting in case of failure), and to execute the `Fuzz` action in its+enclosing Monad. A fuzz test may occur within any monad supporting `MonadIO`+and `MonadBaseControl IO` (for the purpose of catching exceptions), which+means that if we're testing code in IO, we can limit the use of `?>` to only+those cases we expect might fail:++ prop_bs_ffi2 = do+ mem <- malloc+ n <- "pick a number" ?> return <$> gen (choose (40::Int,100))+ "poke" ?> poke <$> arg mem <*> arg n+ x <- "peek at memory" ?> peek <$> arg mem+ x @?= n+ free mem++**NOTE**: Using `gen` does not mean that that specific function is invoked 100+times at that point in the monadic block. Instead, the entire block passed to+`fuzzCheck` is executed 100 times, with each occurence of `gen` producing a+new value at each run.++## Integration with Hspec and HUnit++This all integrates quite nicely with Hspec and Hunit. For example, this is+from the smoke tests for this library:++ hspec $ it "works with an FFI example" $ fuzzCheck $ do+ mem <- malloc+ n <- "pick a number" ?> return <$> gen (choose (40::Int,100))+ "poke" ?> poke <$> arg mem <*> arg n+ x <- "peek at memory" ?> peek <$> arg mem+ x @?= n+ free mem++## See also++Although this library was written before I had found+[this paper](http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.118.9528)+and `Test.QuickCheck.Monadic`, the results are somewhat similar (the paper+uses `name` instead of `?>`, while `arg` is the same).++
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Test/FuzzCheck.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- | Please see the README at:+--+-- https://github.com/jwiegley/fuzzcheck/blob/master/README.md++module Test.FuzzCheck+ ( Fuzz(..)+ , FuzzException(..)+ , arg+ , gen+ , rand+ , branch+ , jumble+ , (?>)+ , fuzzCheck'+ , fuzzCheck+ ) where++import Control.Applicative+import Control.Exception.Lifted+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Control+import Data.Functor.Compose+import Data.Functor.Identity+import Data.Functor.Product+import Data.List+import Data.Typeable+import Prelude hiding (ioError)+import Test.QuickCheck+import Test.QuickCheck.Gen (Gen(..))+import Test.QuickCheck.Random++newtype Fuzz a = Fuzz (Compose Gen (Product (Const [String]) Identity) a)+ deriving Functor++instance Applicative Fuzz where+ pure x = Fuzz (Compose (pure (Pair (Const ["<arg>"]) (Identity x))))+ Fuzz f <*> Fuzz x = Fuzz (f <*> x)++data FuzzException = FuzzException String deriving (Eq, Show, Typeable)+instance Exception FuzzException++wrap :: Show a => a -> Product (Const [String]) Identity a+wrap x = Pair (Const [show x]) (Identity x)++arg :: Show a => a -> Fuzz a+arg = Fuzz . Compose . pure . wrap++gen :: Show a => Gen a -> Fuzz a+gen (MkGen m) = Fuzz (Compose (MkGen g))+ where g r n = let x = m r n in wrap x++rand :: (Arbitrary a, Show a) => Fuzz a+rand = gen arbitrary++branch :: (MonadIO m, MonadBaseControl IO m) => [m a] -> m a+branch xs = do+ let len = length xs+ n <- "pick a random number"+ ?> return <$> gen (choose (0,len-1) :: Gen Int)+ xs !! n++jumble :: (MonadIO m, MonadBaseControl IO m) => [m a] -> m [a]+jumble xs = do+ let len = length xs+ xs' <- sequence xs+ foldM (\acc _x -> do+ n <- "pick a random number"+ ?> return <$> gen (choose (1,len-1) :: Gen Int)+ let (y:ys, z:zs) = splitAt n acc+ return $ (z:ys) ++ (y:zs)) xs' xs'++infixr 1 ?>+(?>) :: (MonadIO m, MonadBaseControl IO m)+ => String -> Fuzz (m a) -> m a+lbl ?> Fuzz (Compose (MkGen g)) = do+ rnd <- liftIO newQCGen+ let Pair (Const args) (Identity x) = g rnd 100+ runFuzz args x+ where+ runFuzz :: (MonadIO m, MonadBaseControl IO m)+ => [String] -> m a -> m a+ runFuzz args m = m `catch` report+ where report e = throwIO (FuzzException $+ lbl ++ " " ++ unwords (map show args)+ ++ ": " ++ show (e :: SomeException))++fuzzCheck' :: (MonadIO m, MonadBaseControl IO m)+ => m a -> Int -> m () -> m ()+fuzzCheck' f runs cleanup = replicateM_ runs f `finally` cleanup++fuzzCheck :: (MonadIO m, MonadBaseControl IO m)+ => m a -> m ()+fuzzCheck f = fuzzCheck' f 100 $+ liftIO $ putStrLn "+++ OK, passed 100 tests."
+ fuzzcheck.cabal view
@@ -0,0 +1,44 @@+Name: fuzzcheck+Version: 0.1.1+ +Synopsis: A simple checker for stress testing monadic code+Description: A simple checker for stress testing monadic code+ +Homepage: https://github.com/fpco/fuzzcheck+License: BSD3+License-file: LICENSE+Author: John Wiegley+Maintainer: John Wiegley <johnw@fpcomplete.com>+Category: Testing+Build-type: Simple+Cabal-version: >= 1.10+ +Extra-Source-Files: README.md+ +Source-repository head+ Type: git+ Location: git://github.com/fpco/fuzzcheck.git++test-suite smoke+ Type: exitcode-stdio-1.0+ Main-is: Smoke.hs+ Hs-source-dirs: tests+ Ghc-options: -Wall+ Default-language: Haskell2010+ Build-depends: base+ , hspec+ , hspec-expectations+ , QuickCheck+ , HUnit+ , fuzzcheck++Library+ Ghc-options: -Wall+ Default-language: Haskell2010+ Exposed-modules: Test.FuzzCheck+ Build-depends: base >= 4.3 && < 5+ , monad-control+ , lifted-base+ , transformers+ , random+ , QuickCheck
+ tests/Smoke.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Control.Applicative+import Test.FuzzCheck+import Test.Hspec+import Test.HUnit+import Test.QuickCheck++import Foreign.Marshal.Alloc+import Foreign.Storable++main :: IO ()+main = hspec $ do+ it "works with a passing test" $+ fuzzCheck $ "qc1" ?> myExample <$> gen (choose (1,2))++ it "work with a failing, interdependent test" $+ fuzzCheckFAIL err $ do+ n <- "qc1" ?> myExample <$> gen (choose (3,3))+ "qc2" ?> myExample <$> gen (choose (1,n))++ it "works with an FFI example" $ fuzzCheck $ do+ mem <- malloc+ n <- "pick a number" ?> return <$> gen (choose (40::Int,100))+ "poke" ?> poke <$> arg mem <*> arg n+ x <- "peek at memory" ?> peek <$> arg mem+ x @?= n+ free mem++ it "works with an FFI example using rand" $ fuzzCheck $ do+ mem <- malloc+ n <- "pick a number" ?> return <$> (rand :: Fuzz Int)+ "poke" ?> poke <$> arg mem <*> arg n+ x <- "peek at memory" ?> peek <$> arg mem+ x @?= n+ free mem++ where+ myExample :: Int -> IO Int+ myExample x = if x `mod` 3 == 0+ then ioError (userError "x divisible by three!")+ else return x++ err = "FuzzException \"qc1 \\\"3\\\": user error (x divisible by three!)\""++ fuzzCheckFAIL msg f = f `shouldThrow` \(e :: FuzzException) -> show e == msg