QuickCheck 2.5.1.1 → 2.6

raw patch · 5 files changed

+64/−46 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• QuickCheck.cabal +3/−3
• Test/QuickCheck/Exception.hs +16/−23
• Test/QuickCheck/Function.hs +19/−6
• Test/QuickCheck/Test.hs +3/−2
• Test/QuickCheck/Text.hs +23/−12

@@ -1,5 +1,5 @@ Name: QuickCheck-Version: 2.5.1.1+Version: 2.6 Cabal-Version: >= 1.6 Build-type: Simple License: BSD3@@ -29,11 +29,11 @@  source-repository head   type:     git-  location: git://github.com/nick8325/quickcheck+  location: https://github.com/nick8325/quickcheck  source-repository this   type:     git-  location: git://github.com/nick8325/quickcheck+  location: https://github.com/nick8325/quickcheck   tag:      2.5.1.1  flag base3

@@ -20,19 +20,10 @@ #endif #endif -#if defined(OLD_EXCEPTIONS)-import Control.Exception(evaluate, try, Exception(..), throw)-#else-#if defined(NO_BASE_3)-import Control.Exception+#if defined(OLD_EXCEPTIONS) || defined(NO_BASE_3)+import qualified Control.Exception as E #else-import Control.Exception.Extensible-#endif-  (evaluate, try, SomeException(SomeException), ErrorCall(..), throw-#if defined(GHC_INTERRUPT)-  , AsyncException(UserInterrupt)-#endif-  )+import qualified Control.Exception.Extensible as E #endif  #if defined(GHC_INTERRUPT)@@ -46,9 +37,9 @@ #endif  #if defined(OLD_EXCEPTIONS)-type AnException = Control.Exception.Exception+type AnException = E.Exception #else-type AnException = SomeException+type AnException = E.SomeException #endif  --------------------------------------------------------------------------@@ -58,7 +49,7 @@ tryEvaluate x = tryEvaluateIO (return x)  tryEvaluateIO :: IO a -> IO (Either AnException a)-tryEvaluateIO m = try (m >>= evaluate)+tryEvaluateIO m = E.try (m >>= E.evaluate) --tryEvaluateIO m = Right `fmap` m  -- Test if an exception was a ^C.@@ -67,13 +58,13 @@  #if defined(GHC_INTERRUPT) #if defined(OLD_EXCEPTIONS)-isInterrupt (DynException e) = fromDynamic e == Just Interrupted+isInterrupt (E.DynException e) = fromDynamic e == Just Interrupted isInterrupt _ = False #elif defined(GHCI_INTERRUPTED_EXCEPTION)-isInterrupt (SomeException e) =-  cast e == Just Interrupted || cast e == Just UserInterrupt+isInterrupt (E.SomeException e) =+  cast e == Just Interrupted || cast e == Just E.UserInterrupt #else-isInterrupt (SomeException e) = cast e == Just UserInterrupt+isInterrupt (E.SomeException e) = cast e == Just E.UserInterrupt #endif  #else /* !defined(GHC_INTERRUPT) */@@ -87,20 +78,22 @@ discard :: a  isDiscard :: AnException -> Bool-(discard, isDiscard) = (throw (ErrorCall msg), isDiscard)+(discard, isDiscard) = (E.throw (E.ErrorCall msg), isDiscard)  where   msg = "DISCARD. " ++         "You should not see this exception, it is internal to QuickCheck." #if defined(OLD_EXCEPTIONS)-  isDiscard (ErrorCall msg') = msg' == msg+  isDiscard (E.ErrorCall msg') = msg' == msg   isDiscard _ = False #else-  isDiscard (SomeException e) =+  isDiscard (E.SomeException e) =     case cast e of-      Just (ErrorCall msg') -> msg' == msg+      Just (E.ErrorCall msg') -> msg' == msg       _ -> False #endif +finally :: IO a -> IO b -> IO a+finally = E.finally  -------------------------------------------------------------------------- -- the end.

@@ -32,7 +32,6 @@  import Test.QuickCheck.Arbitrary import Test.QuickCheck.Poly-import Test.QuickCheck.Exception(discard)  import Data.Char import Data.Word@@ -111,6 +110,23 @@ instance (Function a, Function b) => Function (Either a b) where   function f = function (f . Left) :+: function (f . Right) +-- tuple convenience instances++instance (Function a, Function b, Function c) => Function (a,b,c) where+  function = functionMap (\(a,b,c) -> (a,(b,c))) (\(a,(b,c)) -> (a,b,c))++instance (Function a, Function b, Function c, Function d) => Function (a,b,c,d) where+  function = functionMap (\(a,b,c,d) -> (a,(b,c,d))) (\(a,(b,c,d)) -> (a,b,c,d))++instance (Function a, Function b, Function c, Function d, Function e) => Function (a,b,c,d,e) where+  function = functionMap (\(a,b,c,d,e) -> (a,(b,c,d,e))) (\(a,(b,c,d,e)) -> (a,b,c,d,e))++instance (Function a, Function b, Function c, Function d, Function e, Function f) => Function (a,b,c,d,e,f) where+  function = functionMap (\(a,b,c,d,e,f) -> (a,(b,c,d,e,f))) (\(a,(b,c,d,e,f)) -> (a,b,c,d,e,f))++instance (Function a, Function b, Function c, Function d, Function e, Function f, Function g) => Function (a,b,c,d,e,f,g) where+  function = functionMap (\(a,b,c,d,e,f,g) -> (a,(b,c,d,e,f,g))) (\(a,(b,c,d,e,f,g)) -> (a,b,c,d,e,f,g))+ -- other instances  functionMap :: Function b => (a->b) -> (b->a) -> (a->c) -> (a:->c)@@ -207,8 +223,8 @@   pair p   = Pair p  shrinkFun shr (p :+: q) =-  [ p .+. Nil `whenever` not (isNil q) ] ++-  [ Nil .+. q `whenever` not (isNil p) ] +++  [ p .+. Nil | not (isNil q) ] +++  [ Nil .+. q | not (isNil p) ] ++   [ p  .+. q' | q' <- shrinkFun shr q ] ++   [ p' .+. q  | p' <- shrinkFun shr p ]  where@@ -218,9 +234,6 @@    Nil .+. Nil = Nil   p   .+. q   = p :+: q--  p `whenever` True = p-  p `whenever` False = discard  shrinkFun shr (Unit c) =   [ Nil ] ++

@@ -60,6 +60,7 @@     , usedSeed       :: StdGen         -- ^ what seed was used     , usedSize       :: Int            -- ^ what was the test size     , reason         :: String         -- ^ what was the reason+    , interrupted    :: Bool           -- ^ did the user press ctrl-C?     , labels         :: [(String,Int)] -- ^ labels and frequencies found during all successful tests     , output         :: String         -- ^ printed output     }@@ -100,8 +101,7 @@  -- | Tests a property, using test arguments, produces a test result, and prints the results to 'stdout'. quickCheckWithResult :: Testable prop => Args -> prop -> IO Result-quickCheckWithResult a p =-  do tm <- if chatty a then newStdioTerminal else newNullTerminal+quickCheckWithResult a p = (if chatty a then withStdioTerminal else withNullTerminal) $ \tm -> do      rnd <- case replay a of               Nothing      -> newStdGen               Just (rnd,_) -> return rnd@@ -258,6 +258,7 @@                             , numShrinks  = numShrinks                             , output      = theOutput                             , reason      = P.reason res+                            , interrupted = P.interrupted res                             , labels      = summary st                             }  where

@@ -10,8 +10,8 @@   , bold    , newTerminal-  , newStdioTerminal-  , newNullTerminal+  , withStdioTerminal+  , withNullTerminal   , terminalOutput   , handle   , Terminal@@ -24,15 +24,20 @@ -------------------------------------------------------------------------- -- imports +import Control.Applicative import System.IO   ( hFlush   , hPutStr   , stdout   , stderr   , Handle+  , BufferMode (..)+  , hGetBuffering+  , hSetBuffering   )  import Data.IORef+import Test.QuickCheck.Exception  -------------------------------------------------------------------------- -- literal string@@ -89,17 +94,25 @@   do ref <- newIORef (return ())      return (MkTerminal ref out err) -newStdioTerminal :: IO Terminal-newStdioTerminal = do+withBuffering :: IO a -> IO a+withBuffering action = do+  mode <- hGetBuffering stderr+  -- By default stderr is unbuffered.  This is very slow, hence we explicitly+  -- enable line buffering.+  hSetBuffering stderr LineBuffering+  action `finally` hSetBuffering stderr mode++withStdioTerminal :: (Terminal -> IO a) -> IO a+withStdioTerminal action = do   out <- output (handle stdout)   err <- output (handle stderr)-  newTerminal out err+  withBuffering (newTerminal out err >>= action) -newNullTerminal :: IO Terminal-newNullTerminal = do+withNullTerminal :: (Terminal -> IO a) -> IO a+withNullTerminal action = do   out <- output (const (return ()))   err <- output (const (return ()))-  newTerminal out err+  newTerminal out err >>= action  terminalOutput :: Terminal -> IO String terminalOutput (MkTerminal _ out _) = get out@@ -140,8 +153,7 @@  putTemp tm@(MkTerminal _ _ err) s =   do flush tm-     put err s-     put err [ '\b' | _ <- s ]+     put err (s ++ [ '\b' | _ <- s ])      postpone tm $        put err ( [ ' ' | _ <- s ]               ++ [ '\b' | _ <- s ]@@ -149,8 +161,7 @@  putLine tm@(MkTerminal _ out _) s =   do flush tm-     put out s-     put out "\n"+     put out (s ++ "\n")  -------------------------------------------------------------------------- -- the end.