QuickCheck 2.14.2 → 2.14.3

raw patch · 16 files changed

+352/−50 lines, 16 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• QuickCheck.cabal +8/−3
• README +1/−3
• changelog +13/−0
• src/Test/QuickCheck.hs +2/−0
• src/Test/QuickCheck/All.hs +20/−10
• src/Test/QuickCheck/Arbitrary.hs +166/−17
• src/Test/QuickCheck/Exception.hs +3/−0
• src/Test/QuickCheck/Features.hs +5/−1
• src/Test/QuickCheck/Function.hs +43/−1
• src/Test/QuickCheck/Gen.hs +22/−2
• src/Test/QuickCheck/Monadic.hs +23/−0
• src/Test/QuickCheck/Property.hs +18/−5
• src/Test/QuickCheck/State.hs +4/−0
• src/Test/QuickCheck/Text.hs +10/−6
• tests/Generators.hs +13/−1
• tests/Split.hs +1/−1

@@ -1,5 +1,5 @@ Name: QuickCheck-Version: 2.14.2+Version: 2.14.3 Cabal-Version: >= 1.10 Build-type: Simple License: BSD3@@ -57,15 +57,17 @@ source-repository this   type:     git   location: https://github.com/nick8325/quickcheck-  tag:      2.14.2+  tag:      2.14.3  flag templateHaskell   Description: Build Test.QuickCheck.All, which uses Template Haskell.   Default: True+  Manual: True  flag old-random   Description: Build against a pre-1.2.0 version of the random package.   Default: False+  Manual: False  library   Hs-source-dirs: src@@ -114,7 +116,10 @@    if impl(ghc) && flag(templateHaskell)     Build-depends: template-haskell >= 2.4-    Other-Extensions: TemplateHaskell+    if impl(ghc >=8.0)+      Other-Extensions: TemplateHaskellQuotes+    else+      Other-Extensions: TemplateHaskell     Exposed-Modules: Test.QuickCheck.All   else     cpp-options: -DNO_TEMPLATE_HASKELL

@@ -1,8 +1,6 @@ This is QuickCheck 2, a library for random testing of program properties. -Install it in the usual way:--$ cabal install+Add `QuickCheck` to your package dependencies to use it in tests or REPL.  The quickcheck-instances [1] companion package provides instances for types in Haskell Platform packages at the cost of additional dependencies.

@@ -1,3 +1,16 @@+QuickCheck 2.14.3 (released 2023-05-31)+	* Add shrinkBoundedEnum (thanks to Jonathan Knowles)+	* Add discardAfter for discarding tests on timeout (thanks to Justus Sagemüller)+	* Add assertWith for monadic testing (thanks to KtorZ)+	* Add functionElements to Test.QuickCheck.Function (thanks to Oleg Grenrus)+	* Add Arbitrary instance for Newline (thanks to Daniel Bramucci)+	* Improve Arbitrary instances for Float and Double (thanks to Oleg Grenrus)+	* Improve arbitrarySizedFractional (thanks to Bodigrim)+	* Fix shrinkRealFrac and shrinkDecimal, which were broken+	* Speed up printing of progress messages (thanks to Bodigrim)+	* Add COMPLETE pragmas for Fn and family (thanks to ilkecan)+	* Make templateHaskell flag manual (thanks to Oleg Grenrus)+ QuickCheck 2.14.2 (released 2020-11-14) 	* Add Arbitrary instances for Tree (thanks to Oleg Grenrus) 	* GHC 9.0 compatibility (thanks to Vilem-Benjamin Liepelt)

@@ -81,6 +81,7 @@   , shrinkMapBy   , shrinkIntegral   , shrinkRealFrac+  , shrinkBoundedEnum   , shrinkDecimal      -- ** Lifting of 'Arbitrary' to unary and binary type constructors@@ -269,6 +270,7 @@   , noShrinking   , withMaxSuccess   , within+  , discardAfter   , once   , again   , mapSize

@@ -1,4 +1,9 @@-{-# LANGUAGE TemplateHaskell, Rank2Types, CPP #-}+{-# LANGUAGE Rank2Types, CPP #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE TemplateHaskellQuotes #-}+#else+{-# LANGUAGE TemplateHaskell #-}+#endif #ifndef NO_SAFE_HASKELL {-# LANGUAGE Trustworthy #-} #endif@@ -24,7 +29,7 @@ import Test.QuickCheck.Property hiding (Result) import Test.QuickCheck.Test import Data.Char-import Data.List+import Data.List (isPrefixOf, nubBy) import Control.Monad  import qualified System.IO as S@@ -44,7 +49,7 @@ -- property, the same scoping problems pop up as in 'quickCheckAll': -- see the note there about @return []@. polyQuickCheck :: Name -> ExpQ-polyQuickCheck x = [| quickCheck $(monomorphic x) |]+polyQuickCheck x = [| quickCheck |] `appE` monomorphic x  -- | Test a polymorphic property, defaulting all type variables to 'Integer'. -- This is just a convenience function that combines 'verboseCheck' and 'monomorphic'.@@ -53,7 +58,7 @@ -- property, the same scoping problems pop up as in 'quickCheckAll': -- see the note there about @return []@. polyVerboseCheck :: Name -> ExpQ-polyVerboseCheck x = [| verboseCheck $(monomorphic x) |]+polyVerboseCheck x = [| verboseCheck |] `appE` monomorphic x  type Error = forall a. String -> a @@ -132,7 +137,7 @@ -- 'forAllProperties' has the same issue with scoping as 'quickCheckAll': -- see the note there about @return []@. forAllProperties :: Q Exp -- :: (Property -> IO Result) -> IO Bool-forAllProperties = [| runQuickCheckAll $allProperties |]+forAllProperties = [| runQuickCheckAll |] `appE` allProperties  -- | List all properties in the current module. --@@ -155,10 +160,15 @@       quickCheckOne :: (Int, String) -> Q [Exp]       quickCheckOne (l, x) = do         exists <- (warning x >> return False) `recover` (reify (mkName x) >> return True)-        if exists then sequence [ [| ($(stringE $ x ++ " from " ++ filename ++ ":" ++ show l),-                                     property $(monomorphic (mkName x))) |] ]+        if exists+         then sequence+          [ tupE+            [ stringE $ x ++ " from " ++ filename ++ ":" ++ show l+            , [| property |] `appE` monomorphic (mkName x)+            ]+          ]          else return []-  [| $(fmap (ListE . concat) (mapM quickCheckOne idents)) :: [(String, Property)] |]+  fmap (ListE . concat) (mapM quickCheckOne idents) `sigE` [t| [(String, Property)] |]  readUTF8File name = S.openFile name S.ReadMode >>=                     set_utf8_io_enc >>=@@ -195,7 +205,7 @@ -- of the module, which means that the later call to 'quickCheckAll' -- can see everything that was defined before the @return []@. Yikes! quickCheckAll :: Q Exp-quickCheckAll = [| $(forAllProperties) quickCheckResult |]+quickCheckAll = forAllProperties `appE` [| quickCheckResult |]  -- | Test all properties in the current module. -- This is just a convenience function that combines 'quickCheckAll' and 'verbose'.@@ -203,7 +213,7 @@ -- 'verboseCheckAll' has the same issue with scoping as 'quickCheckAll': -- see the note there about @return []@. verboseCheckAll :: Q Exp-verboseCheckAll = [| $(forAllProperties) verboseCheckResult |]+verboseCheckAll = forAllProperties `appE` [| verboseCheckResult |]  runQuickCheckAll :: [(String, Property)] -> (Property -> IO Result) -> IO Bool runQuickCheckAll ps qc =

@@ -68,6 +68,7 @@   , shrinkMapBy              -- :: (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]   , shrinkIntegral           -- :: Integral a => a -> [a]   , shrinkRealFrac           -- :: RealFrac a => a -> [a]+  , shrinkBoundedEnum        -- :: (Bounded a, Enum a) => a -> [a]   , shrinkDecimal            -- :: RealFrac a => a -> [a]   -- ** Helper functions for implementing coarbitrary   , coarbitraryIntegral      -- :: Integral a => a -> Gen b -> Gen b@@ -137,6 +138,15 @@  import Data.Version (Version (..)) +#if defined(MIN_VERSION_base)+#if MIN_VERSION_base(4,2,0)+import System.IO+  ( Newline(..)+  , NewlineMode(..)+  )+#endif+#endif+ import Control.Monad   ( liftM   , liftM2@@ -684,11 +694,55 @@                 )  instance Arbitrary Float where-  arbitrary = arbitrarySizedFractional+  arbitrary = oneof+    -- generate 0..1 numbers with full precision+    [ genFloat+    -- generate integral numbers+    , fromIntegral <$> (arbitrary :: Gen Int)+    -- generate fractions with small denominators+    , smallDenominators+    -- uniform -size..size with with denominators ~ size+    , uniform+    -- and uniform -size..size with higher precision+    , arbitrarySizedFractional+    ]+    where+      smallDenominators = sized $ \n -> do+        i <- chooseInt (0, n)+        pure (fromRational (streamNth i rationalUniverse))++      uniform = sized $ \n -> do+        let n' = toInteger n+        b <- chooseInteger (1, max 1 n')+        a <- chooseInteger ((-n') * b, n' * b)+        return (fromRational (a % b))+   shrink    = shrinkDecimal  instance Arbitrary Double where-  arbitrary = arbitrarySizedFractional+  arbitrary = oneof+    -- generate 0..1 numbers with full precision+    [ genDouble+    -- generate integral numbers+    , fromIntegral <$> (arbitrary :: Gen Int)+    -- generate fractions with small denominators+    , smallDenominators+    -- uniform -size..size with with denominators ~ size+    , uniform+    -- and uniform -size..size with higher precision+    , arbitrarySizedFractional+    ]+    where+      smallDenominators = sized $ \n -> do+        i <- chooseInt (0, n)+        pure (fromRational (streamNth i rationalUniverse))++      uniform = sized $ \n -> do+        let n' = toInteger n+        b <- chooseInteger (1, max 1 n')+        a <- chooseInteger ((-n') * b, n' * b)+        return (fromRational (a % b))+   shrink    = shrinkDecimal  instance Arbitrary CChar where@@ -987,8 +1041,26 @@   shrink (ExitFailure x) = ExitSuccess : [ ExitFailure x' | x' <- shrink x ]   shrink _        = [] +#if defined(MIN_VERSION_base)+#if MIN_VERSION_base(4,2,0)+instance Arbitrary Newline where+  arbitrary = elements [LF, CRLF] +  -- The behavior of code for LF is generally simpler than for CRLF+  -- See the documentation for this type, which states that Haskell+  -- Internally always assumes newlines are \n and this type represents+  -- how to translate that to and from the outside world, where LF means+  -- no translation.+  shrink LF = []+  shrink CRLF = [LF] +instance Arbitrary NewlineMode where+  arbitrary = NewlineMode <$> arbitrary <*> arbitrary++  shrink (NewlineMode inNL outNL) = [NewlineMode inNL' outNL' | (inNL', outNL') <- shrink (inNL, outNL)]+#endif+#endif+ -- ** Helper functions for implementing arbitrary  -- | Apply a binary function to random arguments.@@ -1024,17 +1096,14 @@ inBounds :: Integral a => (Int -> a) -> Gen Int -> Gen a inBounds fi g = fmap fi (g `suchThat` (\x -> toInteger x == toInteger (fi x))) --- | Generates a fractional number. The number can be positive or negative+-- | Uniformly generates a fractional number. The number can be positive or negative -- and its maximum absolute value depends on the size parameter. arbitrarySizedFractional :: Fractional a => Gen a arbitrarySizedFractional =-  sized $ \n ->-    let n' = toInteger n in-      do b <- chooseInteger (1, precision)-         a <- chooseInteger ((-n') * b, n' * b)-         return (fromRational (a % b))- where-  precision = 9999999999999 :: Integer+  sized $ \n -> do+    denom <- chooseInt (1, max 1 n)+    numer <- chooseInt (-n*denom, n*denom)+    pure $ fromIntegral numer / fromIntegral denom  -- Useful for getting at minBound and maxBound without having to -- fiddle around with asTypeOf.@@ -1119,7 +1188,7 @@ -- shrinkOrderedList :: (Ord a, Arbitrary a) => [a] -> [[a]] -- shrinkOrderedList = shrinkMap sort id ----- shrinkSet :: (Ord a, Arbitrary a) => Set a -> Set [a]+-- shrinkSet :: (Ord a, Arbitrary a) => Set a -> [Set a] -- shrinkSet = shrinkMap fromList toList -- @ shrinkMap :: Arbitrary a => (a -> b) -> (b -> a) -> b -> [b]@@ -1147,14 +1216,42 @@             (True,  False) -> a + b < 0             (False, True)  -> a + b > 0 +-- | Shrink an element of a bounded enumeration.+--+-- === __Example__+--+-- @+-- data MyEnum = E0 | E1 | E2 | E3 | E4 | E5 | E6 | E7 | E8 | E9+--    deriving (Bounded, Enum, Eq, Ord, Show)+-- @+--+-- >>> shrinkBoundedEnum E9+-- [E0,E5,E7,E8]+--+-- >>> shrinkBoundedEnum E5+-- [E0,E3,E4]+--+-- >>> shrinkBoundedEnum E0+-- []+--+shrinkBoundedEnum :: (Bounded a, Enum a, Eq a) => a -> [a]+shrinkBoundedEnum a+  | a == minBound =+    []+  | otherwise =+    toEnum <$> filter (>= minBoundInt) (shrinkIntegral $ fromEnum a)+  where+    minBoundInt :: Int+    minBoundInt = fromEnum (minBound `asTypeOf` a)+ -- | Shrink a fraction, preferring numbers with smaller -- numerators or denominators. See also 'shrinkDecimal'. shrinkRealFrac :: RealFrac a => a -> [a] shrinkRealFrac x-  | not (x == x)  = 0 : take 10 (iterate (*2) 0) -- NaN-  | not (2*x+1>x) = 0 : takeWhile (<x) (iterate (*2) 0) -- infinity+  | not (x == x)  = 0 : takeWhile (< 1000) numbers -- NaN+  | x > 0 && not (2*x+1>x) = 0 : takeWhile (<x) numbers -- infinity   | x < 0 = negate x:map negate (shrinkRealFrac (negate x))-  | otherwise =+  | otherwise = -- x is finite and >= 0     -- To ensure termination     filter (\y -> abs y < abs x) $       -- Try shrinking to an integer first@@ -1168,14 +1265,16 @@   where     num = numerator (toRational x)     denom = denominator (toRational x)+    numbers = iterate (*2) 1  -- | Shrink a real number, preferring numbers with shorter -- decimal representations. See also 'shrinkRealFrac'. shrinkDecimal :: RealFrac a => a -> [a] shrinkDecimal x-  | not (x == x)  = 0 : take 10 (iterate (*2) 0)        -- NaN-  | not (2*abs x+1>abs x) = 0 : takeWhile (<x) (iterate (*2) 0) -- infinity-  | otherwise =+  | not (x == x)  = 0 : takeWhile (< 1000) numbers -- NaN+  | not (2*abs x+1>abs x) = 0 : takeWhile (<x) numbers -- infinity+  | x < 0 = negate x:map negate (shrinkDecimal (negate x))+  | otherwise = -- x is finite and >= 0     -- e.g. shrink pi =     --   shrink 3 ++ map (/ 10) (shrink 31) ++     --   map (/ 100) (shrink 314) + ...,@@ -1187,6 +1286,9 @@       n <- m:shrink m,       let y = fromRational (fromInteger n / precision),       abs y < abs x ]+  where+    -- 1, 2, 3, ..., 10, 20, 30, ..., 100, 200, 300, etc.+    numbers = concat $ iterate (map (*10)) (map fromInteger [1..9])  -------------------------------------------------------------------------- -- ** CoArbitrary@@ -1447,6 +1549,17 @@ instance CoArbitrary Version where   coarbitrary (Version a b) = coarbitrary (a, b) +#if defined(MIN_VERSION_base)+#if MIN_VERSION_base(4,2,0)+instance CoArbitrary Newline where+  coarbitrary LF = variant 0+  coarbitrary CRLF = variant 1++instance CoArbitrary NewlineMode where+  coarbitrary (NewlineMode inNL outNL) = coarbitrary inNL . coarbitrary outNL+#endif+#endif+ -- ** Helpers for implementing coarbitrary  -- | A 'coarbitrary' implementation for integral numbers.@@ -1481,6 +1594,42 @@ -- | Generates an infinite list. infiniteList :: Arbitrary a => Gen [a] infiniteList = infiniteListOf arbitrary+++--------------------------------------------------------------------------+-- ** Rational helper++infixr 5 :<+data Stream a = !a :< Stream a++streamNth :: Int -> Stream a -> a+streamNth n (x :< xs) | n <= 0    = x+                      | otherwise = streamNth (n - 1) xs++-- We read into this stream only with ~size argument,+-- so it's ok to have it as CAF.+--+rationalUniverse :: Stream Rational+rationalUniverse = 0 :< 1 :< (-1) :< go leftSideStream+  where+    go (x :< xs) =+      let nx = -x+          rx = recip x+          nrx = -rx+      in nx `seq` rx `seq` nrx `seq` (x :< rx :< nx :< nrx :< go xs)++-- All the rational numbers on the left side of the Calkin-Wilf tree,+-- in breadth-first order.+leftSideStream :: Stream Rational+leftSideStream = (1 % 2) :< go leftSideStream+  where+    go (x :< xs) =+        lChild `seq` rChild `seq`+        (lChild :< rChild :< go xs)+      where+        nd = numerator x + denominator x+        lChild = numerator x % nd+        rChild = nd % denominator x  -------------------------------------------------------------------------- -- the end.

@@ -5,6 +5,9 @@  {-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE CPP #-}+#ifndef NO_SAFE_HASKELL+{-# LANGUAGE Safe #-}+#endif module Test.QuickCheck.Exception where  #if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ < 700)

@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#ifndef NO_SAFE_HASKELL+{-# LANGUAGE Safe #-}+#endif {-# OPTIONS_HADDOCK hide #-} module Test.QuickCheck.Features where @@ -9,7 +13,7 @@ import Test.QuickCheck.Text import qualified Data.Set as Set import Data.Set(Set)-import Data.List+import Data.List (intersperse) import Data.IORef import Data.Maybe 

@@ -48,6 +48,7 @@   , functionIntegral   , functionRealFrac   , functionBoundedEnum+  , functionElements   , functionVoid   , functionMapWith   , functionEitherWith@@ -83,6 +84,15 @@ import Data.Functor.Identity import qualified Data.Monoid as Monoid +#if defined(MIN_VERSION_base)+#if MIN_VERSION_base(4,2,0)+import System.IO+  ( Newline(..)+  , NewlineMode(..)+  )+#endif+#endif+ #ifndef NO_FIXED import Data.Fixed #endif@@ -165,8 +175,12 @@ -- Use only for small types (i.e. not integers): creates -- the list @['minBound'..'maxBound']@! functionBoundedEnum :: (Eq a, Bounded a, Enum a) => (a->b) -> (a:->b)-functionBoundedEnum f = Table [(x,f x) | x <- [minBound..maxBound]]+functionBoundedEnum = functionElements [minBound..maxBound] +-- | Provides a 'Function' instance for small finite types.+functionElements :: Eq a => [a] ->  (a->b) -> (a:->b)+functionElements xs f = Table [(x,f x) | x <- xs]+ -- | Provides a 'Function' instance for types with 'RealFrac'. functionRealFrac :: RealFrac a => (a->b) -> (a:->b) functionRealFrac = functionMap toRational fromRational@@ -367,6 +381,25 @@ instance Function Word64 where   function = functionIntegral +#if defined(MIN_VERSION_base)+#if MIN_VERSION_base(4,2,0)+instance Function Newline where+  function = functionMap g h+    where+      g LF = False+      g CRLF = True++      h False = LF+      h True = CRLF++instance Function NewlineMode where+  function = functionMap g h+    where+      g (NewlineMode inNL outNL) = (inNL,outNL)+      h (inNL,outNL) = NewlineMode inNL outNL+#endif+#endif+ -- instances for Data.Monoid newtypes  instance Function a => Function (Monoid.Dual a) where@@ -525,6 +558,9 @@ pattern Fn :: (a -> b) -> Fun a b #endif pattern Fn f <- (applyFun -> f)+#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE Fn #-}+#endif  -- | A modifier for testing binary functions. --@@ -534,12 +570,18 @@ pattern Fn2 :: (a -> b -> c) -> Fun (a, b) c #endif pattern Fn2 f <- (applyFun2 -> f)+#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE Fn2 #-}+#endif  -- | A modifier for testing ternary functions. #if __GLASGOW_HASKELL__ >= 800 pattern Fn3 :: (a -> b -> c -> d) -> Fun (a, b, c) d #endif pattern Fn3 f <- (applyFun3 -> f)+#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE Fn3 #-}+#endif #endif  mkFun :: (a :-> b) -> b -> Fun a b

@@ -2,6 +2,9 @@ #ifndef NO_ST_MONAD {-# LANGUAGE Rank2Types #-} #endif+#ifndef NO_SAFE_HASKELL+{-# LANGUAGE Safe #-}+#endif -- | Test case generation. -- -- __Note__: the contents of this module (except for the definition of@@ -32,11 +35,11 @@   ( Applicative(..) )  import Test.QuickCheck.Random-import Data.List+import Data.List (sortBy) import Data.Ord import Data.Maybe #ifndef NO_SPLITMIX-import System.Random.SplitMix(bitmaskWithRejection64', SMGen, nextInteger)+import System.Random.SplitMix(bitmaskWithRejection64', nextInteger, nextDouble, nextFloat, SMGen) #endif import Data.Word import Data.Int@@ -238,6 +241,23 @@ sample g =   do cases <- sample' g      mapM_ print cases++--------------------------------------------------------------------------+-- ** Floating point++-- | Generate 'Double' in 0..1 range+genDouble :: Gen Double++-- | Generate 'Float' in 0..1 range+genFloat :: Gen Float++#ifndef NO_SPLITMIX+genDouble = MkGen $ \(QCGen g) _ -> fst (nextDouble g)+genFloat  = MkGen $ \(QCGen g) _ -> fst (nextFloat g)+#else+genDouble = choose (0,1)+genFloat  = choose (0,1)+#endif  -------------------------------------------------------------------------- -- ** Common generator combinators

@@ -56,6 +56,7 @@   -- * Monadic specification combinators   , run   , assert+  , assertWith   , pre   , wp   , pick@@ -149,6 +150,28 @@ assert :: Monad m => Bool -> PropertyM m () assert True  = return () assert False = fail "Assertion failed"++-- | Like 'assert' but allows caller to specify an explicit message to show on failure.+--+-- __Example:__+--+-- @+-- do+--   assertWith True  "My first predicate."+--   assertWith False "My other predicate."+--   ...+-- @+--+-- @+-- Assertion failed (after 2 tests):+--     Passed: My first predicate+--     Failed: My other predicate+-- @+assertWith :: Monad m => Bool -> String -> PropertyM m ()+assertWith condition msg = do+    let prefix = if condition then "Passed: " else "Failed: "+    monitor $ counterexample $ prefix ++ msg+    assert condition  -- should think about strictness/exceptions here -- | Tests preconditions. Unlike 'assert' this does not cause the

@@ -217,12 +217,12 @@   fmap f (MkRose x rs) = MkRose (f x) [ fmap f r | r <- rs ]  instance Applicative Rose where-  pure = return+  pure x = MkRose x []   -- f must be total   (<*>) = liftM2 ($)  instance Monad Rose where-  return x = MkRose x []+  return = pure   -- k must be total   m >>= k  = joinRose (fmap k m) @@ -778,7 +778,20 @@ -- -- Bad: @prop_foo a b c = ...; main = quickCheck (within 1000000 prop_foo)@ within :: Testable prop => Int -> prop -> Property-within n = mapRoseResult f+within n = onTimeout+   (failed { reason = "Timeout of " ++ show n ++ " microseconds exceeded." })+   n++-- | Discards the test case if it does not complete within the given+-- number of microseconds. This can be useful when testing algorithms+-- that have pathological cases where they run extremely slowly.+discardAfter :: Testable prop => Int -> prop -> Property+discardAfter n = onTimeout+   (rejected { reason = "Timeout of " ++ show n ++ " microseconds exceeded." })+   n++onTimeout :: Testable prop => Result -> Int -> prop -> Property+onTimeout timeoutResult n = mapRoseResult f   where     f rose = ioRose $ do       let m `orError` x = fmap (fromMaybe x) m@@ -787,11 +800,11 @@       res' <- timeout n (protectResult (return res)) `orError`         timeoutResult       return (MkRose res' (map f roses))--    timeoutResult = failed { reason = "Timeout of " ++ show n ++ " microseconds exceeded." } #ifdef NO_TIMEOUT     timeout _ = fmap Just #endif++  -- | Explicit universal quantification: uses an explicitly given -- test case generator.

@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#ifndef NO_SAFE_HASKELL+{-# LANGUAGE Safe #-}+#endif {-# OPTIONS_HADDOCK hide #-} -- | QuickCheck's internal state. Internal QuickCheck module. module Test.QuickCheck.State where

@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#ifndef NO_SAFE_HASKELL+{-# LANGUAGE Safe #-}+#endif {-# OPTIONS_HADDOCK hide #-} -- | Terminal control and text helper functions. Internal QuickCheck module. module Test.QuickCheck.Text@@ -43,7 +47,7 @@   )  import Data.IORef-import Data.List+import Data.List (intersperse, transpose) import Text.Printf import Test.QuickCheck.Exception @@ -222,11 +226,11 @@ putLine tm s = putPart tm (s ++ "\n")  putTemp tm@(MkTerminal _ tmp _ err) s =-  do n <- readIORef tmp-     err $-       replicate n ' ' ++ replicate n '\b' ++-       s ++ [ '\b' | _ <- s ]-     writeIORef tmp (length s)+  do oldLen <- readIORef tmp+     let newLen = length s+         maxLen = max newLen oldLen+     err $ s ++ replicate (maxLen - newLen) ' ' ++ replicate maxLen '\b'+     writeIORef tmp newLen  -------------------------------------------------------------------------- -- the end.

@@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving, Rank2Types, NoMonomorphismRestriction #-} import Test.QuickCheck import Test.QuickCheck.Gen.Unsafe-import Data.List+import Data.List (inits, sort, nub) import Data.Int import Data.Word import Data.Version@@ -203,6 +203,18 @@  prop_B1 :: B1 -> Property prop_B1 (B1 n) = expectFailure $ n === n + 1++-- Double properties:++-- We occasionaly generate duplicates.+prop_double_duplicate_list :: [Double] -> Property+prop_double_duplicate_list xs = expectFailure $ nub xs === xs where+  sorted = sort xs++-- And enough numbers to show basic IEEE pit falls.+prop_double_assoc :: Double -> Double -> Double -> Property+prop_double_assoc x y z = expectFailure $ x + (y + z) === (x + y) + z+  return [] main = do True <- $forAllProperties (quickCheckWithResult stdArgs { maxShrinks = 10000 }); return ()

@@ -1,6 +1,6 @@ import Test.QuickCheck import Test.QuickCheck.Random-import Data.List+import Data.List (group, isPrefixOf, sort)  -- This type allows us to run integerVariant and get a list of bits out. newtype Splits = Splits { unSplits :: [Bool] } deriving (Eq, Ord, Show)