QuickCheck 2.10.1 → 2.11

raw patch · 9 files changed

+228/−49 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• QuickCheck.cabal +3/−3
• Test/QuickCheck.hs +6/−1
• Test/QuickCheck/All.hs +13/−3
• Test/QuickCheck/Arbitrary.hs +21/−1
• Test/QuickCheck/Gen.hs +1/−1
• Test/QuickCheck/Modifiers.hs +113/−5
• Test/QuickCheck/Property.hs +14/−1
• Test/QuickCheck/Test.hs +41/−33
• changelog +16/−1

@@ -1,5 +1,5 @@ Name: QuickCheck-Version: 2.10.1+Version: 2.11 Cabal-Version: >= 1.8 Build-type: Simple License: BSD3@@ -49,7 +49,7 @@ source-repository this   type:     git   location: https://github.com/nick8325/quickcheck-  tag:      2.10.1+  tag:      2.11  flag templateHaskell   Description: Build Test.QuickCheck.All, which uses Template Haskell.@@ -118,7 +118,7 @@   if !impl(ghc)     -- 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 -DNO_GENERICS -DNO_TEMPLATE_HASKELL -DNO_SAFE_HASKELL+    cpp-options: -DNO_TIMEOUT -DNO_NEWTYPE_DERIVING -DNO_GENERICS -DNO_TEMPLATE_HASKELL -DNO_SAFE_HASKELL -DNO_TYPEABLE     if !impl(hugs) && !impl(uhc)       cpp-options: -DNO_ST_MONAD -DNO_MULTI_PARAM_TYPE_CLASSES 

@@ -56,6 +56,7 @@   , quickCheckAll   , verboseCheckAll   , forAllProperties+  , allProperties     -- ** Testing polymorphic properties   , polyQuickCheck   , polyVerboseCheck@@ -106,6 +107,9 @@   , shrink2      -- ** Helper functions for implementing arbitrary+  , applyArbitrary2+  , applyArbitrary3+  , applyArbitrary4   , arbitrarySizedIntegral   , arbitrarySizedNatural   , arbitrarySizedFractional@@ -142,6 +146,7 @@   , Fixed(..)   , OrderedList(..)   , NonEmptyList(..)+  , InfiniteList(..)   , Positive(..)   , NonZero(..)   , NonNegative(..)@@ -158,7 +163,7 @@   , PrintableString(..)      -- ** Functions-  , Fun+  , Fun (..)   , applyFun   , applyFun2   , applyFun3

@@ -11,6 +11,7 @@   quickCheckAll,   verboseCheckAll,   forAllProperties,+  allProperties,   -- ** Testing polymorphic properties   polyQuickCheck,   polyVerboseCheck,@@ -123,7 +124,16 @@ -- 'forAllProperties' has the same issue with scoping as 'quickCheckAll': -- see the note there about @return []@. forAllProperties :: Q Exp -- :: (Property -> IO Result) -> IO Bool-forAllProperties = do+forAllProperties = [| runQuickCheckAll $allProperties |]++-- | List all properties in the current module.+--+-- @$'allProperties'@ has type @[('String', 'Property')]@.+--+-- 'allProperties' has the same issue with scoping as 'quickCheckAll':+-- see the note there about @return []@.+allProperties :: Q Exp+allProperties = do   Loc { loc_filename = filename } <- location   when (filename == "<interactive>") $ error "don't run this interactively"   ls <- runIO (fmap lines (readUTF8File filename))@@ -140,7 +150,7 @@         if exists then sequence [ [| ($(stringE $ x ++ " from " ++ filename ++ ":" ++ show l),                                      property $(monomorphic (mkName x))) |] ]          else return []-  [| runQuickCheckAll $(fmap (ListE . concat) (mapM quickCheckOne idents)) |]+  [| $(fmap (ListE . concat) (mapM quickCheckOne idents)) :: [(String, Property)] |]  readUTF8File name = S.openFile name S.ReadMode >>=                     set_utf8_io_enc >>=@@ -169,7 +179,7 @@ -- and then execute @runTests@. -- -- Note: the bizarre @return []@ in the example above is needed on--- GHC 7.8; without it, 'quickCheckAll' will not be able to find+-- GHC 7.8 and later; without it, 'quickCheckAll' will not be able to find -- any of the properties. For the curious, the @return []@ is a -- Template Haskell splice that makes GHC insert the empty list -- of declarations at that point in the program; GHC typechecks

@@ -36,6 +36,9 @@   , shrink2    -- ** Helper functions for implementing arbitrary+  , applyArbitrary2+  , applyArbitrary3+  , applyArbitrary4   , arbitrarySizedIntegral        -- :: Integral a => Gen a   , arbitrarySizedNatural         -- :: Integral a => Gen a   , arbitraryBoundedIntegral      -- :: (Bounded a, Integral a) => Gen a@@ -180,7 +183,8 @@   --   -- There is no generic @arbitrary@ implementation included because we don't   -- know how to make a high-quality one. If you want one, consider using the-  -- <http://hackage.haskell.org/package/testing-feat testing-feat> package.+  -- <http://hackage.haskell.org/package/testing-feat testing-feat> or+  -- <http://hackage.haskell.org/package/generic-random generic-random> packages.   --   -- The <http://www.cse.chalmers.se/~rjmh/QuickCheck/manual.html QuickCheck manual>   -- goes into detail on how to write good generators. Make sure to look at it,@@ -972,6 +976,22 @@   -- ** Helper functions for implementing arbitrary++-- | Apply a binary function to random arguments.+applyArbitrary2 :: (Arbitrary a, Arbitrary b) => (a -> b -> r) -> Gen r+applyArbitrary2 f = liftA2 f arbitrary arbitrary++-- | Apply a ternary function to random arguments.+applyArbitrary3+  :: (Arbitrary a, Arbitrary b, Arbitrary c)+  => (a -> b -> c -> r) -> Gen r+applyArbitrary3 f = liftA3 f arbitrary arbitrary arbitrary++-- | Apply a function of arity 4 to random arguments.+applyArbitrary4+  :: (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)+  => (a -> b -> c -> d -> r) -> Gen r+applyArbitrary4 f = applyArbitrary3 (uncurry f)  -- | Generates an integral number. The number can be positive or negative -- and its maximum absolute value depends on the size parameter.

@@ -48,7 +48,7 @@  instance Applicative Gen where   pure  = return-  (<*>) = ap+  gf <*> gx = gf >>= \f -> fmap f gx  instance Monad Gen where   return x =

@@ -8,6 +8,9 @@ #ifndef NO_NEWTYPE_DERIVING {-# LANGUAGE GeneralizedNewtypeDeriving #-} #endif+#ifndef NO_TYPEABLE+{-# LANGUAGE DeriveDataTypeable #-}+#endif -- | Modifiers for test data. -- -- These types do things such as restricting the kind of test data that can be generated.@@ -45,6 +48,7 @@   , Fixed(..)   , OrderedList(..)   , NonEmptyList(..)+  , InfiniteList(..)   , Positive(..)   , NonZero(..)   , NonNegative(..)@@ -67,12 +71,17 @@  import Test.QuickCheck.Gen import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Exception  import Data.List   ( sort   ) import Data.Ix (Ix) +#ifndef NO_TYPEABLE+import Data.Typeable (Typeable)+#endif+ -------------------------------------------------------------------------- -- | @Blind x@: as x, but x does not have to be in the 'Show' class. newtype Blind a = Blind {getBlind :: a}@@ -80,6 +89,9 @@ #ifndef NO_NEWTYPE_DERIVING           , Num, Integral, Real, Enum #endif+#ifndef NO_TYPEABLE+          , Typeable+#endif           )  instance Functor Blind where@@ -100,6 +112,9 @@ #ifndef NO_NEWTYPE_DERIVING           , Num, Integral, Real, Enum #endif+#ifndef NO_TYPEABLE+          , Typeable+#endif           )  instance Functor Fixed where@@ -113,7 +128,11 @@ -------------------------------------------------------------------------- -- | @Ordered xs@: guarantees that xs is ordered. newtype OrderedList a = Ordered {getOrdered :: [a]}- deriving ( Eq, Ord, Show, Read )+ deriving ( Eq, Ord, Show, Read+#ifndef NO_TYPEABLE+          , Typeable+#endif+          )  instance Functor OrderedList where   fmap f (Ordered x) = Ordered (map f x)@@ -130,7 +149,11 @@ -------------------------------------------------------------------------- -- | @NonEmpty xs@: guarantees that xs is non-empty. newtype NonEmptyList a = NonEmpty {getNonEmpty :: [a]}- deriving ( Eq, Ord, Show, Read )+ deriving ( Eq, Ord, Show, Read+#ifndef NO_TYPEABLE+          , Typeable+#endif+          )  instance Functor NonEmptyList where   fmap f (NonEmpty x) = NonEmpty (map f x)@@ -144,6 +167,61 @@     , not (null xs')     ] +----------------------------------------------------------------------+-- | @InfiniteList xs _@: guarantees that xs is an infinite list.+-- When a counterexample is found, only prints the prefix of xs+-- that was used by the program.+--+-- Here is a contrived example property:+--+-- > prop_take_10 :: InfiniteList Char -> Bool+-- > prop_take_10 (InfiniteList xs _) =+-- >   or [ x == 'a' | x <- take 10 xs ]+--+-- In the following counterexample, the list must start with @"bbbbbbbbbb"@ but+-- the remaining (infinite) part can contain anything:+--+-- >>> quickCheck prop_take_10+-- *** Failed! Falsifiable (after 1 test and 14 shrinks):+-- "bbbbbbbbbb" ++ ...+data InfiniteList a =+  InfiniteList {+    getInfiniteList :: [a],+    infiniteListInternalData :: InfiniteListInternalData a }++-- Uses a similar trick to Test.QuickCheck.Function:+-- the Arbitrary instance generates an infinite list, which is+-- reduced to a finite prefix by shrinking. We use discard to+-- check that nothing coming after the finite prefix is used+-- (see makeInfiniteList).+data InfiniteListInternalData a = Infinite [a] | FinitePrefix [a]++infiniteListFromData :: InfiniteListInternalData a -> InfiniteList a+infiniteListFromData info@(Infinite xs) = InfiniteList xs info+infiniteListFromData info@(FinitePrefix xs) =+  InfiniteList (xs ++ discard) info++instance Show a => Show (InfiniteList a) where+  showsPrec _ (InfiniteList _ (Infinite _)) =+    ("<infinite list>" ++)+  showsPrec n (InfiniteList _ (FinitePrefix xs)) =+    (if n > 10 then ('(':) else id) .+    showsPrec 0 xs .+    (" ++ ..." ++) .+    (if n > 10 then (')':) else id)++instance Arbitrary a => Arbitrary (InfiniteList a) where+  arbitrary = fmap infiniteListFromData arbitrary+  shrink (InfiniteList _ info) =+    map infiniteListFromData (shrink info)++instance Arbitrary a => Arbitrary (InfiniteListInternalData a) where+  arbitrary = fmap Infinite infiniteList+  shrink (Infinite xs) =+    [FinitePrefix (take n xs) | n <- map (2^) [0..]]+  shrink (FinitePrefix xs) =+    map FinitePrefix (shrink xs)+ -------------------------------------------------------------------------- -- | @Positive x@: guarantees that @x \> 0@. newtype Positive a = Positive {getPositive :: a}@@ -151,6 +229,9 @@ #ifndef NO_NEWTYPE_DERIVING           , Enum #endif+#ifndef NO_TYPEABLE+          , Typeable+#endif           )  instance Functor Positive where@@ -174,6 +255,9 @@ #ifndef NO_NEWTYPE_DERIVING           , Enum #endif+#ifndef NO_TYPEABLE+          , Typeable+#endif           )  instance Functor NonZero where@@ -191,6 +275,9 @@ #ifndef NO_NEWTYPE_DERIVING           , Enum #endif+#ifndef NO_TYPEABLE+          , Typeable+#endif           )  instance Functor NonNegative where@@ -220,6 +307,9 @@ #ifndef NO_NEWTYPE_DERIVING           , Num, Integral, Real, Enum, Ix #endif+#ifndef NO_TYPEABLE+          , Typeable+#endif           )  instance Functor Large where@@ -237,6 +327,9 @@ #ifndef NO_NEWTYPE_DERIVING           , Num, Integral, Real, Enum, Ix #endif+#ifndef NO_TYPEABLE+          , Typeable+#endif           )  instance Functor Small where@@ -253,6 +346,9 @@ #ifndef NO_NEWTYPE_DERIVING           , Num, Integral, Real, Enum #endif+#ifndef NO_TYPEABLE+          , Typeable+#endif           )  instance Functor Shrink2 where@@ -349,7 +445,11 @@ -------------------------------------------------------------------------- -- | @ASCIIString@: generates an ASCII string. newtype ASCIIString = ASCIIString {getASCIIString :: String}-  deriving ( Eq, Ord, Show, Read )+  deriving ( Eq, Ord, Show, Read+#ifndef NO_TYPEABLE+          , Typeable+#endif+           )  instance Arbitrary ASCIIString where   arbitrary = ASCIIString `fmap` listOf arbitraryASCIIChar@@ -359,7 +459,11 @@ -- | @UnicodeString@: generates a unicode String. -- The string will not contain surrogate pairs. newtype UnicodeString = UnicodeString {getUnicodeString :: String}-  deriving ( Eq, Ord, Show, Read )+  deriving ( Eq, Ord, Show, Read+#ifndef NO_TYPEABLE+          , Typeable+#endif+           )  instance Arbitrary UnicodeString where   arbitrary = UnicodeString `fmap` listOf arbitraryUnicodeChar@@ -369,7 +473,11 @@ -- | @PrintableString@: generates a printable unicode String. -- The string will not contain surrogate pairs. newtype PrintableString = PrintableString {getPrintableString :: String}-  deriving ( Eq, Ord, Show, Read )+  deriving ( Eq, Ord, Show, Read+#ifndef NO_TYPEABLE+          , Typeable+#endif+           )  instance Arbitrary PrintableString where   arbitrary = PrintableString `fmap` listOf arbitraryPrintableChar

@@ -1,5 +1,8 @@ -- | Combinators for constructing properties. {-# LANGUAGE CPP #-}+#ifndef NO_TYPEABLE+{-# LANGUAGE DeriveDataTypeable #-}+#endif #ifndef NO_SAFE_HASKELL {-# LANGUAGE Safe #-} #endif@@ -28,6 +31,9 @@ #ifndef NO_DEEPSEQ import Control.DeepSeq #endif+#ifndef NO_TYPEABLE+import Data.Typeable (Typeable)+#endif  -------------------------------------------------------------------------- -- fixities@@ -71,6 +77,9 @@  -- | The type of properties. newtype Property = MkProperty { unProperty :: Gen Prop }+#ifndef NO_TYPEABLE+  deriving (Typeable)+#endif  -- | The class of properties, i.e., types which QuickCheck knows how to test. -- Typically a property will be a function returning 'Bool' or 'Property'.@@ -617,7 +626,11 @@ infix 4 === (===) :: (Eq a, Show a) => a -> a -> Property x === y =-  counterexample (show x ++ " /= " ++ show y) (x == y)+  counterexample (show x ++ interpret res ++ show y) res+  where+    res = x == y+    interpret True  = " == "+    interpret False = " /= "  #ifndef NO_DEEPSEQ -- | Checks that a value is total, i.e., doesn't crash when evaluated.

@@ -304,10 +304,7 @@                 } f         MkResult{ok = Just False} -> -- failed test-         do if expect res-              then putPart (terminal st) (bold "*** Failed! ")-              else putPart (terminal st) "+++ OK, failed as expected. "-            (numShrinks, totFailed, lastFailed, res) <- foundFailure st res ts+         do (numShrinks, totFailed, lastFailed, res) <- foundFailure st res ts             theOutput <- terminalOutput (terminal st)             if not (expect res) then               return Success{ labels = summary st,@@ -330,6 +327,44 @@  where   (rnd1,rnd2) = split (randomSeed st) +failureSummary :: State -> P.Result -> String+failureSummary st res = fst (failureSummaryAndReason st res)++failureReason :: State -> P.Result -> [String]+failureReason st res = snd (failureSummaryAndReason st res)++failureSummaryAndReason :: State -> P.Result -> (String, [String])+failureSummaryAndReason st res = (summary, full)+  where+    summary =+      header +++      short 26 (oneLine reason ++ " ") +++      count ++ "..."++    full =+      (header +++       (if isOneLine reason then reason ++ " " else "") +++       count ++ ":"):+      if isOneLine reason then [] else lines reason++    reason = P.reason res++    header =+      if expect res then+        bold "*** Failed! "+      else "+++ OK, failed as expected. "++    count =+      "(after " ++ number (numSuccessTests st+1) "test" +++      concat [+        " and " +++        show (numSuccessShrinks st) +++        concat [ "." ++ show (numTryShrinks st) | numTryShrinks st > 0 ] +++        " shrink" +++        (if numSuccessShrinks st == 1 && numTryShrinks st == 0 then "" else "s")+        | numSuccessShrinks st > 0 || numTryShrinks st > 0 ] +++      ")"+ summary :: State -> [(String, Double)] summary st = reverse            . sortBy (comparing snd)@@ -408,20 +443,7 @@     localMinFound st res localMin st res _ ts = do   r <- tryEvaluateIO $-    putTemp (terminal st)-      ( short 26 (oneLine (P.reason res))-     ++ " (after " ++ number (numSuccessTests st+1) "test"-     ++ concat [ " and "-              ++ show (numSuccessShrinks st)-              ++ concat [ "." ++ show (numTryShrinks st) | numTryShrinks st > 0 ]-              ++ " shrink"-              ++ (if numSuccessShrinks st == 1-                  && numTryShrinks st == 0-                  then "" else "s")-               | numSuccessShrinks st > 0 || numTryShrinks st > 0-               ]-     ++ ")..."-      )+    putTemp (terminal st) (failureSummary st res)   case r of     Left err ->       localMinFound st (exception "Exception while printing status message" err) { callbacks = callbacks res }@@ -447,21 +469,7 @@  localMinFound :: State -> P.Result -> IO (Int, Int, Int, P.Result) localMinFound st res =-  do let report = concat [-           "(after " ++ number (numSuccessTests st+1) "test",-           concat [ " and " ++ number (numSuccessShrinks st) "shrink"-                  | numSuccessShrinks st > 0-                  ],-           "): "-           ]-     if isOneLine (P.reason res)-       then putLine (terminal st) (P.reason res ++ " " ++ report)-       else do-         putLine (terminal st) report-         sequence_-           [ putLine (terminal st) msg-           | msg <- lines (P.reason res)-           ]+  do sequence_ [ putLine (terminal st) msg | msg <- failureReason st res ]      callbackPostFinalFailure st res      -- NB no need to check if callbacks threw an exception because      -- we are about to return to the user anyway

@@ -1,4 +1,19 @@-QuickCheck 2.10.1 (release 2017-10-06)+QuickCheck 2.11 (released 2018-01-12)+	* New features:+		- InfiniteList modifier generates infinite lists and shows+		  only the relevant part.+		- applyArbitrary2/3/4 for applying a function to random+		  arguments.+		- Template Haskell function allProperties returns all+		  properties in a module.++	* Applicative Gen instances do less splitting.+	* Property now has a Typeable instance.+	* (===) now prints correct output when the property is true.+	* Test.QuickCheck now exports Fun constructor.+	* verboseCheck output is now slightly less confusing.++QuickCheck 2.10.1 (released 2017-10-06) 	* Arbitrary instances for Foreign.C.Types are available in more 	  GHC versions. 	* Fixed a bug where withMaxSuccess didn't adjust the allowed