packages feed

smallcheck 0.5 → 0.6

raw patch · 14 files changed

+828/−715 lines, 14 filesdep +dlistdep +ghc-prim

Dependencies added: dlist, ghc-prim

Files

CHANGES.md view
@@ -1,22 +1,25 @@ Changes ======= -Version 0.1+Version 0.6 ----------- -The differences from 0.0 are two fixes (space-fault, output buffering),-an 'unsafe' but sometimes useful Testable (IO a) instance and additional-examples.+* Default Generic implementation of Serial instance (by Bas van Dijk)+* The code is split into modules+* Convert much of README into haddock documentation+* Many small API changes+* Remove impure Testable (IO a) instance -Version 0.2+Version 0.5 ----------- -The 'smallCheck' driver now takes an argument d and runs test series-at depths 0..d without interaction, stopping if any test fails.-The interactive variant is still available as 'smallCheckI'.  All-Prelude numeric types now have Serial instances, including floating-point-types. Serial types Nat and Natural are also defined.  Examples extended.+Make the package build with GHC 7.2. Some cosmetic changes. +Version 0.4+-----------++The module SmallCheck is now Test.SmallCheck.  Packaged with Cabal.+ Version 0.3 ----------- @@ -27,12 +30,18 @@ now Integers, not Ints.  Ord and Eq are now derived for the N types. Examples extended. -Version 0.4+Version 0.2 ----------- -The module SmallCheck is now Test.SmallCheck.  Packaged with Cabal.+The 'smallCheck' driver now takes an argument d and runs test series+at depths 0..d without interaction, stopping if any test fails.+The interactive variant is still available as 'smallCheckI'.  All+Prelude numeric types now have Serial instances, including floating-point+types. Serial types Nat and Natural are also defined.  Examples extended. -Version 0.5+Version 0.1 ----------- -Make the package build with GHC 7.2. Some cosmetic changes.+The differences from 0.0 are two fixes (space-fault, output buffering),+an 'unsafe' but sometimes useful Testable (IO a) instance and additional+examples.
CREDITS.md view
@@ -11,3 +11,10 @@ > the better method for functional coseries, to Neil Mitchell for > automating the derivation of Serial instances, to Matt Naylor for > the circuit-design examples and to Gwern Branwen for Cabal packaging.++Contributors+------------++The following people have contributed to SmallCheck:++* Bas van Dijk (default Generic implementation of Serial instance)
README.md view
@@ -1,257 +1,32 @@-SmallCheck: another lightweight testing library in Haskell-==========================================================--If you are a Haskell programmer and a QuickCheck user do you ever wish-you could:--* write test generators for your own types more easily?-* be sure that any counter-examples found are minimal?-* write properties using existentials as well as universals?-* establish complete coverage of a defined test-space?-* display counter-examples of functional type?-* always repeat tests and obtain the same results?--If so, try SmallCheck! This note should be enough to  get you started,-assuming some prior experience with QuickCheck.--Similarities and Differences-------------------------------In many ways SmallCheck is very similar to QuickCheck.  It uses the-idea of type-based generators for test data, and the way testable-properties are expressed is closely based on the QuickCheck approach. Like-QuickCheck, SmallCheck tests whether properties hold for finite completely-defined values at specific types, and reports counter-examples.--The big difference is that instead of using a sample of randomly generated-values, SmallCheck tests properties for all the finitely many values-up to some depth, progressively increasing the depth used.  For data-values, depth means depth of construction.  For functional values, it-is a measure combining the depth to which arguments may be evaluated-and the depth of possible results.--QuickCheck's statistics-gathering operators have been omitted from-SmallCheck's property language, as they seem more relevant to the-random-testing approach.--Data Generators------------------SmallCheck itself defines data generators for all the data types used-by the Prelude.--Writing SmallCheck generators for application-specific types is-straightforward.  Just as the QuickCheck user defines 'arbitrary'-generators, so a SmallCheck user defines 'series' generators -- but-it is a more straightforward task, using SmallCheck's cons<N> family-of generic combinators where N is constructor arity.  For example:--    data Tree a = Null | Fork Tree a Tree--    instance Serial a => Serial (Tree a) where-      series = cons0 Null \/ cons3 Fork--The default interpretation of depth for datatypes is the depth of nested-construction: constructor functions, including those for newtypes, build-results with depth one greater than their deepest argument.  But this-default can be over-ridden by composing a cons<N> application with an-application of 'depth', like this:--    newtype Light a = Light a--    instance Serial a => Serial (Light a) where-      series = cons1 Light . depth 0--The depth of Light x is just the depth of x.--Function Generators----------------------To generate functions of an application-specific argument type requires a-second method 'coseries' -- cf. 'coarbitrary' in QuickCheck.  Again there-is a standard pattern, this time using the alts<N> combinators where-again N is constructor arity.  Here are Tree and Light instances:--    coseries rs d = [ \t -> case t of-                            Null         -> z-                            Fork t1 x t2 -> f t1 x t2-                    |  z <- alts0 rs d ,-                       f <- alts3 rs d ]--    coseries rs d = [ \l -> case l of-                            Light x -> f x-                    |  f <- (alts1 rs . depth 0) d ]--(NB changed from Version 0.2: 'coseries' and 'alts<N>' family now take a-series argument -- here rs.  In the coseries definitions we simply pass-on rs as series argument in each 'alts<N>' application.)--Automated Derivation of Generators-------------------------------------For small examples, Series instances are easy enough to define by hand,-following the above patterns.  But for programs with many or large data-type definitions, automatic derivation using a tool such as 'derive'-is a better option. For example, the following command-line appends to-Prog.hs the Series instances for all data types defined there.--    $ derive Prog.hs -d Serial --append --Properties-------------SmallCheck's testable properties are closely based on those of QuickCheck-but with the introduction of existential quantifiers.  Suppose we have-defined a function--    isPrefix :: Eq a => [a] -> [a] -> Bool--and wish to specify it by some suitable property.  Using QuickCheck we-might define--    prop_isPrefix1 :: String -> String -> Bool-    prop_isPrefix1 xs ys = isPrefix xs (xs++ys)--where xs and ys are universally quantified.  This property is necessary-but not sufficient for a correct isPrefix.  For example, it is satisfied-by the function that always returns True!  We can test the same property-using SmallCheck.  But we can also test the following property, which-involves an existentially quantified variable:--    prop_isPrefix2 :: String -> String -> Property-    prop_isPrefix2 xs ys = isPrefix xs ys ==>-                             exists $ \xs' -> ys == xs++xs'--The default testing of existentials is bounded by the same depth as their-context, here the depth-bound for xs and ys.  This rule has important-consequences.  Just as a universal property may be satisfied when the-depth bound is shallow but fail when it is deeper, so the reverse may be-true for an existential property.  So when testing properties involving-existentials it may be appropriate to try deeper testing after a shallow-failure. However, sometimes the default same-depth-bound interpretation-of existential properties can make testing of a valid property fail at-all depths.  Here is a contrived but illustrative example:--    prop_append1 :: [Bool] -> [Bool] -> Property-    prop_append1 xs ys = exists $ \zs -> zs == xs++ys--Customised variants of 'exists' are handy in such circumstances.-For example, 'existsDeeperBy' transforms the depth bound by a given-Int->Int function:--    prop_append2 :: [Bool] -> [Bool] -> Property-    prop_append2 xs ys = existsDeeperBy (*2) $ \zs -> zs == xs++ys--There are also quantifiers for unique existence.  Their names include-a 1 immediately after 'exists': eg. exists1, exists1DeeperBy.--Pragmatics of ==>--------------------As in QuickCheck, the ==> operator can be used to express a restricting-condition under which a property should hold.  For example, testing a-propositional-logic module (see examples/logical), we might define:--    prop_tautEval :: Proposition -> Environment -> Property-    prop_tautEval p e =-      tautology p ==> eval p e--But here is an alternative definition:--    prop_tautEval :: Proposition -> Property-    prop_taut p =-      tautology p ==> \e -> eval p e--The first definition generates p and e for each test, whereas the second-only generates e if the tautology p holds.  This difference is not great-in QuickCheck where single random values are generated, but in SmallCheck-the second definition is far better as the test-space is reduced from-P*E to T'+T*E where P, T, T' and E are the numbers of propositions,-tautologies, non-tautologies and environments.--Testing----------Just as QuickCheck has a top-level function 'quickCheck' so SmallCheck-has 'smallCheck d'.--    smallCheck  :: Testable a => Int -> a -> IO ()--It runs series of tests using depth bounds 0..d, stopping if any test-fails, and prints a summary report or a counter-example. The variant:--    smallCheckI :: Testable a =>        a -> IO ()- -is interactive. Instead of requiring a maximum-depth argument, it invites-the user to decide whether to do deeper tests and whether to continue-after a failure.  The interface is low-tech: y<return> (or just <return>)-means "yes", anything else means "no".  For example:--    haskell> smallCheckI prop_append1-    Depth 0:-      Completed 1 test(s) without failure.-      Deeper? y-    Depth 1:-      Failed test no. 5. Test values follow.-      [True]-      [True]-      Continue? n-      Deeper? n-    haskell>--Having methods to generate series of all (depth-bounded) values of-an argument type, SmallCheck can give at least partial information-about the extension of a function.  For example, if we test the-property--    prop_assoc op =-      \x y z -> (x `op` y) `op` z == x `op` (y `op` z)-      where-      typeInfo = op :: Bool -> Bool -> Bool--the result is shown as follows.--    haskell> smallCheckI prop_assoc-    Depth 0:-      Failed test no. 22. Test values follow.-      {True->{True->True;False->True};False->{True->False;False->True}}-      False-      True-      False--When (unique) existential properties are tested, any failure reports-conclude with "non-existence" (or "non-uniqueness" followed by two-witnesses).--Large Test Spaces------------------+SmallCheck: a property-based testing library for Haskell+======================================================== -Using the standard generic scheme to define series of test value, it-often turns out that at some small depth d the 10,000-100,000 tests-are quickly checked, but at depth d+1 it is infeasible to complete-the billions of tests.  There are ways to reduce some dimensions of-the search space so that other dimensions can be tested more deeply:-for example, cut the scope of quantifiers to a small fixed domain-(forAllElem, thereExistsElem), use newtypes to define restricted series-for some data types (see the 'examples' directory) or assign depth >1-to some constructors.+SmallCheck is a testing library that allows to verify properties for all test+cases up to some depth. The test cases are generated automatically by+SmallCheck. -Function spaces grow exponentially in relation to their result and-argument spaces.  Even with a depth bound, testing all functional-arguments is a challenge.  Keep base-types as small as possible.-For example, try testing higher-order polymorphic functions over their-() or Bool instances.+Usefulness of such an approach to testing is based on the following observation: -Final Notes------------+> If a program fails to meet its specification in some cases, it almost always+> fails in some simple case. -The name is intended to acknowledge QuickCheck, not to suggest that-SmallCheck replaces it.  See also Lazy SmallCheck.  Each tool has its-advantages and disadvantages when compared with the others.+To get started with SmallCheck: -SmallCheck is a Haskell 98 package (aside from using unsafePerformIO to test IO-computations). It can be [obtained][hackage] from hackage.+* Read the [documentation][haddock]+* Look at some [examples][examples]+* If you have experience with QuickCheck, [read the comparison of QuickCheck and SmallCheck][comparison]+* Install it and give it a try!  +  `cabal update; cabal install smallcheck`+* Read the [paper][paper] or [other materials][oldpage] from the original+  authors of SmallCheck (note that that information might be somewhat outdated)+* If you see something that can be improved, please [submit an issue][issues]+* Check out [the source code][github] at GitHub +[haddock]: http://hackage.haskell.org/packages/archive/smallcheck/latest/doc/html/Test-SmallCheck.html [hackage]: http://hackage.haskell.org/package/smallcheck--Comments and suggestions are welcome.+[examples]: https://github.com/feuerbach/smallcheck/tree/master/examples+[paper]: http://www.cs.york.ac.uk/fp/smallcheck/smallcheck.pdf+[oldpage]: http://www.cs.york.ac.uk/fp/smallcheck/+[comparison]: https://github.com/feuerbach/smallcheck/wiki/Comparison-with-QuickCheck+[github]: https://github.com/feuerbach/smallcheck+[issues]: https://github.com/feuerbach/smallcheck/issues
Test/SmallCheck.hs view
@@ -1,432 +1,72 @@------------------------------------------------------------------------- SmallCheck: another lightweight testing library.--- Colin Runciman, August 2006--- Version 0.4, 23 May 2008+--------------------------------------------------------------------+-- |+-- Module    : Test.SmallCheck+-- Copyright : (c) Colin Runciman et al.+-- License   : BSD3+-- Maintainer: Roman Cheplyaka <roma@ro-che.info> ----- After QuickCheck, by Koen Claessen and John Hughes (2000-2004).-----------------------------------------------------------------------+-- This module exports the main pieces of SmallCheck functionality.+--+-- For pointers to other sources of information about SmallCheck, please refer+-- to the README at+-- <https://github.com/feuerbach/smallcheck/blob/master/README.md>+-------------------------------------------------------------------- module Test.SmallCheck (-  smallCheck, smallCheckI, depthCheck, test,-  Property, Testable,-  forAll, forAllElem,-  exists, existsDeeperBy, thereExists, thereExistsElem,-  exists1, exists1DeeperBy, thereExists1, thereExists1Elem,-  (==>),-  Series, Serial(..),-  (\/), (><), two, three, four,-  cons0, cons1, cons2, cons3, cons4,-  alts0, alts1, alts2, alts3, alts4,-  N(..), Nat, Natural,-  depth, inc, dec-  ) where--import Data.List (intersperse)-import Control.Monad (when)-import System.IO (stdout, hFlush)-import System.IO.Unsafe (unsafePerformIO)  -- used only for Testable (IO a)-------------------- <Series of depth-bounded values> --------------------- Series arguments should be interpreted as a depth bound (>=0)--- Series results should have finite length--type Series a = Int -> [a]---- sum-infixr 7 \/-(\/) :: Series a -> Series a -> Series a-s1 \/ s2 = \d -> s1 d ++ s2 d---- product-infixr 8 ><-(><) :: Series a -> Series b -> Series (a,b)-s1 >< s2 = \d -> [(x,y) | x <- s1 d, y <- s2 d]--------------------- <methods for type enumeration> ---------------------- enumerated data values should be finite and fully defined--- enumerated functional values should be total and strict---- bounds:--- for data values, the depth of nested constructor applications--- for functional values, both the depth of nested case analysis--- and the depth of results- -class Serial a where-  series   :: Series a-  coseries :: Series b -> Series (a->b)--instance Serial () where-  series      _ = [()]-  coseries rs d = [ \() -> b-                  | b <- rs d ]--instance Serial Int where-  series      d = [(-d)..d]-  coseries rs d = [ \i -> if i > 0 then f (N (i - 1))-                          else if i < 0 then g (N (abs i - 1))-                          else z-                  | z <- alts0 rs d, f <- alts1 rs d, g <- alts1 rs d ]--instance Serial Integer where-  series      d = [ toInteger (i :: Int)-                  | i <- series d ]-  coseries rs d = [ f . (fromInteger :: Integer->Int)-                  | f <- coseries rs d ]--newtype N a = N a-              deriving (Eq, Ord)--instance Show a => Show (N a) where-  show (N i) = show i--instance (Integral a, Serial a) => Serial (N a) where-  series      d = map N [0..d']-                  where-                  d' = fromInteger (toInteger d)-  coseries rs d = [ \(N i) -> if i > 0 then f (N (i - 1))-                              else z-                  | z <- alts0 rs d, f <- alts1 rs d ]--type Nat = N Int-type Natural = N Integer--instance Serial Float where-  series     d = [ encodeFloat sig exp-                 | (sig,exp) <- series d,-                   odd sig || sig==0 && exp==0 ]-  coseries rs d = [ f . decodeFloat-                  | f <- coseries rs d ]-             -instance Serial Double where-  series      d = [ frac (x :: Float)-                  | x <- series d ]-  coseries rs d = [ f . (frac :: Double->Float)-                  | f <- coseries rs d ]--frac :: (Real a, Fractional a, Real b, Fractional b) => a -> b-frac = fromRational . toRational--instance Serial Char where-  series      d = take (d+1) ['a'..'z']-  coseries rs d = [ \c -> f (N (fromEnum c - fromEnum 'a'))-                  | f <- coseries rs d ]--instance (Serial a, Serial b) =>-         Serial (a,b) where-  series      = series >< series-  coseries rs = map uncurry . (coseries $ coseries rs)--instance (Serial a, Serial b, Serial c) =>-         Serial (a,b,c) where-  series      = \d -> [(a,b,c) | (a,(b,c)) <- series d]-  coseries rs = map uncurry3 . (coseries $ coseries $ coseries rs)--instance (Serial a, Serial b, Serial c, Serial d) =>-         Serial (a,b,c,d) where-  series      = \d -> [(a,b,c,d) | (a,(b,(c,d))) <- series d]-  coseries rs = map uncurry4 . (coseries $ coseries $ coseries $ coseries rs)--uncurry3 :: (a->b->c->d) -> ((a,b,c)->d)-uncurry3 f (x,y,z) = f x y z--uncurry4 :: (a->b->c->d->e) -> ((a,b,c,d)->e)-uncurry4 f (w,x,y,z) = f w x y z--two   :: Series a -> Series (a,a)-two   s = s >< s--three :: Series a -> Series (a,a,a)-three s = \d -> [(x,y,z) | (x,(y,z)) <- (s >< s >< s) d]--four  :: Series a -> Series (a,a,a,a)-four  s = \d -> [(w,x,y,z) | (w,(x,(y,z))) <- (s >< s >< s >< s) d]--cons0 :: -         a -> Series a-cons0 c _ = [c]--cons1 :: Serial a =>-         (a->b) -> Series b-cons1 c d = [c z | d > 0, z <- series (d-1)]--cons2 :: (Serial a, Serial b) =>-         (a->b->c) -> Series c-cons2 c d = [c y z | d > 0, (y,z) <- series (d-1)]--cons3 :: (Serial a, Serial b, Serial c) =>-         (a->b->c->d) -> Series d-cons3 c d = [c x y z | d > 0, (x,y,z) <- series (d-1)]--cons4 :: (Serial a, Serial b, Serial c, Serial d) =>-         (a->b->c->d->e) -> Series e-cons4 c d = [c w x y z | d > 0, (w,x,y,z) <- series (d-1)]--alts0 ::  Series a ->-            Series a-alts0 as d = as d--alts1 ::  Serial a =>-            Series b -> Series (a->b)-alts1 bs d = if d > 0 then coseries bs (dec d)-             else [\_ -> x | x <- bs d]--alts2 ::  (Serial a, Serial b) =>-            Series c -> Series (a->b->c)-alts2 cs d = if d > 0 then coseries (coseries cs) (dec d)-             else [\_ _ -> x | x <- cs d]--alts3 ::  (Serial a, Serial b, Serial c) =>-            Series d -> Series (a->b->c->d)-alts3 ds d = if d > 0 then coseries (coseries (coseries ds)) (dec d)-             else [\_ _ _ -> x | x <- ds d]--alts4 ::  (Serial a, Serial b, Serial c, Serial d) =>-            Series e -> Series (a->b->c->d->e)-alts4 es d = if d > 0 then coseries (coseries (coseries (coseries es))) (dec d)-             else [\_ _ _ _ -> x | x <- es d]--instance Serial Bool where-  series        = cons0 True \/ cons0 False-  coseries rs d = [ \x -> if x then r1 else r2-                  | r1 <- rs d, r2 <- rs d ]--instance Serial a => Serial (Maybe a) where-  series        = cons0 Nothing \/ cons1 Just-  coseries rs d = [ \m -> case m of-                       Nothing -> z-                       Just x  -> f x-                  |  z <- alts0 rs d ,-                     f <- alts1 rs d ]--instance (Serial a, Serial b) => Serial (Either a b) where-  series        = cons1 Left \/ cons1 Right-  coseries rs d = [ \e -> case e of-                          Left x  -> f x-                          Right y -> g y-                  |  f <- alts1 rs d ,-                     g <- alts1 rs d ]--instance Serial a => Serial [a] where-  series        = cons0 [] \/ cons2 (:)-  coseries rs d = [ \xs -> case xs of-                           []      -> y-                           (x:xs') -> f x xs'-                  |   y <- alts0 rs d ,-                      f <- alts2 rs d ]---- Thanks to Ralf Hinze for the definition of coseries--- using the nest auxiliary.--instance (Serial a, Serial b) => Serial (a->b) where-  series = coseries series-  coseries rs d = -    [ \ f -> g [ f a | a <- args ] -    | g <- nest args d ]-    where-    args = series d-    nest []     _ = [ \[] -> c-                    | c <- rs d ]-    nest (a:as) _ = [ \(b:bs) -> f b bs-                    | f <- coseries (nest as) d ]---- For customising the depth measure.  Use with care!--depth :: Int -> Int -> Int-depth d d' | d >= 0    = d'+1-d-           | otherwise = error "SmallCheck.depth: argument < 0"--dec :: Int -> Int-dec d | d > 0     = d-1-      | otherwise = error "SmallCheck.dec: argument <= 0"--inc :: Int -> Int-inc d = d+1---- show the extension of a function (in part, bounded both by--- the number and depth of arguments)-instance (Serial a, Show a, Show b) => Show (a->b) where-  show f = -    if maxarheight == 1-    && sumarwidth + length ars * length "->;" < widthLimit then-      "{"++(-      concat $ intersperse ";" $ [a++"->"++r | (a,r) <- ars]-      )++"}"-    else-      concat $ [a++"->\n"++indent r | (a,r) <- ars]-    where-    ars = take lengthLimit [ (show x, show (f x))-                           | x <- series depthLimit ]-    maxarheight = maximum  [ max (height a) (height r)-                           | (a,r) <- ars ]-    sumarwidth = sum       [ length a + length r -                           | (a,r) <- ars]-    indent = unlines . map ("  "++) . lines-    height = length . lines-    (widthLimit,lengthLimit,depthLimit) = (80,20,3)::(Int,Int,Int)------------------ <properties and their evaluation> ---------------------- adapted from QuickCheck originals: here results come in lists,--- properties have depth arguments, stamps (for classifying random--- tests) are omitted, existentials are introduced--newtype PR = Prop [Result]--data Result = Result {ok :: Maybe Bool, arguments :: [String]}--nothing :: Result-nothing = Result {ok = Nothing, arguments = []}--result :: Result -> PR-result res = Prop [res]--newtype Property = Property (Int -> PR)--class Testable a where-  property :: a -> Int -> PR--instance Testable Bool where-  property b _ = Prop [Result (Just b) []]--instance Testable PR where-  property prop _ = prop--instance (Serial a, Show a, Testable b) => Testable (a->b) where-  property f = f' where Property f' = forAll series f--instance Testable Property where-  property (Property f) d = f d---- For testing properties involving IO.  Unsafe, so use with care!-instance Testable a => Testable (IO a) where-  property = property . unsafePerformIO--evaluate :: Testable a => a -> Series Result-evaluate x d = rs where Prop rs = property x d--forAll :: (Show a, Testable b) => Series a -> (a->b) -> Property-forAll xs f = Property $ \d -> Prop $-  [ r{arguments = show x : arguments r}-  | x <- xs d, r <- evaluate (f x) d ]--forAllElem :: (Show a, Testable b) => [a] -> (a->b) -> Property-forAllElem xs = forAll (const xs)--existence :: (Show a, Testable b) => Bool -> Series a -> (a->b) -> Property-existence u xs f = Property existenceDepth-  where-  existenceDepth d = Prop [ Result (Just valid) arguments ]-    where-    witnesses = [ show x | x <- xs d, all pass (evaluate (f x) d) ]-    valid     = enough witnesses-    enough    = if u then unique else (not . null)-    arguments = if valid then []-                else if null witnesses then ["non-existence"]-                else "non-uniqueness" : take 2 witnesses--unique :: [a] -> Bool-unique [_] = True-unique  _  = False--pass :: Result -> Bool-pass (Result Nothing _)  = True-pass (Result (Just b) _) = b--thereExists :: (Show a, Testable b) => Series a -> (a->b) -> Property-thereExists = existence False--thereExists1 :: (Show a, Testable b) => Series a -> (a->b) -> Property-thereExists1 = existence True--thereExistsElem :: (Show a, Testable b) => [a] -> (a->b) -> Property-thereExistsElem xs = thereExists (const xs)--thereExists1Elem :: (Show a, Testable b) => [a] -> (a->b) -> Property-thereExists1Elem xs = thereExists1 (const xs)--exists :: (Show a, Serial a, Testable b) => (a->b) -> Property-exists = thereExists series--exists1 :: (Show a, Serial a, Testable b) => (a->b) -> Property-exists1 = thereExists1 series--existsDeeperBy :: (Show a, Serial a, Testable b) => (Int->Int) -> (a->b) -> Property-existsDeeperBy f = thereExists (series . f)--exists1DeeperBy :: (Show a, Serial a, Testable b) => (Int->Int) -> (a->b) -> Property-exists1DeeperBy f = thereExists1 (series . f)- -infixr 0 ==>--(==>) :: Testable a => Bool -> a -> Property-True ==>  x = Property (property x)-False ==> x = Property (const (result nothing))----------------------- <top-level test drivers> -------------------------- similar in spirit to QuickCheck but with iterative deepening+  -- * Constructing tests -test :: Testable a => a -> IO ()-test = smallCheckI+  -- | The simplest kind of test is a function (possibly of many+  -- arguments) returning 'Bool'.+  --+  -- In addition, you can use the combinators shown below. For more+  -- advanced combinators, see "Test.SmallCheck.Property". --- test for values of depths 0..d stopping when a property--- fails or when it has been checked for all these values-smallCheck :: Testable a => Int -> a -> IO ()-smallCheck d = iterCheck 0 (Just d)+  Testable,+  Property,+  property, --- interactive variant, asking the user whether testing should--- continue/go deeper after a failure/completed iteration-smallCheckI :: Testable a => a -> IO ()-smallCheckI = iterCheck 0 Nothing+  -- ** Existential quantification -depthCheck :: Testable a => Int -> a -> IO ()-depthCheck d = iterCheck d (Just d)+  -- | Suppose we have defined a function+  --+  -- >isPrefix :: Eq a => [a] -> [a] -> Bool+  --+  -- and wish to specify it by some suitable property. We might define+  --+  -- >prop_isPrefix1 :: String -> String -> Bool+  -- >prop_isPrefix1 xs ys = isPrefix xs (xs++ys)+  --+  -- where @xs@ and @ys@ are universally quantified. This property is necessary+  -- but not sufficient for a correct @isPrefix@. For example, it is satisfied+  -- by the function that always returns @True@!+  --+  -- We can also test the following property, which involves an existentially+  -- quantified variable:+  --+  -- >prop_isPrefix2 :: String -> String -> Property+  -- >prop_isPrefix2 xs ys = isPrefix xs ys ==> exists $ \xs' -> ys == xs++xs' -iterCheck :: Testable a => Int -> Maybe Int -> a -> IO ()-iterCheck dFrom mdTo t = iter dFrom-  where-  iter d = do-    putStrLn ("Depth "++show d++":")-    let Prop results = property t d-    ok <- check (mdTo==Nothing) 0 0 True results-    maybe (whenUserWishes "  Deeper" () $ iter (d+1))-          (\dTo -> when (ok && d < dTo) $ iter (d+1))-          mdTo+  exists,+  exists1,+  existsDeeperBy,+  exists1DeeperBy, -check :: Bool -> Integer -> Integer -> Bool -> [Result] -> IO Bool-check i n x ok rs | null rs = do-  putStr ("  Completed "++show n++" test(s)")-  putStrLn (if ok then " without failure." else ".")-  when (x > 0) $-    putStrLn ("  But "++show x++" did not meet ==> condition.")-  return ok-check i n x ok (Result Nothing _ : rs) = do-  progressReport i n x-  check i (n+1) (x+1) ok rs-check i n x f (Result (Just True) _ : rs) = do-  progressReport i n x-  check i (n+1) x f rs-check i n x f (Result (Just False) args : rs) = do-  putStrLn ("  Failed test no. "++show (n+1)++". Test values follow.")-  mapM_ (putStrLn . ("  "++)) args-  ( if i then-      whenUserWishes "  Continue" False $ check i (n+1) x False rs-    else-      return False )+  -- ** Conditioning+  (==>), -whenUserWishes :: String -> a -> IO a -> IO a-whenUserWishes wish x action = do-  putStr (wish++"? ")-  hFlush stdout-  reply <- getLine-  ( if (null reply || reply=="y") then action-    else return x )+  -- * Running tests+  -- | The functions below can be used to run SmallCheck tests.+  --+  -- As an alternative, consider using @test-framework@ package.+  --+  -- It allows to organize SmallCheck properties into a test suite (possibly+  -- together with HUnit or QuickCheck tests), apply timeouts, get nice+  -- statistics etc.+  --+  -- To use SmallCheck properties with test-framework, install+  -- @test-framework-smallcheck@ package.+  smallCheck, depthCheck, smallCheckI,+  Depth+  ) where -progressReport :: Bool -> Integer -> Integer -> IO ()-progressReport i n x | n >= x = do-  when i $ ( putStr (n' ++ replicate (length n') '\b') >>-             hFlush stdout )-  where-  n' = show n+import Test.SmallCheck.Property+import Test.SmallCheck.Drivers
+ Test/SmallCheck/Drivers.hs view
@@ -0,0 +1,91 @@+--------------------------------------------------------------------+-- |+-- Module    : Test.SmallCheck.Drivers+-- Copyright : (c) Colin Runciman et al.+-- License   : BSD3+-- Maintainer: Roman Cheplyaka <roma@ro-che.info>+--+-- Functions to run SmallCheck tests.+--------------------------------------------------------------------+module Test.SmallCheck.Drivers (+  smallCheck, smallCheckI, depthCheck+  ) where++import System.IO (stdout, hFlush)+import Control.Monad (when)+import Test.SmallCheck.Property++-- | Run series of tests using depth bounds 0..d, stopping if any test fails,+-- and print a summary report or a counter-example.+smallCheck :: Testable a => Depth -> a -> IO ()+smallCheck d = iterCheck 0 (Just d)++-- | Same as 'smallCheck', but test for values of depth d only+depthCheck :: Testable a => Depth -> a -> IO ()+depthCheck d = iterCheck d (Just d)++-- | Interactive variant, asking the user whether testing should+-- continue\/go deeper after a failure\/completed iteration.+--+-- Example session:+--+-- >haskell> smallCheckI prop_append1+-- >Depth 0:+-- >  Completed 1 test(s) without failure.+-- >  Deeper? y+-- >Depth 1:+-- >  Failed test no. 5. Test values follow.+-- >  [True]+-- >  [True]+-- >  Continue? n+-- >  Deeper? n+-- >haskell>+smallCheckI :: Testable a => a -> IO ()+smallCheckI = iterCheck 0 Nothing++iterCheck :: Testable a => Depth -> Maybe Depth -> a -> IO ()+iterCheck dFrom mdTo t = iter dFrom+  where+  iter d = do+    putStrLn ("Depth "++show d++":")+    let results = test t d+    ok <- check (mdTo==Nothing) 0 0 True results+    maybe (whenUserWishes "  Deeper" () $ iter (d+1))+          (\dTo -> when (ok && d < dTo) $ iter (d+1))+          mdTo++check :: Bool -> Integer -> Integer -> Bool -> [TestCase] -> IO Bool+check i n x ok rs | null rs = do+  putStr ("  Completed "++show n++" test(s)")+  putStrLn (if ok then " without failure." else ".")+  when (x > 0) $+    putStrLn ("  But "++show x++" did not meet ==> condition.")+  return ok+check i n x ok (TestCase Inappropriate _ : rs) = do+  progressReport i n x+  check i (n+1) (x+1) ok rs+check i n x f (TestCase Pass _ : rs) = do+  progressReport i n x+  check i (n+1) x f rs+check i n x f (TestCase Fail args : rs) = do+  putStrLn ("  Failed test no. "++show (n+1)++". Test values follow.")+  mapM_ (putStrLn . ("  "++)) args+  ( if i then+      whenUserWishes "  Continue" False $ check i (n+1) x False rs+    else+      return False )++whenUserWishes :: String -> a -> IO a -> IO a+whenUserWishes wish x action = do+  putStr (wish++"? ")+  hFlush stdout+  reply <- getLine+  ( if (null reply || reply=="y") then action+    else return x )++progressReport :: Bool -> Integer -> Integer -> IO ()+progressReport i n x | n >= x = do+  when i $ ( putStr (n' ++ replicate (length n') '\b') >>+             hFlush stdout )+  where+  n' = show n
+ Test/SmallCheck/Property.hs view
@@ -0,0 +1,176 @@+--------------------------------------------------------------------+-- |+-- Module    : Test.SmallCheck.Property+-- Copyright : (c) Colin Runciman et al.+-- License   : BSD3+-- Maintainer: Roman Cheplyaka <roma@ro-che.info>+--+-- Properties and tools to construct them.+--------------------------------------------------------------------+module Test.SmallCheck.Property (+  -- * Basic definitions+  TestCase(..),+  TestResult(..),+  resultIsOk,++  Property, Depth, Testable(..),+  property, mkProperty,++  -- * Constructing tests+  (==>), exists, existsDeeperBy, exists1, exists1DeeperBy,+  -- ** Series- and list-based constructors+  -- | Combinators below can be used to explicitly specify the domain of+  -- quantification (as 'Series' or lists).+  --+  -- Hopefully, their meaning is evident from their names and types.+  forAll, forAllElem,+  thereExists, thereExistsElem,+  thereExists1, thereExists1Elem+  ) where++import Test.SmallCheck.Series++data TestResult+    = Pass+    | Fail+    | Inappropriate+        -- ^ 'Inappropriate' means that the precondition of '==>'+        -- was not satisfied+data TestCase = TestCase { result :: TestResult, arguments :: [String] }++-- | Wrapper type for 'Testable's+newtype Property = Property (Depth -> [TestCase])++-- | Wrap a 'Testable' into a 'Property'+property :: Testable a => a -> Property+property = Property . test++-- | A lower-level way to create properties. Use 'property' if possible.+--+-- The argument is a function that produces the list of results given the depth+-- of testing.+mkProperty :: (Depth -> [TestCase]) -> Property+mkProperty = Property++-- | Anything of a 'Testable' type can be regarded as a \"test\"+class Testable a where+  test :: a -> Depth -> [TestCase]++instance Testable Bool where+  test b _ = [TestCase (boolToResult b) []]++instance (Serial a, Show a, Testable b) => Testable (a->b) where+  test f = f' where Property f' = forAll series f++instance Testable Property where+  test (Property f) d = f d++forAll :: (Show a, Testable b) => Series a -> (a->b) -> Property+forAll xs f = Property $ \d ->+  [ r{arguments = show x : arguments r}+  | x <- xs d, r <- test (f x) d ]++forAllElem :: (Show a, Testable b) => [a] -> (a->b) -> Property+forAllElem xs = forAll (const xs)++existence :: (Show a, Testable b) => Bool -> Series a -> (a->b) -> Property+existence u xs f = Property existenceDepth+  where+  existenceDepth d = [ TestCase (boolToResult valid) arguments ]+    where+    witnesses = [ show x | x <- xs d, all (resultIsOk . result) (test (f x) d) ]+    valid     = enough witnesses+    enough    = if u then unique else (not . null)+    arguments = if valid then []+                else if null witnesses then ["non-existence"]+                else "non-uniqueness" : take 2 witnesses++unique :: [a] -> Bool+unique [_] = True+unique  _  = False++-- | Return 'False' iff the result is 'Fail'+resultIsOk :: TestResult -> Bool+resultIsOk r =+    case r of+        Fail -> False+        Pass -> True+        Inappropriate -> True++boolToResult :: Bool -> TestResult+boolToResult b = if b then Pass else Fail++thereExists :: (Show a, Testable b) => Series a -> (a->b) -> Property+thereExists = existence False++thereExists1 :: (Show a, Testable b) => Series a -> (a->b) -> Property+thereExists1 = existence True++thereExistsElem :: (Show a, Testable b) => [a] -> (a->b) -> Property+thereExistsElem xs = thereExists (const xs)++thereExists1Elem :: (Show a, Testable b) => [a] -> (a->b) -> Property+thereExists1Elem xs = thereExists1 (const xs)++-- | @'exists' p@ holds iff it is possible to find an argument @a@ (within the+-- depth constraints!) satisfying the predicate @p@+exists :: (Show a, Serial a, Testable b) => (a->b) -> Property+exists = thereExists series++-- | Like 'exists', but additionally require the uniqueness of the+-- argument satisfying the predicate+exists1 :: (Show a, Serial a, Testable b) => (a->b) -> Property+exists1 = thereExists1 series++-- | The default testing of existentials is bounded by the same depth as their+-- context. This rule has important consequences. Just as a universal property+-- may be satisfied when the depth bound is shallow but fail when it is deeper,+-- so the reverse may be true for an existential property. So when testing+-- properties involving existentials it may be appropriate to try deeper testing+-- after a shallow failure. However, sometimes the default same-depth-bound+-- interpretation of existential properties can make testing of a valid property+-- fail at all depths. Here is a contrived but illustrative example:+--+-- >prop_append1 :: [Bool] -> [Bool] -> Property+-- >prop_append1 xs ys = exists $ \zs -> zs == xs++ys+--+-- 'existsDeeperBy' transforms the depth bound by a given @'Depth' -> 'Depth'@ function:+--+-- >prop_append2 :: [Bool] -> [Bool] -> Property+-- >prop_append2 xs ys = existsDeeperBy (*2) $ \zs -> zs == xs++ys+existsDeeperBy :: (Show a, Serial a, Testable b) => (Depth->Depth) -> (a->b) -> Property+existsDeeperBy f = thereExists (series . f)++-- | Like 'existsDeeperBy', but additionally require the uniqueness of the+-- argument satisfying the predicate+exists1DeeperBy :: (Show a, Serial a, Testable b) => (Depth->Depth) -> (a->b) -> Property+exists1DeeperBy f = thereExists1 (series . f)++infixr 0 ==>++-- | The '==>' operator can be used to express a+-- restricting condition under which a property should hold. For example,+-- testing a propositional-logic module (see examples/logical), we might+-- define:+--+-- >prop_tautEval :: Proposition -> Environment -> Property+-- >prop_tautEval p e =+-- >  tautology p ==> eval p e+--+-- But here is an alternative definition:+--+-- >prop_tautEval :: Proposition -> Property+-- >prop_taut p =+-- >  tautology p ==> \e -> eval p e+--+-- The first definition generates p and e for each test, whereas the+-- second only generates e if the tautology p holds.+--+-- The second definition is far better as the test-space is+-- reduced from PE to T'+TE where P, T, T' and E are the numbers of+-- propositions, tautologies, non-tautologies and environments.+(==>) :: Testable a => Bool -> a -> Property+True ==>  x = Property (test x)+False ==> x = Property (const [nothing])+    where+    nothing = TestCase { result = Inappropriate, arguments = [] }
+ Test/SmallCheck/Series.hs view
@@ -0,0 +1,410 @@+--------------------------------------------------------------------+-- |+-- Module    : Test.SmallCheck.Series+-- Copyright : (c) Colin Runciman et al.+-- License   : BSD3+-- Maintainer: Roman Cheplyaka <roma@ro-che.info>+--+-- Generation of test data.+--------------------------------------------------------------------+{-# LANGUAGE CPP #-}++#ifdef GENERICS+{-# LANGUAGE DefaultSignatures+           , FlexibleContexts+           , TypeOperators+           , TypeSynonymInstances+           , FlexibleInstances+  #-}+#endif++module Test.SmallCheck.Series (+  -- * Basic definitions+  Depth, Series, Serial(..),++  -- * Data Generators+  -- | SmallCheck itself defines data generators for all the data types used+  -- by the Prelude.+  --+  -- Writing SmallCheck generators for application-specific types is+  -- straightforward. You need to define a 'series' generator, typically using+  -- @consN@ family of generic combinators where N is constructor arity.+  --+  -- For example:+  --+  -- >data Tree a = Null | Fork (Tree a) a (Tree a)+  -- >+  -- >instance Serial a => Serial (Tree a) where+  -- >  series = cons0 Null \/ cons3 Fork+  --+  -- The default interpretation of depth for datatypes is the depth of nested+  -- construction: constructor functions, including those for newtypes, build+  -- results with depth one greater than their deepest argument.  But this+  -- default can be over-ridden by composing a @consN@ application with an+  -- application of 'depth', like this:+  --+  -- >newtype Light a = Light a+  -- >+  -- >instance Serial a => Serial (Light a) where+  -- >  series = cons1 Light . depth 0+  --+  -- The depth of @Light x@ is just the depth of @x@.++  cons0, cons1, cons2, cons3, cons4,+  -- * Function Generators++  -- | To generate functions of an application-specific argument type+  -- requires a second method 'coseries'.  Again there is a standard+  -- pattern, this time using the altsN combinators where again N is+  -- constructor arity.  Here are Tree and Light instances:+  --+  -- >coseries rs d = [ \t -> case t of+  -- >                        Null         -> z+  -- >                        Fork t1 x t2 -> f t1 x t2+  -- >                |  z <- alts0 rs d ,+  -- >                   f <- alts3 rs d ]+  -- >+  -- >coseries rs d = [ \l -> case l of+  -- >                        Light x -> f x+  -- >                |  f <- (alts1 rs . depth 0) d ]+  alts0, alts1, alts2, alts3, alts4,++  -- * Automated Derivation of Generators++  -- | For small examples, Series instances are easy enough to define by hand,+  -- following the above patterns.  But for programs with many or large data+  -- type definitions, automatic derivation using a tool such as \"derive\"+  -- is a better option. For example, the following command-line appends to+  -- Prog.hs the Series instances for all data types defined there.+  --+  -- >$ derive Prog.hs -d Serial --append++  -- ** Using GHC Generics+  -- | For GHC users starting from GHC 7.2.1 there's also an option to use GHC's+  -- Generics to get 'Serial' instance for free.+  --+  -- Example:+  --+  -- >{-# LANGUAGE DeriveGeneric #-}+  -- >import Test.SmallCheck+  -- >import GHC.Generics+  -- >+  -- >data Tree a = Null | Fork (Tree a) a (Tree a)+  -- >    deriving Generic+  -- >instance Serial a => Serial (Tree a)+  --+  -- Here we enable the @DeriveGeneric@ extension which allows to derive 'Generic'+  -- instance for our data type. Then we declare that @Tree a@ is an instance of+  -- 'Serial', but do not provide any definitions. This causes GHC to use the+  -- default definitions that use the 'Generic' instance.++  -- * Other useful definitions+  (\/), (><),+  N(..), Nat, Natural,+  depth+  ) where++import Data.List (intersperse)++#ifdef GENERICS+import GHC.Generics+import Data.DList (DList, toList, fromList)+import Data.Monoid (mempty, mappend)+#endif++-- | Maximum depth of generated test values+--+-- For data values, it is the depth of nested constructor applications.+--+-- For functional values, it is both the depth of nested case analysis+-- and the depth of results.+type Depth = Int++-- | 'Series' is a function from the depth to a finite list of values.+type Series a = Depth -> [a]++-- | Sum (union) of series+infixr 7 \/+(\/) :: Series a -> Series a -> Series a+s1 \/ s2 = \d -> s1 d ++ s2 d++-- | Product of series+infixr 8 ><+(><) :: Series a -> Series b -> Series (a,b)+s1 >< s2 = \d -> [(x,y) | x <- s1 d, y <- s2 d]++class Serial a where+  series   :: Series a+  coseries :: Series b -> Series (a->b)++#ifdef GENERICS+  default series :: (Generic a, GSerial (Rep a)) => Series a+  series = map to . gSeries++  default coseries :: (Generic a, GSerial (Rep a)) => Series b -> Series (a->b)+  coseries rs = map (. from) . gCoseries rs++class GSerial f where+  gSeries   :: Series (f a)+  gCoseries :: Series b -> Series (f a -> b)++instance GSerial f => GSerial (M1 i c f) where+  gSeries      = map M1 . gSeries+  gCoseries rs = map (. unM1) . gCoseries rs+  {-# INLINE gSeries #-}+  {-# INLINE gCoseries #-}++instance Serial c => GSerial (K1 i c) where+  gSeries      = map K1 . series+  gCoseries rs = map (. unK1) . coseries rs+  {-# INLINE gSeries #-}+  {-# INLINE gCoseries #-}++instance GSerial U1 where+  gSeries        = cons0 U1+  gCoseries rs d = [\U1 -> b | b <- rs d]+  {-# INLINE gSeries #-}+  {-# INLINE gCoseries #-}++instance (GSerial a, GSerial b) => GSerial (a :*: b) where+  gSeries    d = [x :*: y | x <- gSeries d, y <- gSeries d]+  gCoseries rs = map uncur . gCoseries (gCoseries rs)+      where+        uncur f (x :*: y) = f x y+  {-# INLINE gSeries #-}+  {-# INLINE gCoseries #-}++instance (GSerialSum a, GSerialSum b) => GSerial (a :+: b) where+  gSeries   = toList . gSeriesSum+  gCoseries = gCoseriesSum+  {-# INLINE gSeries #-}+  {-# INLINE gCoseries #-}++class GSerialSum f where+  gSeriesSum   :: DSeries (f a)+  gCoseriesSum :: Series b -> Series (f a -> b)++type DSeries a = Depth -> DList a++instance (GSerialSum a, GSerialSum b) => GSerialSum (a :+: b) where+  gSeriesSum      d = fmap L1 (gSeriesSum d) `mappend` fmap R1 (gSeriesSum d)+  gCoseriesSum rs d = [ \e -> case e of+                                L1 x -> f x+                                R1 y -> g y+                      | f <- gCoseriesSum rs d+                      , g <- gCoseriesSum rs d+                      ]+  {-# INLINE gSeriesSum #-}+  {-# INLINE gCoseriesSum #-}++instance GSerial f => GSerialSum (C1 c f) where+  gSeriesSum      d | d > 0     = fromList $ gSeries (d-1)+                    | otherwise = mempty+  gCoseriesSum rs d | d > 0     = gCoseries rs (d-1)+                    | otherwise = [\_ -> x | x <- rs d]+  {-# INLINE gSeriesSum #-}+  {-# INLINE gCoseriesSum #-}+#endif++instance Serial () where+  series      _ = [()]+  coseries rs d = [ \() -> b+                  | b <- rs d ]++instance Serial Int where+  series      d = [(-d)..d]+  coseries rs d = [ \i -> if i > 0 then f (N (i - 1))+                          else if i < 0 then g (N (abs i - 1))+                          else z+                  | z <- alts0 rs d, f <- alts1 rs d, g <- alts1 rs d ]++instance Serial Integer where+  series      d = [ toInteger (i :: Int)+                  | i <- series d ]+  coseries rs d = [ f . (fromInteger :: Integer->Int)+                  | f <- coseries rs d ]++-- | 'N' is a wrapper for 'Integral' types that causes only non-negative values+-- to be generated. Generated functions of type @N a -> b@ do not distinguish+-- different negative values of @a@.+--+-- See also 'Nat' and 'Natural'.+newtype N a = N a+              deriving (Eq, Ord)++instance Show a => Show (N a) where+  show (N i) = show i++instance (Integral a, Serial a) => Serial (N a) where+  series      d = map N [0..d']+                  where+                  d' = fromInteger (toInteger d)+  coseries rs d = [ \(N i) -> if i > 0 then f (N (i - 1))+                              else z+                  | z <- alts0 rs d, f <- alts1 rs d ]++type Nat = N Int+type Natural = N Integer++instance Serial Float where+  series     d = [ encodeFloat sig exp+                 | (sig,exp) <- series d,+                   odd sig || sig==0 && exp==0 ]+  coseries rs d = [ f . decodeFloat+                  | f <- coseries rs d ]++instance Serial Double where+  series      d = [ frac (x :: Float)+                  | x <- series d ]+  coseries rs d = [ f . (frac :: Double->Float)+                  | f <- coseries rs d ]++frac :: (Real a, Fractional a, Real b, Fractional b) => a -> b+frac = fromRational . toRational++instance Serial Char where+  series      d = take (d+1) ['a'..'z']+  coseries rs d = [ \c -> f (N (fromEnum c - fromEnum 'a'))+                  | f <- coseries rs d ]++instance (Serial a, Serial b) =>+         Serial (a,b) where+  series      = series >< series+  coseries rs = map uncurry . (coseries $ coseries rs)++instance (Serial a, Serial b, Serial c) =>+         Serial (a,b,c) where+  series      = \d -> [(a,b,c) | (a,(b,c)) <- series d]+  coseries rs = map uncurry3 . (coseries $ coseries $ coseries rs)++instance (Serial a, Serial b, Serial c, Serial d) =>+         Serial (a,b,c,d) where+  series      = \d -> [(a,b,c,d) | (a,(b,(c,d))) <- series d]+  coseries rs = map uncurry4 . (coseries $ coseries $ coseries $ coseries rs)++uncurry3 :: (a->b->c->d) -> ((a,b,c)->d)+uncurry3 f (x,y,z) = f x y z++uncurry4 :: (a->b->c->d->e) -> ((a,b,c,d)->e)+uncurry4 f (w,x,y,z) = f w x y z++cons0 ::+         a -> Series a+cons0 c _ = [c]++cons1 :: Serial a =>+         (a->b) -> Series b+cons1 c d = [c z | d > 0, z <- series (d-1)]++cons2 :: (Serial a, Serial b) =>+         (a->b->c) -> Series c+cons2 c d = [c y z | d > 0, (y,z) <- series (d-1)]++cons3 :: (Serial a, Serial b, Serial c) =>+         (a->b->c->d) -> Series d+cons3 c d = [c x y z | d > 0, (x,y,z) <- series (d-1)]++cons4 :: (Serial a, Serial b, Serial c, Serial d) =>+         (a->b->c->d->e) -> Series e+cons4 c d = [c w x y z | d > 0, (w,x,y,z) <- series (d-1)]++alts0 ::  Series a ->+            Series a+alts0 as d = as d++alts1 ::  Serial a =>+            Series b -> Series (a->b)+alts1 bs d = if d > 0 then coseries bs (dec d)+             else [\_ -> x | x <- bs d]++alts2 ::  (Serial a, Serial b) =>+            Series c -> Series (a->b->c)+alts2 cs d = if d > 0 then coseries (coseries cs) (dec d)+             else [\_ _ -> x | x <- cs d]++alts3 ::  (Serial a, Serial b, Serial c) =>+            Series d -> Series (a->b->c->d)+alts3 ds d = if d > 0 then coseries (coseries (coseries ds)) (dec d)+             else [\_ _ _ -> x | x <- ds d]++alts4 ::  (Serial a, Serial b, Serial c, Serial d) =>+            Series e -> Series (a->b->c->d->e)+alts4 es d = if d > 0 then coseries (coseries (coseries (coseries es))) (dec d)+             else [\_ _ _ _ -> x | x <- es d]++instance Serial Bool where+  series        = cons0 True \/ cons0 False+  coseries rs d = [ \x -> if x then r1 else r2+                  | r1 <- rs d, r2 <- rs d ]++instance Serial a => Serial (Maybe a) where+  series        = cons0 Nothing \/ cons1 Just+  coseries rs d = [ \m -> case m of+                       Nothing -> z+                       Just x  -> f x+                  |  z <- alts0 rs d ,+                     f <- alts1 rs d ]++instance (Serial a, Serial b) => Serial (Either a b) where+  series        = cons1 Left \/ cons1 Right+  coseries rs d = [ \e -> case e of+                          Left x  -> f x+                          Right y -> g y+                  |  f <- alts1 rs d ,+                     g <- alts1 rs d ]++instance Serial a => Serial [a] where+  series        = cons0 [] \/ cons2 (:)+  coseries rs d = [ \xs -> case xs of+                           []      -> y+                           (x:xs') -> f x xs'+                  |   y <- alts0 rs d ,+                      f <- alts2 rs d ]++-- Thanks to Ralf Hinze for the definition of coseries+-- using the nest auxiliary.+instance (Serial a, Serial b) => Serial (a->b) where+  series = coseries series+  coseries rs d =+    [ \ f -> g [ f a | a <- args ]+    | g <- nest args d ]+    where+    args = series d+    nest []     _ = [ \[] -> c+                    | c <- rs d ]+    nest (a:as) _ = [ \(b:bs) -> f b bs+                    | f <- coseries (nest as) d ]++-- | For customising the depth measure. Use with care!+depth :: Depth -> Depth -> Depth+depth d d' | d >= 0    = d'+1-d+           | otherwise = error "SmallCheck.depth: argument < 0"++dec :: Depth -> Depth+dec d | d > 0     = d-1+      | otherwise = error "SmallCheck.dec: argument <= 0"++inc :: Depth -> Depth+inc d = d+1++-- show the extension of a function (in part, bounded both by+-- the number and depth of arguments)+instance (Serial a, Show a, Show b) => Show (a->b) where+  show f =+    if maxarheight == 1+    && sumarwidth + length ars * length "->;" < widthLimit then+      "{"++(+      concat $ intersperse ";" $ [a++"->"++r | (a,r) <- ars]+      )++"}"+    else+      concat $ [a++"->\n"++indent r | (a,r) <- ars]+    where+    ars = take lengthLimit [ (show x, show (f x))+                           | x <- series depthLimit ]+    maxarheight = maximum  [ max (height a) (height r)+                           | (a,r) <- ars ]+    sumarwidth = sum       [ length a + length r+                           | (a,r) <- ars]+    indent = unlines . map ("  "++) . lines+    height = length . lines+    (widthLimit,lengthLimit,depthLimit) = (80,20,3)::(Int,Int,Depth)
examples/binarytries/BinaryTries.hs view
@@ -7,6 +7,7 @@ module BinaryTries where  import Test.SmallCheck+import Test.SmallCheck.Series  -- first representation
examples/circuits/Mux.hs view
@@ -1,5 +1,6 @@ import List import Test.SmallCheck+import Test.SmallCheck.Series  type Bit             =  Bool
examples/logical/LogicProps.hs view
@@ -7,6 +7,7 @@ module PropLogic where  import Test.SmallCheck+import Test.SmallCheck.Series  import List (nub)
examples/numeric/NumProps.hs view
@@ -5,6 +5,8 @@ ----------------------------------------  import Test.SmallCheck+import Test.SmallCheck.Series+import Test.SmallCheck.Property  primes :: [Int] primes = sieve [2..]
examples/regular/Regular.hs view
@@ -5,6 +5,7 @@ import Monad (liftM)  import Test.SmallCheck+import Test.SmallCheck.Series  -- A data type of regular expressions. @@ -97,21 +98,7 @@         \/ cons1 cat         \/ cons1 Rep -prop_readShow :: RE -> IO Bool-prop_readShow re = do-  writeFile "tmp" (show re)-  re' <- liftM read (readFile "tmp")-  return (re'==re)+prop_readShow :: RE -> Bool+prop_readShow re = read (show re) == re -main = do-  rule-  putStrLn "Testing property involving IO.  Always returns True?"-  putStrLn "do\n\-           \  writeFile \"tmp\" (show re)\n\-           \  re' <- liftM read (readFile \"tmp\")\n\-           \  return (re'==re)"-  rule-  smallCheck 4 prop_readShow-  where-  rule = putStrLn-           "----------------------------------------------------"+main = smallCheck 4 prop_readShow
+ examples/run-examples.sh view
@@ -0,0 +1,3 @@+find -iname '*.hs' \+     -exec grep -q ^main {} \; \+     -exec runghc {} \;
smallcheck.cabal view
@@ -1,5 +1,5 @@ Name:          smallcheck-Version:       0.5+Version:       0.6 Cabal-Version: >= 1.6 License:       BSD3 License-File:  LICENSE@@ -10,11 +10,10 @@  Stability:     Beta Category:      Testing-Synopsis:      Another lightweight testing library in Haskell.-Description:   SmallCheck is similar to QuickCheck (Claessen and Hughes 2000-) but-               instead of testing for a sample of randomly generated values, SmallCheck-               tests properties for all the finitely many values up to some depth,-               progressively increasing the depth used.+Synopsis:      A property-based testing library+Description:   SmallCheck is a testing library that allows to verify properties+               for all test cases up to some depth. The test cases are generated+               automatically by SmallCheck. Build-Type:    Simple  Extra-source-files: examples/numeric/NumProps.hs, examples/logical/LogicProps.hs,@@ -24,12 +23,15 @@                     examples/imperative/StackMap.hs, examples/imperative/Compiler.hs,                     examples/listy/ListProps.hs, examples/regular/Regular.hs,                     examples/circuits/BitAdd.hs, examples/circuits/Mux.hs, examples/circuits/Sad.hs,-                    examples/binarytries/BinaryTries.hs--Data-files:         examples/numeric/README, examples/logical/README, examples/imperative/README,+                    examples/binarytries/BinaryTries.hs,+                    examples/numeric/README, examples/logical/README, examples/imperative/README,                     examples/listy/README, examples/regular/README, examples/circuits/README,-                    examples/binarytries/README, README.md, CREDITS.md, CHANGES.md+                    examples/binarytries/README,+                    README.md, CREDITS.md, CHANGES.md,+                    examples/run-examples.sh ++ Source-repository head   type:     git   location: git://github.com/feuerbach/smallcheck.git@@ -37,10 +39,18 @@ Source-repository this   type:     git   location: git://github.com/feuerbach/smallcheck.git-  tag:      v0.5+  tag:      v0.6  Library      Build-Depends: base == 4.* -    Exposed-modules:    Test.SmallCheck+    Exposed-modules:+        Test.SmallCheck+        Test.SmallCheck.Drivers+        Test.SmallCheck.Property+        Test.SmallCheck.Series++    if impl(ghc >= 7.2.1)+      cpp-options: -DGENERICS+      build-depends: ghc-prim >= 0.2, dlist >= 0.2 && < 0.6