tasty-quickcheck 0.10.3 → 0.11.1
raw patch · 4 files changed
Files
- CHANGELOG.md +32/−1
- Test/Tasty/QuickCheck.hs +96/−47
- tasty-quickcheck.cabal +8/−15
- tests/test.hs +56/−13
CHANGELOG.md view
@@ -1,10 +1,41 @@ Changes ======= +Version 0.11.1+--------------++* Add timeouts for individual tests within a property+ ([#425](https://github.com/UnkindPartition/tasty/pull/425)).+* Define `showDefaultValue` for `QuickCheckTests`,+ `QuickCheckMaxSize` and `QuickCheckMaxRatio`+ ([#428](https://github.com/UnkindPartition/tasty/pull/428)).+* Print the number of QuickCheck shrinks in the progress message+ ([#431](https://github.com/UnkindPartition/tasty/pull/431)).+* Drop support for GHC 7.10.++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
@@ -10,6 +10,7 @@ , QuickCheckMaxRatio(..) , QuickCheckVerbose(..) , QuickCheckMaxShrinks(..)+ , QuickCheckTimeout(..) -- * Re-export of Test.QuickCheck , module Test.QuickCheck -- * Internal@@ -20,13 +21,12 @@ , optionSetToArgs ) where -import Test.Tasty ( testGroup )+import Test.Tasty ( testGroup, Timeout(..) ) 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 +50,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 +80,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@@ -107,8 +119,15 @@ newtype QuickCheckMaxShrinks = QuickCheckMaxShrinks Int deriving (Num, Ord, Eq, Real, Enum, Integral, Typeable) +-- | Timeout for individual tests within a property.+--+-- @since 0.11.1+newtype QuickCheckTimeout = QuickCheckTimeout Timeout+ deriving (Eq, Ord, Typeable)+ instance IsOption QuickCheckTests where defaultValue = 100+ showDefaultValue (QuickCheckTests n) = Just (show n) parseValue = -- We allow numeric underscores for readability; see -- https://github.com/UnkindPartition/tasty/issues/263@@ -118,11 +137,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@@ -137,6 +157,7 @@ instance IsOption QuickCheckMaxSize where defaultValue = fromIntegral defaultMaxSize+ showDefaultValue (QuickCheckMaxSize n) = Just (show n) parseValue = fmap QuickCheckMaxSize . safeRead optionName = return "quickcheck-max-size" optionHelp = return "Size of the biggest test cases quickcheck generates"@@ -144,6 +165,7 @@ instance IsOption QuickCheckMaxRatio where defaultValue = fromIntegral $ QC.maxDiscardRatio QC.stdArgs+ showDefaultValue (QuickCheckMaxRatio n) = Just (show n) parseValue = fmap QuickCheckMaxRatio . safeRead optionName = return "quickcheck-max-ratio" optionHelp = return "Maximum number of discared tests per successful test before giving up"@@ -163,35 +185,49 @@ optionHelp = return "Number of shrinks allowed before QuickCheck will fail a test" optionCLParser = mkOptionCLParser $ metavar "NUMBER" +instance IsOption QuickCheckTimeout where+ defaultValue = QuickCheckTimeout defaultValue+ parseValue = fmap QuickCheckTimeout . parseValue+ optionName = return "quickcheck-timeout"+ optionHelp = return "Timeout for individual tests within a QuickCheck property (suffixes: ms,s,m,h; default: s)"+ optionCLParser = mkOptionCLParser $ metavar "DURATION"+ -- | Convert tasty options into QuickCheck options. -- -- 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@@ -202,20 +238,24 @@ , Option (Proxy :: Proxy QuickCheckMaxRatio) , Option (Proxy :: Proxy QuickCheckVerbose) , Option (Proxy :: Proxy QuickCheckMaxShrinks)+ , Option (Proxy :: Proxy QuickCheckTimeout) ] 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+ QuickCheckTimeout timeout = lookupOption opts+ applyTimeout = case timeout of+ Timeout micros _+ | micros <= toInteger (maxBound :: Int) -> QC.within (fromInteger micros)+ _ -> id -- Quickcheck already catches exceptions, no need to do it here. r <- quickCheck yieldProgress args- (if verbose then QC.verbose prop else prop)+ (applyTimeout $ if verbose then QC.verbose prop else prop) qcOutput <- formatMessage $ QC.output r let qcOutputNl =@@ -224,6 +264,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,31 +279,38 @@ -> 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+ $ \st@QC.MkState {QC.maxSuccessTests, QC.numSuccessTests} _ ->+ yieldProgress $+ if QC.numTotTryShrinks st > 0 then+ emptyProgress {+ progressText = showShrinkCount st+ }+ else+ emptyProgress {+ progressPercent = fromIntegral numSuccessTests / fromIntegral maxSuccessTests+ } +-- Based on 'QuickCheck.Test.failureSummaryAndReason'.+showShrinkCount :: QC.State -> String+showShrinkCount st = show (QC.numSuccessShrinks st) ++ " shrink" ++ plural+ where plural = if QC.numSuccessShrinks st == 1 then "" else "s"+ successful :: QC.Result -> Bool successful r = case r of 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
@@ -1,8 +1,5 @@--- Initial tasty-quickcheck.cabal generated by cabal init. For further--- documentation, see http://haskell.org/cabal/users-guide/- name: tasty-quickcheck-version: 0.10.3+version: 0.11.1 synopsis: QuickCheck support for the Tasty test framework. description: QuickCheck support for the Tasty test framework. .@@ -10,7 +7,6 @@ license-file: LICENSE author: Roman Cheplyaka <roma@ro-che.info> maintainer: Roman Cheplyaka <roma@ro-che.info>--- copyright: homepage: https://github.com/UnkindPartition/tasty bug-reports: https://github.com/UnkindPartition/tasty/issues category: Testing@@ -25,16 +21,14 @@ library exposed-modules: Test.Tasty.QuickCheck- -- other-modules: other-extensions: GeneralizedNewtypeDeriving, DeriveDataTypeable- build-depends: base >= 4.8 && < 5,+ build-depends: base >= 4.9 && < 5, tagged < 0.9,- tasty >= 1.0.1 && < 1.6,+ tasty >= 1.5.1 && < 1.6, random < 1.3,- QuickCheck >= 2.10 && < 2.15,+ QuickCheck >= 2.10 && < 2.16, optparse-applicative < 0.19 - -- hs-source-dirs: default-language: Haskell2010 default-extensions: CPP ghc-options: -Wall@@ -50,11 +44,10 @@ main-is: test.hs build-depends:- base >= 4.7 && < 5- , tasty >= 1.5+ base+ , regex-tdfa >= 1.3 && < 1.4+ , tasty , tasty-quickcheck , tasty-hunit- , pcre-light+ , QuickCheck ghc-options: -Wall- if (!impl(ghc >= 8.0) || os(windows))- buildable: False
tests/test.hs view
@@ -1,13 +1,15 @@ {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+import Control.Concurrent (threadDelay) import Test.Tasty import Test.Tasty.Options import Test.Tasty.Providers as Tasty import Test.Tasty.Runners as Tasty import Test.Tasty.QuickCheck import Test.Tasty.HUnit-import Data.Maybe-import Text.Regex.PCRE.Light.Char8+import Test.QuickCheck.Random (QCGen) import Text.Printf+import qualified Text.Regex.TDFA as Regex (=~), (!~) :: String -- ^ text@@ -18,20 +20,11 @@ msg = printf "Expected /%s/, got %s" regexStr (show text) -- NB show above the intentional -- to add quotes around the string and -- escape newlines etc.- in assertBool msg $ match' text regexStr+ in assertBool msg $ text Regex.=~ regexStr text !~ regexStr = let msg = printf "Did not expect /%s/, got %s" regexStr (show text)- in assertBool msg $ not $ match' text regexStr---- note: the order of arguments is reversed relative to match from--- pcre-light, but consistent with =~ and !~-match' :: String -> String -> Bool-match' text regexStr =- let- regex = compile regexStr []- in- isJust $ match regex text []+ in assertBool msg $ not $ text Regex.=~ regexStr main :: IO () main =@@ -67,6 +60,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 +99,12 @@ 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+ , testProperty "Number of shrinks" $+ expectFailure $ withMaxSize 1000 $ \(Large (x :: Int)) ->+ ioProperty $ threadDelay 100000 >> pure (x <= 100) ] run' :: Testable p => p -> IO Result@@ -98,3 +120,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 (/='\"')