tasty-quickcheck 0.10.3 → 0.11
raw patch · 4 files changed
+132/−49 lines, 4 filesdep ~QuickCheck
Dependency ranges changed: QuickCheck
Files
- CHANGELOG.md +20/−1
- Test/Tasty/QuickCheck.hs +58/−45
- tasty-quickcheck.cabal +4/−3
- tests/test.hs +50/−0
CHANGELOG.md view
@@ -1,10 +1,29 @@ Changes ======= +Version 0.11+--------------++* Fix issues with QuickCheck progress reporting in the presence of `withMaxSuccess`+ ([#419](https://github.com/UnkindPartition/tasty/pull/419)).+* Produce seeds that run a single failing tests instead of reproducing+ all the earlier successes ([#410](https://github.com/UnkindPartition/tasty/pull/410)).++ Seeds are now pairs instead of single integers, e.g.+ `--quickcheck-replay="(SMGen 2909028190965759779 12330386376379709109,0)"`++ Single integer seeds are still accepted as input, but they do run through+ earlier successes.++ The `QuickCheckReplay` type used as a tasty option has three data constructors+ now. `QuickCheckReplayNone` is the default value and provides no seed.+ `QuickCheckReplayLegacy` takes an integer as before. The `QuickCheckReplay`+ data constructor takes the new seed form.+ Version 0.10.3 -------------- -* Print Quickcheck progress using Tasty progress reporting.+* Print QuickCheck progress using Tasty progress reporting. ([#311](https://github.com/UnkindPartition/tasty/pull/311)). Version 0.10.2
Test/Tasty/QuickCheck.hs view
@@ -24,9 +24,8 @@ import Test.Tasty.Providers import Test.Tasty.Options import qualified Test.QuickCheck as QC-import qualified Test.QuickCheck.Test as QC+import qualified Test.QuickCheck.Property as QCP import qualified Test.QuickCheck.State as QC-import qualified Test.QuickCheck.Text as QC import Test.Tasty.Runners (formatMessage, emptyProgress) import Test.QuickCheck hiding -- for re-export ( quickCheck@@ -50,16 +49,14 @@ , verboseCheckAll ) -import qualified Data.Char as Char+import Control.Applicative import Data.Typeable import Data.List import Text.Printf-import Text.Read (readMaybe)-import Test.QuickCheck.Random (mkQCGen)+import Test.QuickCheck.Random (QCGen, mkQCGen) import Options.Applicative (metavar) import System.Random (getStdRandom, randomR) #if !MIN_VERSION_base(4,9,0)-import Control.Applicative import Data.Monoid #endif @@ -82,7 +79,21 @@ newtype QuickCheckTests = QuickCheckTests Int deriving (Num, Ord, Eq, Real, Enum, Integral, Typeable) -newtype QuickCheckReplay = QuickCheckReplay (Maybe Int)+-- | Replay seed+data QuickCheckReplay+ = -- | No seed+ --+ -- @since 0.11+ QuickCheckReplayNone+ | -- | Legacy integer seed+ --+ -- @since 0.11+ QuickCheckReplayLegacy Int+ | -- | @(qcgen, intSize)@ holds both the seed and the size+ -- to run QuickCheck tests+ --+ -- @since 0.11+ QuickCheckReplay (QCGen, Int) deriving (Typeable) -- | If a test case fails unexpectedly, show the replay token@@ -118,11 +129,12 @@ optionCLParser = mkOptionCLParser $ metavar "NUMBER" instance IsOption QuickCheckReplay where- defaultValue = QuickCheckReplay Nothing- -- Reads a replay int seed- parseValue v = QuickCheckReplay . Just <$> safeRead v+ defaultValue = QuickCheckReplayNone+ -- Reads either a replay Int seed or a (QCGen, Int) seed+ parseValue v =+ (QuickCheckReplayLegacy <$> safeRead v) <|> (QuickCheckReplay <$> safeRead v) optionName = return "quickcheck-replay"- optionHelp = return "Random seed to use for replaying a previous test run (use same --quickcheck-max-size)"+ optionHelp = return "Random seed to use for replaying a previous test run" optionCLParser = mkOptionCLParser $ metavar "SEED" instance IsOption QuickCheckShowReplay where@@ -168,30 +180,37 @@ -- This is a low-level function that was originally added for tasty-hspec -- but may be used by others. --+-- The returned Int is kept only for backward compatibility purposes. It+-- has no use in @tasty-quickcheck@.+-- -- @since 0.9.1 optionSetToArgs :: OptionSet -> IO (Int, QC.Args) optionSetToArgs opts = do- replaySeed <- case mReplay of- Nothing -> getStdRandom (randomR (1,999999))- Just seed -> return seed+ (intSeed, replaySeed) <- case quickCheckReplay of+ QuickCheckReplayNone -> do+ intSeed <- getStdRandom (randomR (1,999999))+ return (intSeed, (mkQCGen intSeed, 0))+ QuickCheckReplayLegacy intSeed -> return (intSeed, (mkQCGen intSeed, 0))+ -- The intSeed is not used when the new form of replay seed is used.+ QuickCheckReplay replaySeed -> return (0, replaySeed) let args = QC.stdArgs { QC.chatty = False , QC.maxSuccess = nTests , QC.maxSize = maxSize- , QC.replay = Just (mkQCGen replaySeed, 0)+ , QC.replay = Just replaySeed , QC.maxDiscardRatio = maxRatio , QC.maxShrinks = maxShrinks } - return (replaySeed, args)+ return (intSeed, args) where- QuickCheckTests nTests = lookupOption opts- QuickCheckReplay mReplay = lookupOption opts- QuickCheckMaxSize maxSize = lookupOption opts- QuickCheckMaxRatio maxRatio = lookupOption opts- QuickCheckMaxShrinks maxShrinks = lookupOption opts+ QuickCheckTests nTests = lookupOption opts+ quickCheckReplay = lookupOption opts+ QuickCheckMaxSize maxSize = lookupOption opts+ QuickCheckMaxRatio maxRatio = lookupOption opts+ QuickCheckMaxShrinks maxShrinks = lookupOption opts instance IsTest QC where testOptions = return@@ -205,12 +224,10 @@ ] run opts (QC prop) yieldProgress = do- (replaySeed, args) <- optionSetToArgs opts+ (_, args) <- optionSetToArgs opts let QuickCheckShowReplay showReplay = lookupOption opts QuickCheckVerbose verbose = lookupOption opts- maxSize = QC.maxSize args- replayMsg = makeReplayMsg replaySeed maxSize -- Quickcheck already catches exceptions, no need to do it here. r <- quickCheck yieldProgress@@ -224,6 +241,8 @@ else qcOutput ++ "\n" testSuccessful = successful r putReplayInDesc = (not testSuccessful) || showReplay+ Just seedSz <- return $ replayFromResult r <|> QC.replay args+ let replayMsg = makeReplayMsg seedSz return $ (if testSuccessful then testPassed else testFailed) (qcOutputNl ++@@ -237,21 +256,12 @@ -> QC.Args -> QC.Property -> IO QC.Result-quickCheck yieldProgress args prop = do- -- Here we rely on the fact that QuickCheck currently prints its progress to- -- stderr and the overall status (which we don't need) to stdout- tm <- QC.newTerminal- (const $ pure ())- (\progressText -> yieldProgress emptyProgress { progressPercent = parseProgress progressText })- QC.withState args $ \ s ->- QC.test s { QC.terminal = tm } prop- where- -- QuickCheck outputs something like "(15461 tests)\b\b\b\b\b\b\b\b\b\b\b\b\b"- parseProgress :: String -> Float- parseProgress = maybe 0 (\n -> fromIntegral (n :: Int) / fromIntegral (QC.maxSuccess args))- . readMaybe- . takeWhile Char.isDigit- . drop 1+quickCheck yieldProgress args+ = (.) (QC.quickCheckWithResult args)+ $ QCP.callback+ $ QCP.PostTest QCP.NotCounterexample+ $ \QC.MkState {QC.maxSuccessTests, QC.numSuccessTests} _ ->+ yieldProgress $ emptyProgress {progressPercent = fromIntegral numSuccessTests / fromIntegral maxSuccessTests} successful :: QC.Result -> Bool successful r =@@ -259,9 +269,12 @@ QC.Success {} -> True _ -> False -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+makeReplayMsg :: (QCGen, Int) -> String+makeReplayMsg seedSz =+ printf "Use --quickcheck-replay=\"%s\" to reproduce." (show seedSz)++replayFromResult :: QC.Result -> Maybe (QCGen, Int)+replayFromResult r =+ case r of+ Failure{} -> Just (QC.usedSeed r, QC.usedSize r)+ _ -> Nothing
tasty-quickcheck.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: tasty-quickcheck-version: 0.10.3+version: 0.11 synopsis: QuickCheck support for the Tasty test framework. description: QuickCheck support for the Tasty test framework. .@@ -29,9 +29,9 @@ other-extensions: GeneralizedNewtypeDeriving, DeriveDataTypeable build-depends: base >= 4.8 && < 5, tagged < 0.9,- tasty >= 1.0.1 && < 1.6,+ tasty >= 1.5 && < 1.6, random < 1.3,- QuickCheck >= 2.10 && < 2.15,+ QuickCheck >= 2.10 && < 2.16, optparse-applicative < 0.19 -- hs-source-dirs:@@ -55,6 +55,7 @@ , tasty-quickcheck , tasty-hunit , pcre-light+ , QuickCheck ghc-options: -Wall if (!impl(ghc >= 8.0) || os(windows)) buildable: False
tests/test.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+import Control.Concurrent (threadDelay) import Test.Tasty import Test.Tasty.Options import Test.Tasty.Providers as Tasty@@ -6,6 +8,7 @@ import Test.Tasty.QuickCheck import Test.Tasty.HUnit import Data.Maybe+import Test.QuickCheck.Random (QCGen) import Text.Regex.PCRE.Light.Char8 import Text.Printf @@ -67,6 +70,29 @@ resultDescription =~ "Failed" resultDescription =~ "Use .* to reproduce" + , testCase "Replay unexpected failure" $ do+ Result{..} <- runMaxSized 3 $ \x -> x /= (2 :: Int)+ case resultOutcome of+ Tasty.Failure {} -> return ()+ _ -> assertFailure $ show resultOutcome+ resultDescription =~ "Failed"+ resultDescription =~ "Use --quickcheck-replay=.* to reproduce."+ let firstResultDescription = resultDescription+ Just seedSz <- return (parseSeed resultDescription)++ Result{..} <- runReplayWithSeed seedSz $ \x -> x /= (2 :: Int)+ case resultOutcome of+ Tasty.Failure {} -> return ()+ _ -> assertFailure $ show resultOutcome++ resultDescription =~ "Failed"+ -- Compare the last lines reporting the replay seed.+ let lastLine = concat . take 1 . reverse . lines+ lastLine resultDescription =~ "Use --quickcheck-replay=.* to reproduce."+ lastLine resultDescription @?= lastLine firstResultDescription+ -- Exactly one test is executed+ resultDescription =~ "Falsified \\(after 1 test\\)"+ , testCase "Gave up" $ do Result{..} <- run' $ \x -> x > x ==> x > (x :: Int) case resultOutcome of@@ -83,6 +109,9 @@ resultDescription =~ "Failed.*expected failure" resultDescription =~ "Use .* to reproduce" + -- Run the test suite manually and check that progress does not go beyond 100%+ , testProperty "Percent Complete" $ withMaxSuccess 1000 $ \(_ :: Int) -> ioProperty $ threadDelay 10000+ ] run' :: Testable p => p -> IO Result@@ -98,3 +127,24 @@ (singleOption $ QuickCheckShowReplay True) (QC $ property p) (const $ return ())++runMaxSized :: Testable p => Int -> p -> IO Result+runMaxSized sz p =+ run+ (singleOption $ QuickCheckMaxSize sz)+ (QC $ property p)+ (const $ return ())++runReplayWithSeed :: Testable p => (QCGen, Int) -> p -> IO Result+runReplayWithSeed seedSz p =+ run+ (singleOption $ QuickCheckReplay seedSz)+ (QC $ property p)+ (const $ return ())++-- | Reads a seed from a message like+--+-- > "Use --quickcheck-single-replay=\"(SMGen 2909028190965759779 12330386376379709109,0)\" to reproduce."+--+parseSeed :: String -> Maybe (QCGen, Int)+parseSeed = safeRead . takeWhile (/= '\"') . drop 1 . dropWhile (/='\"')