QuickCheck 2.5 → 2.5.1

raw patch · 6 files changed

+69/−84 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• QuickCheck.cabal +2/−2
• README +4/−1
• Test/QuickCheck/Exception.hs +10/−1
• Test/QuickCheck/Function.hs +10/−41
• Test/QuickCheck/State.hs +16/−15
• Test/QuickCheck/Test.hs +27/−24

@@ -1,5 +1,5 @@ Name: QuickCheck-Version: 2.5+Version: 2.5.1 Cabal-Version: >= 1.6 Build-type: Simple License: BSD3@@ -60,7 +60,7 @@       Build-depends: ghc    -- We want to use extensible-exceptions even if linking against base-3.-  if impl(ghc >= 6.9)+  if impl(ghc >= 6.9) && impl (ghc < 7.0)     Build-depends: extensible-exceptions    -- Modules that are always built.

@@ -1,4 +1,4 @@-This is QuickCheck 2.4.1.1, a library for random testing of program properties.+This is QuickCheck 2, a library for random testing of program properties.  === Installation === @@ -15,6 +15,9 @@ If you get errors about Template Haskell, try  $ cabal install -f-templateHaskell++but please report this as a bug, letting us know about your GHC+installation.  === Bugs === 

@@ -14,12 +14,21 @@ #if __GLASGOW_HASKELL__ < 613 #define GHCI_INTERRUPTED_EXCEPTION #endif++#if __GLASGOW_HASKELL__ >= 700+#define NO_BASE_3 #endif+#endif  #if defined(OLD_EXCEPTIONS) import Control.Exception(evaluate, try, Exception(..), throw) #else-import Control.Exception.Extensible(evaluate, try, SomeException(SomeException), ErrorCall(..), throw+#if defined(NO_BASE_3)+import Control.Exception+#else+import Control.Exception.Extensible+#endif+  (evaluate, try, SomeException(SomeException), ErrorCall(..), throw #if defined(GHC_INTERRUPT)   , AsyncException(UserInterrupt) #endif

@@ -32,6 +32,7 @@  import Test.QuickCheck.Arbitrary import Test.QuickCheck.Poly+import Test.QuickCheck.Exception(discard)  import Data.Char import Data.Word@@ -90,41 +91,6 @@ table (Table xys) = xys table (Map _ h p) = [ (h x, c) | (x,c) <- table p ] --- finding a default result---- breadth-first search (can't use depth-first search!)-data Steps a = Step (Steps a) | Fail | Result a--(#) :: Steps a -> Steps a -> Steps a-Result x # t        = Result x-s        # Result y = Result y-Fail     # t        = t-s        # Fail     = s-Step s   # Step t   = Step (s # t)--instance Monad Steps where-  Step s   >>= k = Step (s >>= k)-  Result x >>= k = k x-  Fail     >>= k = Fail--  return x = Result x--run :: Steps a -> Maybe a-run (Step s)   = run s-run (Result x) = Just x-run Fail       = Nothing--defaultSteps :: (a :-> c) -> Steps c-defaultSteps (Pair p)          = defaultSteps p >>= defaultSteps-defaultSteps (p :+: q)         = Step (defaultSteps p # defaultSteps q)-defaultSteps (Unit c)          = Result c-defaultSteps (Table ((_,y):_)) = Result y-defaultSteps (Map _ _ p)       = defaultSteps p-defaultSteps _                 = Fail--defaultResult :: (a :-> c) -> Maybe c-defaultResult = run . defaultSteps- -------------------------------------------------------------------------- -- Function @@ -241,8 +207,8 @@   pair p   = Pair p  shrinkFun shr (p :+: q) =-  [ p .+. Nil | not (isNil q) ] ++-  [ Nil .+. q | not (isNil p) ] +++  [ p .+. Nil `whenever` not (isNil q) ] +++  [ Nil .+. q `whenever` not (isNil p) ] ++   [ p  .+. q' | q' <- shrinkFun shr q ] ++   [ p' .+. q  | p' <- shrinkFun shr p ]  where@@ -253,6 +219,9 @@   Nil .+. Nil = Nil   p   .+. q   = p :+: q +  p `whenever` True = p+  p `whenever` False = discard+ shrinkFun shr (Unit c) =   [ Nil ] ++   [ Unit c' | c' <- shr c ]@@ -291,12 +260,12 @@ instance (Function a, CoArbitrary a, Arbitrary b) => Arbitrary (Fun a b) where   arbitrary =     do p <- arbitrary-       return (mkFun p (fromJust (defaultResult p)))+       d <- arbitrary+       return (mkFun p d)    shrink (Fun (p,d) _) =-       [ mkFun p' d' | p' <- shrink p, Just d' <- [defaultResult p'] ]-    ++ [ mkFun p' d  | p' <- shrink p ]-    ++ [ mkFun p d'  | d' <- shrink d ]+       [ mkFun p' d | p' <- shrink p ]+    ++ [ mkFun p d' | d' <- shrink d ]  -------------------------------------------------------------------------- -- the end.

@@ -11,23 +11,24 @@ data State   = MkState   -- static-  { terminal          :: Terminal   -- ^ the current terminal-  , maxSuccessTests   :: Int        -- ^ maximum number of successful tests needed-  , maxDiscardedTests :: Int        -- ^ maximum number of tests that can be discarded-  , computeSize       :: Int -> Int -> Int -- ^ how to compute the size of test cases from-                                    -- #tests and #discarded tests+  { terminal                  :: Terminal          -- ^ the current terminal+  , maxSuccessTests           :: Int               -- ^ maximum number of successful tests needed+  , maxDiscardedTests         :: Int               -- ^ maximum number of tests that can be discarded+  , computeSize               :: Int -> Int -> Int -- ^ how to compute the size of test cases from+                                                   -- #tests and #discarded tests -  -- dynamic-  , numSuccessTests   :: Int        -- ^ the current number of tests that have succeeded-  , numDiscardedTests :: Int        -- ^ the current number of discarded tests-  , collected         :: [[(String,Int)]] -- ^ all labels that have been collected so far-  , expectedFailure   :: Bool       -- ^ indicates if the property is expected to fail-  , randomSeed        :: StdGen     -- ^ the current random seed+                                                   -- dynamic+  , numSuccessTests           :: Int               -- ^ the current number of tests that have succeeded+  , numDiscardedTests         :: Int               -- ^ the current number of discarded tests+  , numRecentlyDiscardedTests :: Int               -- ^ the number of discarded tests since the last successful test+  , collected                 :: [[(String,Int)]]  -- ^ all labels that have been collected so far+  , expectedFailure           :: Bool              -- ^ indicates if the property is expected to fail+  , randomSeed                :: StdGen            -- ^ the current random seed -  -- shrinking-  , numSuccessShrinks :: Int        -- ^ number of successful shrinking steps so far-  , numTryShrinks     :: Int        -- ^ number of failed shrinking steps since the last successful shrink-  , numTotTryShrinks  :: Int        -- ^ total number of failed shrinking steps+                                                   -- shrinking+  , numSuccessShrinks         :: Int               -- ^ number of successful shrinking steps so far+  , numTryShrinks             :: Int               -- ^ number of failed shrinking steps since the last successful shrink+  , numTotTryShrinks          :: Int               -- ^ total number of failed shrinking steps   }  --------------------------------------------------------------------------

@@ -105,29 +105,30 @@      rnd <- case replay a of               Nothing      -> newStdGen               Just (rnd,_) -> return rnd-     test MkState{ terminal          = tm-                 , maxSuccessTests   = if exhaustive p then 1 else maxSuccess a-                 , maxDiscardedTests = if exhaustive p then maxDiscardRatio a else maxDiscardRatio a * maxSuccess a-                 , computeSize       = case replay a of-                                         Nothing    -> computeSize'-                                         Just (_,s) -> computeSize' `at0` s-                 , numSuccessTests   = 0-                 , numDiscardedTests = 0-                 , collected         = []-                 , expectedFailure   = False-                 , randomSeed        = rnd-                 , numSuccessShrinks = 0-                 , numTryShrinks     = 0-                 , numTotTryShrinks  = 0+     test MkState{ terminal                  = tm+                 , maxSuccessTests           = if exhaustive p then 1 else maxSuccess a+                 , maxDiscardedTests         = if exhaustive p then maxDiscardRatio a else maxDiscardRatio a * maxSuccess a+                 , computeSize               = case replay a of+                                                 Nothing    -> computeSize'+                                                 Just (_,s) -> computeSize' `at0` s+                 , numSuccessTests           = 0+                 , numDiscardedTests         = 0+                 , numRecentlyDiscardedTests = 0+                 , collected                 = []+                 , expectedFailure           = False+                 , randomSeed                = rnd+                 , numSuccessShrinks         = 0+                 , numTryShrinks             = 0+                 , numTotTryShrinks          = 0                  } (unGen (property p))   where computeSize' n d           -- e.g. with maxSuccess = 250, maxSize = 100, goes like this:           -- 0, 1, 2, ..., 99, 0, 1, 2, ..., 99, 0, 2, 4, ..., 98.           | n `roundTo` maxSize a + maxSize a <= maxSuccess a ||             n >= maxSuccess a ||-            maxSuccess a `mod` maxSize a == 0 = n `mod` maxSize a + d `div` 10+            maxSuccess a `mod` maxSize a == 0 = (n `mod` maxSize a + d `div` 10) `min` maxSize a           | otherwise =-            (n `mod` maxSize a) * maxSize a `div` (maxSuccess a `mod` maxSize a) + d `div` 10+            ((n `mod` maxSize a) * maxSize a `div` (maxSuccess a `mod` maxSize a) + d `div` 10) `min` maxSize a         n `roundTo` m = (n `div` m) * m         at0 f s 0 0 = s         at0 f s n d = f n d@@ -215,7 +216,7 @@                  ]        ++ ")"         )-     let size = computeSize st (numSuccessTests st) (numDiscardedTests st)+     let size = computeSize st (numSuccessTests st) (numRecentlyDiscardedTests st)      MkRose res ts <- protectRose (reduceRose (unProp (f rnd1 size)))      callbackPostTest st res @@ -225,17 +226,19 @@      case res of        MkResult{ok = Just True, stamp = stamp, expect = expect} -> -- successful test          do continue doneTesting-              st{ numSuccessTests = numSuccessTests st + 1-                , randomSeed      = rnd2-                , collected       = stamp : collected st-                , expectedFailure = expect+              st{ numSuccessTests           = numSuccessTests st + 1+                , numRecentlyDiscardedTests = 0+                , randomSeed                = rnd2+                , collected                 = stamp : collected st+                , expectedFailure           = expect                 } f         MkResult{ok = Nothing, expect = expect} -> -- discarded test          do continue giveUp-              st{ numDiscardedTests = numDiscardedTests st + 1-                , randomSeed        = rnd2-                , expectedFailure   = expect+              st{ numDiscardedTests         = numDiscardedTests st + 1+                , numRecentlyDiscardedTests = numRecentlyDiscardedTests st + 1+                , randomSeed                = rnd2+                , expectedFailure           = expect                 } f         MkResult{ok = Just False} -> -- failed test