tasty-quickcheck 0.8.1 → 0.11.1
raw patch · 5 files changed
Files
- CHANGELOG +0/−1
- CHANGELOG.md +160/−0
- Test/Tasty/QuickCheck.hs +227/−39
- tasty-quickcheck.cabal +36/−12
- tests/test.hs +143/−0
− CHANGELOG
@@ -1,1 +0,0 @@-See https://github.com/feuerbach/tasty/blob/master/CHANGES.md
+ CHANGELOG.md view
@@ -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`
Test/Tasty/QuickCheck.hs view
@@ -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
tasty-quickcheck.cabal view
@@ -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 <roma@ro-che.info>+maintainer: Roman Cheplyaka <roma@ro-che.info>+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
+ tests/test.hs view
@@ -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 (/='\"')