diff --git a/CHANGELOG b/CHANGELOG deleted file mode 100644 --- a/CHANGELOG +++ /dev/null @@ -1,1 +0,0 @@ -See https://github.com/feuerbach/tasty/blob/master/CHANGES.md diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,160 @@ +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. + ([#311](https://github.com/UnkindPartition/tasty/pull/311)). + +Version 0.10.2 +-------------- + +Export `QuickCheckMaxShrinks` + +Version 0.10.1.2 +---------------- + +The only point of this release is to introduce compatibility with GHCs back to 7.0 +(see https://github.com/UnkindPartition/tasty/pull/287). + +Note, however, that these changes are not merged to the master branch, and the +future releases will only support the GHC/base versions from the last 5 years, +as per our usual policy. To test with even older GHCs, you'll have to use this +particular version of tasty-quickcheck (or have the constraint solver pick it +for you when testing with older GHCs). + +The source of this release is in the `support-old-ghcs` branch of the tasty +repository. + +Version 0.10.1.1 +---------------- + +* Accept underscores in `--quickcheck-tests` for readability, + e.g. `--quickcheck-tests 10_000_000`. + +Version 0.10.1 +-------------- + +* Add a --quickcheck-shrinks flag + +Version 0.10 +------------ + +* Do not re-export irrelevant Template Haskell QuickCheck functions +* Make boolean options case-insensitive +* Make --quickcheck-show-replay a command-line flag rather than an option + requiring an argument `True` + +Version 0.9.2 +------------- + +* Add a `testProperties` function, which allows to test all QuickCheck + properties defined in a module. + +Version 0.9.1 +------------- + +* Expose internal `optionSetToArgs` function + +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 +------------- + +Add a "--quickcheck-verbose" option + +Version 0.8.3.2 +--------------- + +* Put correct lower version bound on tasty +* Allow use of older QuickCheck for HP compatibility + +Version 0.8.3.1 +--------------- + +When QC message throws an exception, still print the replay message + +Version 0.8.3 +------------- + +* Export 'show replay' option +* Fixed a run-time error when using QuickCheck's `expectFailure` + +Version 0.8.2 +------------- + +* Allow suppressing the --quickcheck-replay hint +* Split the changelog out of the main tasty changelog + +Version 0.8.1 +------------- + +Re-export `Gen` from `Test.Tasty.QuickCheck` + +Version 0.8.0.3 +--------------- + +Upgrade to QuickCheck 2.7 + +Version 0.8 +----------- + +Update to tasty-0.8 + +Version 0.3.1 +------------- + +Use the original QuickCheck's output format + +Version 0.3 +----------- + +Add options for maximum size and maximum ratio; support replay. + +Version 0.2 +----------- + +Re-export useful bits of `Test.QuickCheck` from `Test.Tasty.QuickCheck` diff --git a/Test/Tasty/QuickCheck.hs b/Test/Tasty/QuickCheck.hs --- a/Test/Tasty/QuickCheck.hs +++ b/Test/Tasty/QuickCheck.hs @@ -1,17 +1,33 @@ -- | This module allows to use QuickCheck properties in tasty. -{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, NamedFieldPuns #-} module Test.Tasty.QuickCheck ( testProperty + , testProperties , QuickCheckTests(..) , QuickCheckReplay(..) + , QuickCheckShowReplay(..) , QuickCheckMaxSize(..) , QuickCheckMaxRatio(..) + , QuickCheckVerbose(..) + , QuickCheckMaxShrinks(..) + , QuickCheckTimeout(..) + -- * Re-export of Test.QuickCheck , module Test.QuickCheck + -- * Internal + -- | If you are building a test suite, you don't need these functions. + -- + -- They may be used by other tasty add-on packages (such as tasty-hspec). + , QC(..) + , optionSetToArgs ) where +import Test.Tasty ( testGroup, Timeout(..) ) import Test.Tasty.Providers import Test.Tasty.Options import qualified Test.QuickCheck as QC +import qualified Test.QuickCheck.Property as QCP +import qualified Test.QuickCheck.State as QC +import Test.Tasty.Runners (formatMessage, emptyProgress) import Test.QuickCheck hiding -- for re-export ( quickCheck , Args(..) @@ -25,29 +41,66 @@ , verboseCheckWithResult , verboseCheckResult , verbose + -- Template Haskell functions +#if MIN_VERSION_QuickCheck(2,11,0) + , allProperties +#endif + , forAllProperties + , quickCheckAll + , verboseCheckAll ) -import Test.QuickCheck.Random (QCGen) + +import Control.Applicative import Data.Typeable -import Data.Proxy import Data.List import Text.Printf -import Control.Applicative +import Test.QuickCheck.Random (QCGen, mkQCGen) +import Options.Applicative (metavar) +import System.Random (getStdRandom, randomR) +#if !MIN_VERSION_base(4,9,0) +import Data.Monoid +#endif newtype QC = QC QC.Property deriving Typeable --- | Create a 'Test' for a QuickCheck 'QC.Testable' property +-- | Create a 'TestTree' for a QuickCheck 'QC.Testable' property testProperty :: QC.Testable a => TestName -> a -> TestTree testProperty name prop = singleTest name $ QC $ QC.property prop +-- | Create a test from a list of QuickCheck properties. To be used +-- with 'Test.QuickCheck.allProperties'. E.g. +-- +-- >tests :: TestTree +-- >tests = testProperties "Foo" $allProperties +testProperties :: TestName -> [(String, Property)] -> TestTree +testProperties name = testGroup name . map (uncurry testProperty) + -- | Number of test cases for QuickCheck to generate newtype QuickCheckTests = QuickCheckTests Int deriving (Num, Ord, Eq, Real, Enum, Integral, Typeable) --- | Replay a previous test using a replay token -newtype QuickCheckReplay = QuickCheckReplay (Maybe (QCGen, 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 +newtype QuickCheckShowReplay = QuickCheckShowReplay Bool + deriving (Typeable) + -- | Size of the biggest test cases newtype QuickCheckMaxSize = QuickCheckMaxSize Int deriving (Num, Ord, Eq, Real, Enum, Integral, Typeable) @@ -56,73 +109,208 @@ newtype QuickCheckMaxRatio = QuickCheckMaxRatio Int deriving (Num, Ord, Eq, Real, Enum, Integral, Typeable) +-- | Show the test cases that QuickCheck generates +newtype QuickCheckVerbose = QuickCheckVerbose Bool + deriving (Typeable) + +-- | Number of shrinks allowed before QuickCheck will fail a test. +-- +-- @since 0.10.2 +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 - parseValue = fmap QuickCheckTests . safeRead + showDefaultValue (QuickCheckTests n) = Just (show n) + parseValue = + -- We allow numeric underscores for readability; see + -- https://github.com/UnkindPartition/tasty/issues/263 + fmap QuickCheckTests . safeRead . filter (/= '_') optionName = return "quickcheck-tests" - optionHelp = return "Number of test cases for QuickCheck to generate" + optionHelp = return "Number of test cases for QuickCheck to generate. Underscores accepted: e.g. 10_000_000" + optionCLParser = mkOptionCLParser $ metavar "NUMBER" 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 + 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 "Replay token to use for replaying a previous test run" + optionHelp = return "Random seed to use for replaying a previous test run" + optionCLParser = mkOptionCLParser $ metavar "SEED" +instance IsOption QuickCheckShowReplay where + defaultValue = QuickCheckShowReplay False + parseValue = fmap QuickCheckShowReplay . safeReadBool + optionName = return "quickcheck-show-replay" + optionHelp = return "Show a replay token for replaying tests" + optionCLParser = flagCLParser Nothing (QuickCheckShowReplay True) + +defaultMaxSize :: Int +defaultMaxSize = QC.maxSize QC.stdArgs + instance IsOption QuickCheckMaxSize where - defaultValue = fromIntegral $ QC.maxSize QC.stdArgs + 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" + optionCLParser = mkOptionCLParser $ metavar "NUMBER" 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" + optionCLParser = mkOptionCLParser $ metavar "NUMBER" +instance IsOption QuickCheckVerbose where + defaultValue = QuickCheckVerbose False + parseValue = fmap QuickCheckVerbose . safeReadBool + optionName = return "quickcheck-verbose" + optionHelp = return "Show the generated test cases" + optionCLParser = mkFlagCLParser mempty (QuickCheckVerbose True) + +instance IsOption QuickCheckMaxShrinks where + defaultValue = QuickCheckMaxShrinks (QC.maxShrinks QC.stdArgs) + parseValue = fmap QuickCheckMaxShrinks . safeRead + optionName = return "quickcheck-shrinks" + 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 + (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 replaySeed + , QC.maxDiscardRatio = maxRatio + , QC.maxShrinks = maxShrinks + } + + return (intSeed, args) + + where + 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 [ Option (Proxy :: Proxy QuickCheckTests) , Option (Proxy :: Proxy QuickCheckReplay) + , Option (Proxy :: Proxy QuickCheckShowReplay) , Option (Proxy :: Proxy QuickCheckMaxSize) , Option (Proxy :: Proxy QuickCheckMaxRatio) + , Option (Proxy :: Proxy QuickCheckVerbose) + , Option (Proxy :: Proxy QuickCheckMaxShrinks) + , Option (Proxy :: Proxy QuickCheckTimeout) ] run opts (QC prop) yieldProgress = do + (_, args) <- optionSetToArgs opts let - QuickCheckTests nTests = lookupOption opts - QuickCheckReplay replay = lookupOption opts - QuickCheckMaxSize maxSize = lookupOption opts - QuickCheckMaxRatio maxRatio = lookupOption opts - args = QC.stdArgs { QC.chatty = False, QC.maxSuccess = nTests, QC.maxSize = maxSize, QC.replay = replay, QC.maxDiscardRatio = maxRatio} - -- TODO yield progress - r <- QC.quickCheckWithResult args prop + QuickCheckShowReplay showReplay = lookupOption opts + QuickCheckVerbose verbose = lookupOption opts + 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 + (applyTimeout $ if verbose then QC.verbose prop else prop) + + qcOutput <- formatMessage $ QC.output r + let qcOutputNl = + if "\n" `isSuffixOf` qcOutput + then qcOutput + else qcOutput ++ "\n" + testSuccessful = successful r + putReplayInDesc = (not testSuccessful) || showReplay + Just seedSz <- return $ replayFromResult r <|> QC.replay args + let replayMsg = makeReplayMsg seedSz return $ - (if successful r then testPassed else testFailed) - (if unexpected r - then QC.output r ++ reproduceMsg r - else QC.output r - ) + (if testSuccessful then testPassed else testFailed) + (qcOutputNl ++ + (if putReplayInDesc then replayMsg else "")) + +-- | Like the original 'QC.quickCheck' but is reporting progress using tasty +-- callback. +-- +quickCheck :: (Progress -> IO ()) + -> QC.Args + -> QC.Property + -> IO QC.Result +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 -unexpected :: QC.Result -> Bool -unexpected r = - case r of - QC.Failure {} -> True - QC.NoExpectedFailure {} -> True - _ -> False +makeReplayMsg :: (QCGen, Int) -> String +makeReplayMsg seedSz = + printf "Use --quickcheck-replay=\"%s\" to reproduce." (show seedSz) -reproduceMsg :: QC.Result -> String -reproduceMsg r = - printf "Use --quickcheck-replay '%d %s' to reproduce." - (QC.usedSize r) - (show $ QC.usedSeed r) +replayFromResult :: QC.Result -> Maybe (QCGen, Int) +replayFromResult r = + case r of + Failure{} -> Just (QC.usedSeed r, QC.usedSize r) + _ -> Nothing diff --git a/tasty-quickcheck.cabal b/tasty-quickcheck.cabal --- a/tasty-quickcheck.cabal +++ b/tasty-quickcheck.cabal @@ -1,29 +1,53 @@ --- Initial tasty-quickcheck.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - name: tasty-quickcheck -version: 0.8.1 +version: 0.11.1 synopsis: QuickCheck support for the Tasty test framework. description: QuickCheck support for the Tasty test framework. + . license: MIT license-file: LICENSE -author: Roman Cheplyaka -maintainer: roma@ro-che.info --- copyright: +author: Roman Cheplyaka +maintainer: Roman Cheplyaka +homepage: https://github.com/UnkindPartition/tasty +bug-reports: https://github.com/UnkindPartition/tasty/issues category: Testing build-type: Simple -extra-source-files: CHANGELOG +extra-source-files: CHANGELOG.md cabal-version: >=1.10 Source-repository head type: git - location: git://github.com/feuerbach/tasty.git + location: https://github.com/UnkindPartition/tasty.git subdir: quickcheck library exposed-modules: Test.Tasty.QuickCheck - -- other-modules: other-extensions: GeneralizedNewtypeDeriving, DeriveDataTypeable - build-depends: base == 4.*, tasty >= 0.8, QuickCheck >= 2.7 && < 3, tagged - -- hs-source-dirs: + build-depends: base >= 4.9 && < 5, + tagged < 0.9, + tasty >= 1.5.1 && < 1.6, + random < 1.3, + QuickCheck >= 2.10 && < 2.16, + optparse-applicative < 0.19 + default-language: Haskell2010 + default-extensions: CPP + ghc-options: -Wall + +test-suite test + default-language: + Haskell2010 + default-extensions: CPP + type: + exitcode-stdio-1.0 + hs-source-dirs: + tests + main-is: + test.hs + build-depends: + base + , regex-tdfa >= 1.3 && < 1.4 + , tasty + , tasty-quickcheck + , tasty-hunit + , QuickCheck + ghc-options: -Wall diff --git a/tests/test.hs b/tests/test.hs new file mode 100644 --- /dev/null +++ b/tests/test.hs @@ -0,0 +1,143 @@ +{-# 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 Test.QuickCheck.Random (QCGen) +import Text.Printf +import qualified Text.Regex.TDFA as Regex + +(=~), (!~) + :: String -- ^ text + -> String -- ^ regex + -> Assertion +text =~ regexStr = + let + 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 $ text Regex.=~ regexStr +text !~ regexStr = + let + msg = printf "Did not expect /%s/, got %s" regexStr (show text) + in assertBool msg $ not $ text Regex.=~ regexStr + +main :: IO () +main = + defaultMain $ + testGroup "Unit tests for Test.Tasty.QuickCheck" + [ testCase "Success" $ do + Result{..} <- run' $ \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.Success -> return () + _ -> assertFailure $ show resultOutcome + resultDescription =~ "OK, passed 100 tests" + resultDescription !~ "Use .* to reproduce" + + , 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.Success -> return () + _ -> assertFailure $ show resultOutcome + resultDescription =~ "OK, passed 100 tests" + resultDescription =~ "Use .* to reproduce" + + , 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" + + , 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 + Tasty.Failure {} -> return () + _ -> assertFailure $ show resultOutcome + resultDescription =~ "Gave up" + resultDescription =~ "Use .* to reproduce" + + , testCase "No expected failure" $ do + Result{..} <- run' $ expectFailure $ \x -> x >= (x :: Int) + case resultOutcome of + Tasty.Failure {} -> return () + _ -> assertFailure $ show resultOutcome + 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 +run' p = + run + mempty -- options + (QC $ property p) + (const $ return ()) -- callback + +runReplay :: Testable p => p -> IO Result +runReplay p = + run + (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 (/='\"')