packages feed

QuickCheck 2.4.0.1 → 2.4.1

raw patch · 15 files changed

+256/−95 lines, 15 filesdep −mtldep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependencies removed: mtl

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

+ Test.QuickCheck.Test: safely :: State -> IO () -> IO ()

Files

LICENSE view
@@ -1,5 +1,6 @@-Copyright (c) 2000-2006, Koen Claessen-Copyright (c) 2006, Bjorn Bringert+Copyright (c) 2000-2011, Koen Claessen+Copyright (c) 2006-2008, Björn Bringert+Copyright (c) 2009-2011, Nick Smallbone All rights reserved.  Redistribution and use in source and binary forms, with or without
QuickCheck.cabal view
@@ -1,13 +1,15 @@ Name: QuickCheck-Version: 2.4.0.1-Cabal-Version: >= 1.2+Version: 2.4.1+Cabal-Version: >= 1.6 Build-type: Simple License: BSD3 License-file: LICENSE Extra-source-files: README-Copyright: Koen Claessen <koen@chalmers.se>+Copyright: 2000-2011 Koen Claessen, 2006-2008 Björn Bringert, 2009-2001 Nick Smallbone Author: Koen Claessen <koen@chalmers.se> Maintainer: QuickCheck developers <quickcheck@projects.haskell.org>+Bug-reports: mailto:quickcheck@projects.haskell.org+Tested-with: GHC >=6.8, Hugs Homepage: http://code.haskell.org/QuickCheck Category:	    Testing Synopsis:	    Automatic testing of Haskell programs@@ -25,29 +27,46 @@ 	the distribution of test data, and define test 	data generators. -flag splitBase+source-repository head+  type:     darcs+  location: http://code.haskell.org/QuickCheck/++source-repository this+  type:     darcs+  location: http://code.haskell.org/QuickCheck+  tag:      2.4.1++flag base3   Description: Choose the new smaller, split-up base package. -flag extensibleExceptions-  Description: Choose the even newer, even smaller, split-up base package.+flag base4+  Description: Choose the even newer base package with extensible exceptions. +flag templateHaskell+  Description: Build Test.QuickCheck.All, which uses Template Haskell.+ library-  Build-depends: mtl-  if flag(extensibleExceptions)+  -- Choose which library versions to use.+  if flag(base4)     Build-depends: base >= 4 && < 5, random   else-    if flag(splitBase)+    if flag(base3)       Build-depends: base >= 3 && < 4, random     else       Build-depends: base < 3++  -- On old versions of GHC use the ghc package to catch ctrl-C.     if impl(ghc >= 6.7) && impl(ghc < 6.13)       Build-depends: ghc++  -- We want to use extensible-exceptions even if linking against base-3.   if impl(ghc >= 6.9)     Build-depends: extensible-exceptions++  -- Modules that are always built.   Exposed-Modules:     Test.QuickCheck,     Test.QuickCheck.Arbitrary,-    Test.QuickCheck.Function,     Test.QuickCheck.Gen,     Test.QuickCheck.Monadic,     Test.QuickCheck.Modifiers,@@ -56,9 +75,25 @@     Test.QuickCheck.Text,     Test.QuickCheck.Poly,     Test.QuickCheck.State-  if impl(ghc >= 6.12)-    Build-depends: template-haskell-    Exposed-Modules: Test.QuickCheck.All++  -- Choose which optional features to build based on which compiler+  -- we're using. It would be nice to use flags for this but Cabal's+  -- dependency resolution isn't good enough.+  if impl(ghc)+    Exposed-Modules: Test.QuickCheck.Function+    if flag(templateHaskell) && impl(ghc >= 6.12)+      Build-depends: template-haskell >= 2.4+      Exposed-Modules: Test.QuickCheck.All+    -- GHC < 7.0 doesn't cope with multiple LANGUAGE pragmas in the same+    -- file, I think...+    if impl(ghc < 7)+      Extensions: GeneralizedNewtypeDeriving, MultiParamTypeClasses, Rank2Types, TypeOperators+  else+    -- If your Haskell compiler can cope without some of these, please+    -- send a message to the QuickCheck mailing list!+    cpp-options: -DNO_TIMEOUT -DNO_NEWTYPE_DERIVING+    if !impl(hugs)+      cpp-options: -DNO_ST_MONAD -DNO_MULTI_PARAM_TYPE_CLASSES   Other-Modules:     Test.QuickCheck.Exception   GHC-options:
README view
@@ -1,4 +1,4 @@-This is QuickCheck 2.1.1, a library for random testing of program properties.+This is QuickCheck 2.4.1, a library for random testing of program properties.  === Installation === @@ -11,6 +11,10 @@ $ runghc Setup.lhs configure $ runghc Setup.lhs build $ runghc Setup.lhs install++If you get errors about Template Haskell, try++$ cabal install -f-templateHaskell  === Bugs ===
Test/QuickCheck.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Test.QuickCheck   (      -- * Running tests@@ -37,7 +38,7 @@   , sample   , sample' -    -- * Arbitrary and CoArbitrary classes.+    -- * Arbitrary and CoArbitrary classes   , Arbitrary(..)   , CoArbitrary(..)   @@ -68,7 +69,9 @@   , NonNegative(..)   , Smart(..)   , Shrink2(..)+#ifndef NO_MULTI_PARAM_TYPE_CLASSES   , Shrinking(..)+#endif   , ShrinkState(..)      -- * Properties
Test/QuickCheck/All.hs view
@@ -1,5 +1,14 @@ {-# LANGUAGE TemplateHaskell, Rank2Types #-}-module Test.QuickCheck.All(forAllProperties, quickCheckAll, mono, polyQuickCheck) where+-- | Experimental features using Template Haskell.+-- You need to have a @{-\# LANGUAGE TemplateHaskell \#-}@ pragma in+-- your module for any of these to work.+module Test.QuickCheck.All(+  -- ** Testing all properties in a module.+  quickCheckAll,+  forAllProperties,+  -- ** Testing polymorphic properties.+  polyQuickCheck,+  mono) where  import Language.Haskell.TH import Test.QuickCheck.Property hiding (Result)@@ -8,11 +17,20 @@ import Data.List import Control.Monad +-- | Test a polymorphic property, defaulting all type variables to 'Integer'.+--+-- Invoke as @$('polyQuickCheck' 'prop)@, where @prop@ is a property.+-- Note that just evaluating @'quickCheck' prop@ in GHCi will seem to+-- work, but will silently default all type variables to @()@! polyQuickCheck :: Name -> ExpQ polyQuickCheck x = [| quickCheck $(mono x) |]  type Error = forall a. String -> a +-- | Monomorphise an arbitrary name by defaulting all type variables to 'Integer'.+--+-- For example, if @f@ has type @'Ord' a => [a] -> [a]@+-- then @$('mono' 'f)@ has type @['Integer'] -> ['Integer']@. mono :: Name -> ExpQ mono t = do   ty0 <- fmap infoType (reify t)@@ -44,6 +62,13 @@ monomorphise err mono ty@(ForallT _ _ _) = err $ "Higher-ranked type" monomorphise err mono ty = return ty +-- | Test all properties in the current module, using a custom+-- 'quickCheck' function. The same caveats as with 'quickCheckAll'+-- apply.+-- +-- @$'forAllProperties'@ has type @('Property' -> 'IO' 'Result') -> 'IO' 'Bool'@.+-- An example invocation is @$'forAllProperties' 'quickCheckResult'@,+-- which does the same thing as @$'quickCheckAll'@. forAllProperties :: Q Exp -- :: (Property -> IO Result) -> IO Bool forAllProperties = do   Loc { loc_filename = filename } <- location@@ -59,6 +84,17 @@          else return []   [| runQuickCheckAll $(fmap (ListE . concat) (mapM quickCheckOne idents)) |] +-- | Test all properties in the current module.+-- The name of the property must begin with @prop_@.+-- Polymorphic properties will be defaulted to 'Integer'.+-- Returns 'True' if all tests succeeded, 'False' otherwise.+--+-- Using 'quickCheckAll' interactively doesn't work.+-- Instead, add a definition to your module along the lines of+-- +-- > runTests = $quickCheckAll+-- +-- and then execute @runTests@. quickCheckAll :: Q Exp quickCheckAll = [| $(forAllProperties) quickCheckResult |]
Test/QuickCheck/Arbitrary.hs view
@@ -1,6 +1,6 @@ module Test.QuickCheck.Arbitrary   ( -  -- * Arbitrary and CoArbitrary classes.+  -- * Arbitrary and CoArbitrary classes     Arbitrary(..)   , CoArbitrary(..)   @@ -255,12 +255,12 @@            ++ [' ','\n']    where     a <. b  = stamp a < stamp b-    stamp a = ( not (isLower a)+    stamp a = ( (not (isLower a)               , not (isUpper a)-              , not (isDigit a)-              , not (a==' ')+              , not (isDigit a))+              , (not (a==' ')               , not (isSpace a)-              , a+              , a)               )      instance Arbitrary Float where
Test/QuickCheck/Exception.hs view
@@ -1,3 +1,6 @@+-- Hide away the nasty implementation-specific ways of catching+-- exceptions behind a nice API. The main trouble is catching ctrl-C.+ {-# LANGUAGE CPP #-} module Test.QuickCheck.Exception where
Test/QuickCheck/Function.hs view
@@ -1,4 +1,22 @@ {-# LANGUAGE TypeOperators, GADTs #-}+-- | Generation of random shrinkable, showable functions.+-- Not really documented at the moment!+--+-- Example of use:+-- +-- >>> :{+-- >>> let prop :: Fun String Integer -> Bool+-- >>>     prop (Fun _ f) = f "monkey" == f "banana" || f "banana" == f "elephant"+-- >>> :}+-- >>> quickCheck prop+-- *** Failed! Falsifiable (after 3 tests and 134 shrinks):     +-- {"elephant"->1, "monkey"->1, _->0}+--+-- To generate random values of type @'Fun' a b@,+-- you must have an instance @'Function' a@.+-- If your type has a 'Show' instance, you can use 'functionShow' to write the instance; otherwise,+-- use 'functionMap' to give a bijection between your type and a type that is already an instance of 'Function'.+-- See the @'Function' [a]@ instance for an example of the latter. module Test.QuickCheck.Function   ( Fun(..)   , apply@@ -12,11 +30,8 @@ -------------------------------------------------------------------------- -- imports -import Test.QuickCheck.Gen import Test.QuickCheck.Arbitrary-import Test.QuickCheck.Property import Test.QuickCheck.Poly-import Test.QuickCheck.Modifiers  import Data.Char import Data.Word@@ -49,12 +64,12 @@ -- only use this on finite functions showFunction :: (Show a, Show b) => (a :-> b) -> Maybe b -> String showFunction p md =-  "{" ++ concat (intersperse "," ( [ show x ++ "->" ++ show c-                                   | (x,c) <- table p-                                   ]-                                ++ [ "_->" ++ show d-                                   | Just d <- [md]-                                   ] )) ++ "}"+  "{" ++ concat (intersperse ", " ( [ show x ++ "->" ++ show c+                                    | (x,c) <- table p+                                    ]+                                 ++ [ "_->" ++ show d+                                    | Just d <- [md]+                                    ] )) ++ "}"  -- turning a concrete function into an abstract function (with a default result) abstract :: (a :-> c) -> c -> (a -> c)
Test/QuickCheck/Gen.hs view
@@ -1,3 +1,4 @@+-- | Test case generation. module Test.QuickCheck.Gen where  --------------------------------------------------------------------------@@ -19,14 +20,6 @@ import Control.Applicative   ( Applicative(..)   )--import Control.Monad.Reader()-  -- needed for "instance Monad (a ->)"-  -  -- 2005-09-16:-  -- GHC gives a warning for this. I reported this as a bug. /Koen---- * Test case generation  -------------------------------------------------------------------------- -- ** Generator type
Test/QuickCheck/Modifiers.hs view
@@ -1,4 +1,40 @@-{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP #-}+#ifndef NO_MULTI_PARAM_TYPE_CLASSES+{-# LANGUAGE MultiParamTypeClasses #-}+#endif+#ifndef NO_NEWTYPE_DERIVING+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+#endif+-- | Modifiers for test data.+--+-- These types do things such as restricting the kind of test data that can be generated.+-- They can be pattern-matched on in properties as a stylistic+-- alternative to using explicit quantification.+-- +-- Examples:+-- +-- @+-- -- Functions cannot be shown (but see "Test.QuickCheck.Function")+-- prop_TakeDropWhile ('Blind' p) (xs :: ['A']) =+--   takeWhile p xs ++ dropWhile p xs == xs+-- @+--+-- @+-- prop_TakeDrop ('NonNegative' n) (xs :: ['A']) =+--   take n xs ++ drop n xs == xs+-- @+--+-- @+-- -- cycle does not work for empty lists+-- prop_Cycle ('NonNegative' n) ('NonEmpty' (xs :: ['A'])) =+--   take n (cycle xs) == take n (xs ++ cycle xs)+-- @+--+-- @+-- -- Instead of 'forAll' 'orderedList'+-- prop_Sort ('Ordered' (xs :: ['OrdA'])) =+--   sort xs == xs+-- @ module Test.QuickCheck.Modifiers   (   -- ** Type-level modifiers for changing generator behavior@@ -27,32 +63,13 @@   )  ----------------------------------------------------------------------------- ** arbitrary modifiers---- These datatypes are mainly here to *pattern match* on in properties.--- This is a stylistic alternative to using explicit quantification.--- In other words, they should not be replaced by type synonyms, and their--- constructors should be exported.---- Examples:-{--prop_TakeDropWhile (Blind p) (xs :: [A]) =           -- because functions cannot be shown-  takeWhile p xs ++ dropWhile p xs == xs--prop_TakeDrop (NonNegative n) (xs :: [A]) =          -- (BTW, also works for negative n)-  take n xs ++ drop n xs == xs--prop_Cycle (NonNegative n) (NonEmpty (xs :: [A])) =  -- cycle does not work for empty lists-  take n (cycle xs) == take n (xs ++ cycle xs)--prop_Sort (Ordered (xs :: [OrdA])) =                 -- instead of "forAll orderedList"-  sort xs == xs--}---------------------------------------------------------------------------- -- | @Blind x@: as x, but x does not have to be in the 'Show' class. newtype Blind a = Blind a- deriving ( Eq, Ord, Num, Integral, Real, Enum )+ deriving ( Eq, Ord+#ifndef NO_NEWTYPE_DERIVING+          , Num, Integral, Real, Enum+#endif+          )  instance Show (Blind a) where   show _ = "(*)"@@ -65,7 +82,11 @@ -------------------------------------------------------------------------- -- | @Fixed x@: as x, but will not be shrunk. newtype Fixed a = Fixed a- deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )+ deriving ( Eq, Ord, Show, Read+#ifndef NO_NEWTYPE_DERIVING+          , Num, Integral, Real, Enum+#endif+          )  instance Arbitrary a => Arbitrary (Fixed a) where   arbitrary = Fixed `fmap` arbitrary@@ -103,8 +124,11 @@ -------------------------------------------------------------------------- -- | @Positive x@: guarantees that @x \> 0@. newtype Positive a = Positive a- deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )-+ deriving ( Eq, Ord, Show, Read+#ifndef NO_NEWTYPE_DERIVING+          , Num, Integral, Real, Enum+#endif+          ) instance (Num a, Ord a, Arbitrary a) => Arbitrary (Positive a) where   arbitrary =     (Positive . abs) `fmap` (arbitrary `suchThat` (/= 0))@@ -118,7 +142,11 @@ -------------------------------------------------------------------------- -- | @NonZero x@: guarantees that @x \/= 0@. newtype NonZero a = NonZero a- deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )+ deriving ( Eq, Ord, Show, Read+#ifndef NO_NEWTYPE_DERIVING+          , Num, Integral, Real, Enum+#endif+          )  instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonZero a) where   arbitrary = fmap NonZero $ arbitrary `suchThat` (/= 0)@@ -128,14 +156,18 @@ -------------------------------------------------------------------------- -- | @NonNegative x@: guarantees that @x \>= 0@. newtype NonNegative a = NonNegative a- deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )+ deriving ( Eq, Ord, Show, Read+#ifndef NO_NEWTYPE_DERIVING+          , Num, Integral, Real, Enum+#endif+          )  instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonNegative a) where   arbitrary =     frequency       -- why is this distrbution like this?       [ (5, (NonNegative . abs) `fmap` arbitrary)-      , (1, return 0)+      , (1, return (NonNegative 0))       ]    shrink (NonNegative x) =@@ -147,7 +179,11 @@ -------------------------------------------------------------------------- -- | @Shrink2 x@: allows 2 shrinking steps at the same time when shrinking x newtype Shrink2 a = Shrink2 a- deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )+ deriving ( Eq, Ord, Show, Read+#ifndef NO_NEWTYPE_DERIVING+          , Num, Integral, Real, Enum+#endif+          )  instance Arbitrary a => Arbitrary (Shrink2 a) where   arbitrary =@@ -206,6 +242,7 @@     -- == take k ys ++ drop k ys     -- == ys +#ifndef NO_MULTI_PARAM_TYPE_CLASSES -------------------------------------------------------------------------- -- | @Shrinking _ x@: allows for maintaining a state during shrinking. data Shrinking s a =@@ -227,6 +264,8 @@     [ Shrinking s' x'     | (x',s') <- shrinkState x s     ]++#endif /* NO_MULTI_PARAM_TYPE_CLASSES */  -------------------------------------------------------------------------- -- the end.
Test/QuickCheck/Monadic.hs view
@@ -1,5 +1,10 @@+{-# LANGUAGE CPP #-}+#ifndef NO_ST_MONAD {-# LANGUAGE Rank2Types #-}+#endif -- | Allows testing of monadic values.+-- See the paper \"Testing Monadic Code with QuickCheck\":+-- <http://www.cse.chalmers.se/~rjmh/Papers/QuickCheckST.ps>. module Test.QuickCheck.Monadic where  --------------------------------------------------------------------------@@ -75,11 +80,13 @@ monadicIO :: PropertyM IO a -> Property monadicIO = monadic morallyDubiousIOProperty +#ifndef NO_ST_MONAD monadicST :: (forall s. PropertyM (ST s) a) -> Property monadicST m = property (runSTGen (monadic' m))  runSTGen :: (forall s. Gen (ST s a)) -> Gen a runSTGen g = MkGen $ \r n -> runST (unGen g r n)+#endif  -------------------------------------------------------------------------- -- the end.
Test/QuickCheck/Poly.hs view
@@ -1,4 +1,15 @@+{-# LANGUAGE CPP #-}+#ifndef NO_NEWTYPE_DERIVING {-# LANGUAGE GeneralizedNewtypeDeriving #-}+#endif+-- | Types to help with testing polymorphic properties.+--+-- Types 'A', 'B' and 'C' are @newtype@ wrappers around 'Integer' that+-- implement 'Eq', 'Show', 'Arbitrary' and 'CoArbitrary'. Types+-- 'OrdA', 'OrdB' and 'OrdC' also implement 'Ord' and 'Num'.+--+-- See also "Test.QuickCheck.All" for an experimental way of testing+-- polymorphic properties. module Test.QuickCheck.Poly   ( A(..), B(..), C(..)   , OrdA(..), OrdB(..), OrdC(..)@@ -64,7 +75,11 @@ -- OrdA  newtype OrdA = OrdA{ unOrdA :: Integer }-  deriving ( Eq, Ord, Num )+  deriving ( Eq, Ord+#ifndef NO_NEWTYPE_DERIVING+           , Num+#endif+           )  instance Show OrdA where   showsPrec n (OrdA x) = showsPrec n x@@ -79,7 +94,11 @@ -- OrdB  newtype OrdB = OrdB{ unOrdB :: Integer }-  deriving ( Eq, Ord, Num )+  deriving ( Eq, Ord+#ifndef NO_NEWTYPE_DERIVING+           , Num+#endif+           )  instance Show OrdB where   showsPrec n (OrdB x) = showsPrec n x@@ -94,7 +113,11 @@ -- OrdC  newtype OrdC = OrdC{ unOrdC :: Integer }-  deriving ( Eq, Ord, Num )+  deriving ( Eq, Ord+#ifndef NO_NEWTYPE_DERIVING+           , Num+#endif+           )  instance Show OrdC where   showsPrec n (OrdC x) = showsPrec n x
Test/QuickCheck/Property.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-} module Test.QuickCheck.Property where  --------------------------------------------------------------------------@@ -10,21 +10,9 @@ import Test.QuickCheck.Exception import Test.QuickCheck.State -import Control.Concurrent-  ( forkIO-  , threadDelay-  , killThread-  , newEmptyMVar-  , takeMVar-  , putMVar-  )--import System.IO-  ( hFlush-  , stdout-  )-+#ifndef NO_TIMEOUT import System.Timeout(timeout)+#endif import Data.Maybe  --------------------------------------------------------------------------@@ -312,7 +300,9 @@       -> Int    -- ^ The required percentage (0-100) of test cases.       -> String -- ^ Label for the test case class.       -> prop -> Property-cover True n s = mapTotalResult $ \res -> res { stamp = (s,n) : stamp res }+cover True n s = n `seq` s `listSeq` (mapTotalResult $ \res -> res { stamp = (s,n) : stamp res })+  where [] `listSeq` z = z+        (x:xs) `listSeq` z = x `seq` xs `listSeq` z cover False _ _ = property  -- | Implication for properties: The resulting property holds if@@ -335,6 +325,9 @@       res' <- timeout n (protectResult (return res)) `orError`               "within: timeout exception not caught in Result"       return (MkRose res' (map f roses))+#ifdef NO_TIMEOUT+    timeout _ = fmap Just+#endif  -- | Explicit universal quantification: uses an explicitly given -- test case generator.
Test/QuickCheck/State.hs view
@@ -7,7 +7,7 @@ -- State  -- | State represents QuickCheck's internal state while testing a property.--- | The state is made visible to callback functions.+-- The state is made visible to callback functions. data State   = MkState   -- static
Test/QuickCheck/Test.hs view
@@ -9,7 +9,6 @@ import Test.QuickCheck.Text import Test.QuickCheck.State import Test.QuickCheck.Exception-import Data.IORef  import System.Random   ( split@@ -368,11 +367,21 @@  callbackPostTest :: State -> P.Result -> IO () callbackPostTest st res =-  sequence_ [ f st res | PostTest _ f <- callbacks res ]+  sequence_ [ safely st (f st res) | PostTest _ f <- callbacks res ]  callbackPostFinalFailure :: State -> P.Result -> IO () callbackPostFinalFailure st res =-  sequence_ [ f st res | PostFinalFailure _ f <- callbacks res ]+  sequence_ [ safely st (f st res) | PostFinalFailure _ f <- callbacks res ]++safely :: State -> IO () -> IO ()+safely st x = do+  r <- tryEvaluateIO x+  case r of+    Left e ->+      putLine (terminal st)+        ("*** Exception in callback: " ++ show e)+    Right x ->+      return x  -------------------------------------------------------------------------- -- the end.