tasty-quickcheck 0.8.4 → 0.9
raw patch · 4 files changed
+65/−55 lines, 4 filesdep ~QuickCheck
Dependency ranges changed: QuickCheck
Files
- CHANGELOG.md +13/−0
- Test/Tasty/QuickCheck.hs +34/−32
- tasty-quickcheck.cabal +2/−11
- tests/test.hs +16/−12
CHANGELOG.md view
@@ -1,6 +1,19 @@ Changes ======= +Version 0.9+-------------++* Drop support for QuickCheck < 2.7+* Change the `--quickcheck-show-replay` semantics++ Previously, when the flag was set to `True`, the seed was only shown on failure.++ Now, the seed is shown on failure regardless of the value of the flag,+ and the flag causes the seed to be shown on success.++ The default value for `--quickcheck-show-replay` is now `False`.+ Version 0.8.4 -------------
Test/Tasty/QuickCheck.hs view
@@ -1,5 +1,5 @@ -- | This module allows to use QuickCheck properties in tasty.-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} module Test.Tasty.QuickCheck ( testProperty , QuickCheckTests(..)@@ -38,14 +38,11 @@ import Data.Typeable import Data.Proxy import Data.List+import Data.Monoid import Text.Printf import Control.Applicative--#if MIN_VERSION_QuickCheck(2,7,0)-import Test.QuickCheck.Random (QCGen)-#else-import System.Random (StdGen)-#endif+import Test.QuickCheck.Random (QCGen, mkQCGen)+import System.Random (getStdRandom, randomR) newtype QC = QC QC.Property deriving Typeable@@ -58,12 +55,7 @@ newtype QuickCheckTests = QuickCheckTests Int deriving (Num, Ord, Eq, Real, Enum, Integral, Typeable) --- | Replay a previous test using a replay token-#if MIN_VERSION_QuickCheck(2,7,0)-newtype QuickCheckReplay = QuickCheckReplay (Maybe (QCGen, Int))-#else-newtype QuickCheckReplay = QuickCheckReplay (Maybe (StdGen, Int))-#endif+newtype QuickCheckReplay = QuickCheckReplay (Maybe Int) deriving (Typeable) -- | If a test case fails unexpectedly, show the replay token@@ -90,21 +82,22 @@ instance IsOption QuickCheckReplay where defaultValue = QuickCheckReplay Nothing- parseValue v = QuickCheckReplay . Just <$> replay- -- Reads a replay token in the form "{size} {seed}"- where replay = (,) <$> safeRead (intercalate " " seed) <*> safeRead (concat size)- (size, seed) = splitAt 1 $ words v+ -- Reads a replay int seed+ parseValue v = QuickCheckReplay . Just <$> safeRead v optionName = return "quickcheck-replay"- optionHelp = return "Replay token to use for replaying a previous test run"+ optionHelp = return "Random seed to use for replaying a previous test run (use same --quickcheck-max-size)" instance IsOption QuickCheckShowReplay where- defaultValue = QuickCheckShowReplay True+ defaultValue = QuickCheckShowReplay False parseValue = fmap QuickCheckShowReplay . safeRead optionName = return "quickcheck-show-replay" optionHelp = return "Show a replay token for replaying tests" +defaultMaxSize :: Int+defaultMaxSize = QC.maxSize QC.stdArgs+ instance IsOption QuickCheckMaxSize where- defaultValue = fromIntegral $ QC.maxSize QC.stdArgs+ defaultValue = fromIntegral defaultMaxSize parseValue = fmap QuickCheckMaxSize . safeRead optionName = return "quickcheck-max-size" optionHelp = return "Size of the biggest test cases quickcheck generates"@@ -120,7 +113,7 @@ parseValue = fmap QuickCheckVerbose . safeRead optionName = return "quickcheck-verbose" optionHelp = return "Show the generated test cases"- optionCLParser = flagCLParser Nothing (QuickCheckVerbose True)+ optionCLParser = mkFlagCLParser mempty (QuickCheckVerbose True) instance IsTest QC where testOptions = return@@ -135,15 +128,23 @@ run opts (QC prop) yieldProgress = do let QuickCheckTests nTests = lookupOption opts- QuickCheckReplay replay = lookupOption opts+ QuickCheckReplay mReplay = lookupOption opts QuickCheckShowReplay showReplay = lookupOption opts QuickCheckMaxSize maxSize = lookupOption opts QuickCheckMaxRatio maxRatio = lookupOption opts QuickCheckVerbose verbose = lookupOption opts- args = QC.stdArgs { QC.chatty = False, QC.maxSuccess = nTests, QC.maxSize = maxSize, QC.replay = replay, QC.maxDiscardRatio = maxRatio} testRunner = if verbose then QC.verboseCheckWithResult else QC.quickCheckWithResult+ replaySeed <- case mReplay of+ Nothing -> getStdRandom (randomR (1,999999))+ Just seed -> return seed+ let+ replay = Just (mkQCGen replaySeed, 0)+ args = QC.stdArgs { QC.chatty = False, QC.maxSuccess = nTests, QC.maxSize = maxSize, QC.replay = replay, QC.maxDiscardRatio = maxRatio}+ replayMsg = makeReplayMsg replaySeed maxSize++ -- Quickcheck already catches exceptions, no need to do it here. r <- testRunner args prop qcOutput <- formatMessage $ QC.output r@@ -151,11 +152,12 @@ if "\n" `isSuffixOf` qcOutput then qcOutput else qcOutput ++ "\n"-+ testSuccessful = successful r+ putReplayInDesc = (not testSuccessful) || showReplay return $- (if successful r then testPassed else testFailed)+ (if testSuccessful then testPassed else testFailed) (qcOutputNl ++- (if showReplay then reproduceMsg r else ""))+ (if putReplayInDesc then replayMsg else "")) successful :: QC.Result -> Bool successful r =@@ -163,9 +165,9 @@ QC.Success {} -> True _ -> False --- | If the result is a failure, produce a message that explains how to--- reproduce it. If the result is not a failure, return an empty string.-reproduceMsg :: QC.Result -> String-reproduceMsg QC.Failure { QC.usedSize = size, QC.usedSeed = seed } =- printf "Use --quickcheck-replay '%d %s' to reproduce." size (show seed)-reproduceMsg _ = ""+makeReplayMsg :: Int -> Int -> String+makeReplayMsg seed size = let+ sizeStr = if (size /= defaultMaxSize)+ then printf " --quickcheck-max-size=%d" size+ else ""+ in printf "Use --quickcheck-replay=%d%s to reproduce." seed sizeStr
tasty-quickcheck.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: tasty-quickcheck-version: 0.8.4+version: 0.9 synopsis: QuickCheck support for the Tasty test framework. description: QuickCheck support for the Tasty test framework. license: MIT@@ -22,20 +22,11 @@ location: git://github.com/feuerbach/tasty.git subdir: quickcheck -flag old-QuickCheck- description: Use Quick-Check < 2.7- default: False- library exposed-modules: Test.Tasty.QuickCheck -- other-modules: other-extensions: GeneralizedNewtypeDeriving, DeriveDataTypeable- build-depends: base == 4.*, tagged, tasty >= 0.10.1-- if flag(old-QuickCheck)- build-depends: QuickCheck >= 2.5 && < 2.7, random- else- build-depends: QuickCheck >= 2.7 && < 3+ build-depends: base == 4.*, tagged, tasty >= 0.10.1, random, QuickCheck >= 2.7 -- hs-source-dirs: default-language: Haskell2010
tests/test.hs view
@@ -46,22 +46,26 @@ Tasty.Success -> return () _ -> assertFailure $ show resultOutcome resultDescription =~ "OK, passed 100 tests"+ resultDescription !~ "Use .* to reproduce" - , testCase "Unexpected failure" $ do- Result{..} <- run' $ \x -> x > (x :: Int)+ , testCase "Success, replay requested" $ do+ Result{..} <- runReplay $ \x -> x >= (x :: Int)+ -- there is no instance Show Outcome(+ -- (because there is no instance Show SomeException),+ -- so we can't use @?= for this case resultOutcome of- Tasty.Failure {} -> return ()+ Tasty.Success -> return () _ -> assertFailure $ show resultOutcome- resultDescription =~ "Failed"+ resultDescription =~ "OK, passed 100 tests" resultDescription =~ "Use .* to reproduce" - , testCase "Unexpected failure, no replay message" $ do- Result{..} <- runNoReplay $ \x -> x > (x :: Int)+ , testCase "Unexpected failure" $ do+ Result{..} <- run' $ \x -> x > (x :: Int) case resultOutcome of Tasty.Failure {} -> return () _ -> assertFailure $ show resultOutcome resultDescription =~ "Failed"- resultDescription !~ "Use .* to reproduce"+ resultDescription =~ "Use .* to reproduce" , testCase "Gave up" $ do Result{..} <- run' $ \x -> x > x ==> x > (x :: Int)@@ -69,7 +73,7 @@ Tasty.Failure {} -> return () _ -> assertFailure $ show resultOutcome resultDescription =~ "Gave up"- resultDescription !~ "Use .* to reproduce"+ resultDescription =~ "Use .* to reproduce" , testCase "No expected failure" $ do Result{..} <- run' $ expectFailure $ \x -> x >= (x :: Int)@@ -77,7 +81,7 @@ Tasty.Failure {} -> return () _ -> assertFailure $ show resultOutcome resultDescription =~ "Failed.*expected failure"- resultDescription !~ "Use .* to reproduce"+ resultDescription =~ "Use .* to reproduce" ] @@ -88,9 +92,9 @@ (QC $ property p) (const $ return ()) -- callback -runNoReplay :: Testable p => p -> IO Result-runNoReplay p =+runReplay :: Testable p => p -> IO Result+runReplay p = run- (singleOption $ QuickCheckShowReplay False)+ (singleOption $ QuickCheckShowReplay True) (QC $ property p) (const $ return ())