hspec-core 2.11.7 → 2.11.8

raw patch · 17 files changed

+576/−533 lines, 17 filesdep ~QuickCheckdep ~hspec-metaPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: QuickCheck, hspec-meta

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• help.txt +2/−1
• hspec-core.cabal +7/−7
• src/Test/Hspec/Core/Config.hs +10/−10
• src/Test/Hspec/Core/Config/Definition.hs +28/−21
• src/Test/Hspec/Core/Example.hs +2/−52
• src/Test/Hspec/Core/QuickCheck.hs +63/−4
• src/Test/Hspec/Core/QuickCheck/Util.hs +172/−0
• src/Test/Hspec/Core/QuickCheckUtil.hs +0/−167
• src/Test/Hspec/Core/Runner.hs +11/−15
• src/Test/Hspec/Core/Spec.hs +1/−0
• test/Helper.hs +2/−2
• test/Test/Hspec/Core/HooksSpec.hs +1/−1
• test/Test/Hspec/Core/QuickCheck/UtilSpec.hs +251/−0
• test/Test/Hspec/Core/QuickCheckUtilSpec.hs +0/−241
• test/Test/Hspec/Core/RunnerSpec.hs +24/−10
• version.yaml +1/−1

@@ -1,4 +1,4 @@-Copyright (c) 2011-2023 Simon Hengel <sol@typeful.net>+Copyright (c) 2011-2024 Simon Hengel <sol@typeful.net> Copyright (c) 2011-2012 Trystan Spangler <trystan.s@comcast.net> Copyright (c) 2011-2011 Greg Weber <greg@gregweber.info> 

@@ -28,6 +28,8 @@   -j N  --jobs=N                run at most N parallelizable tests                                 simultaneously (default: number of available                                 processors)+        --seed=N                used seed for --randomize and QuickCheck+                                properties  FORMATTER OPTIONS   -f NAME  --format=NAME           use a custom formatter; this can be one of@@ -57,7 +59,6 @@         --qc-max-size=N     size to use for the biggest test cases         --qc-max-shrinks=N  maximum number of shrinks to perform before giving                             up (a value of 0 turns shrinking off)-        --seed=N            used seed for QuickCheck properties  OPTIONS FOR SMALLCHECK     --depth=N  maximum depth of generated test values for SmallCheck properties

@@ -5,10 +5,10 @@ -- see: https://github.com/sol/hpack  name:             hspec-core-version:          2.11.7+version:          2.11.8 license:          MIT license-file:     LICENSE-copyright:        (c) 2011-2023 Simon Hengel,+copyright:        (c) 2011-2024 Simon Hengel,                   (c) 2011-2012 Trystan Spangler,                   (c) 2011 Greg Weber maintainer:       Simon Hengel <sol@typeful.net>@@ -36,7 +36,7 @@   ghc-options: -Wall -fno-warn-incomplete-uni-patterns   build-depends:       HUnit ==1.6.*-    , QuickCheck >=2.13.1+    , QuickCheck >=2.13.1 && <2.16     , ansi-terminal >=0.6.2     , array     , base >=4.8.2.0 && <5@@ -86,7 +86,7 @@       Test.Hspec.Core.Formatters.V1.Free       Test.Hspec.Core.Formatters.V1.Internal       Test.Hspec.Core.Formatters.V1.Monad-      Test.Hspec.Core.QuickCheckUtil+      Test.Hspec.Core.QuickCheck.Util       Test.Hspec.Core.Runner.Eval       Test.Hspec.Core.Runner.JobQueue       Test.Hspec.Core.Runner.PrintSlowSpecItems@@ -130,7 +130,7 @@     , filepath     , haskell-lexer     , hspec-expectations ==0.8.4.*-    , hspec-meta ==2.11.7+    , hspec-meta ==2.11.8     , process     , quickcheck-io >=0.2.0     , random@@ -171,7 +171,7 @@       Test.Hspec.Core.Formatters.V2       Test.Hspec.Core.Hooks       Test.Hspec.Core.QuickCheck-      Test.Hspec.Core.QuickCheckUtil+      Test.Hspec.Core.QuickCheck.Util       Test.Hspec.Core.Runner       Test.Hspec.Core.Runner.Eval       Test.Hspec.Core.Runner.JobQueue@@ -207,7 +207,7 @@       Test.Hspec.Core.Formatters.V1Spec       Test.Hspec.Core.Formatters.V2Spec       Test.Hspec.Core.HooksSpec-      Test.Hspec.Core.QuickCheckUtilSpec+      Test.Hspec.Core.QuickCheck.UtilSpec       Test.Hspec.Core.Runner.EvalSpec       Test.Hspec.Core.Runner.JobQueueSpec       Test.Hspec.Core.Runner.PrintSlowSpecItemsSpec

@@ -29,9 +29,9 @@  import           Test.Hspec.Core.Util import           Test.Hspec.Core.Config.Options-import           Test.Hspec.Core.Config.Definition (Config(..), ColorMode(..), UnicodeMode(..), mkDefaultConfig, filterOr)+import           Test.Hspec.Core.Config.Definition import           Test.Hspec.Core.FailureReport-import           Test.Hspec.Core.QuickCheckUtil (mkGen)+import           Test.Hspec.Core.QuickCheck.Util (mkGen) import           Test.Hspec.Core.Example (Params(..), defaultParams) import qualified Test.Hspec.Core.Formatters.V2 as V2 @@ -52,21 +52,21 @@   }  applyFailureReport :: Maybe FailureReport -> Config -> Config-applyFailureReport mFailureReport opts = opts {+applyFailureReport mFailureReport config = config {     configFilterPredicate = matchFilter `filterOr` rerunFilter-  , configQuickCheckSeed = mSeed+  , configSeed = mSeed   , configQuickCheckMaxSuccess = mMaxSuccess   , configQuickCheckMaxDiscardRatio = mMaxDiscardRatio   , configQuickCheckMaxSize = mMaxSize   }   where -    mSeed = configQuickCheckSeed opts <|> (failureReportSeed <$> mFailureReport)-    mMaxSuccess = configQuickCheckMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport)-    mMaxSize = configQuickCheckMaxSize opts <|> (failureReportMaxSize <$> mFailureReport)-    mMaxDiscardRatio = configQuickCheckMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport)+    mSeed = configSeed config <|> deprecatedQuickCheckSeed config <|> (failureReportSeed <$> mFailureReport)+    mMaxSuccess = configQuickCheckMaxSuccess config <|> (failureReportMaxSuccess <$> mFailureReport)+    mMaxSize = configQuickCheckMaxSize config <|> (failureReportMaxSize <$> mFailureReport)+    mMaxDiscardRatio = configQuickCheckMaxDiscardRatio config <|> (failureReportMaxDiscardRatio <$> mFailureReport) -    matchFilter = configFilterPredicate opts+    matchFilter = configFilterPredicate config      rerunFilter = case failureReportPaths <$> mFailureReport of       Just [] -> Nothing@@ -77,7 +77,7 @@ configQuickCheckArgs c = qcArgs   where     qcArgs = (-        maybe id setSeed (configQuickCheckSeed c)+        maybe id setSeed (configSeed c)       . maybe id setMaxShrinks (configQuickCheckMaxShrinks c)       . maybe id setMaxSize (configQuickCheckMaxSize c)       . maybe id setMaxDiscardRatio (configQuickCheckMaxDiscardRatio c)

@@ -12,6 +12,8 @@ , quickCheckOptions , runnerOptions +, deprecatedQuickCheckSeed+ #ifdef TEST , splitOn #endif@@ -24,7 +26,6 @@ import           System.IO (openTempFile, hClose) import           System.Process (system) -import           Test.Hspec.Core.Example (Params(..), defaultParams) import           Test.Hspec.Core.Format (Format, FormatConfig) import           Test.Hspec.Core.Formatters.Pretty (pretty2) import qualified Test.Hspec.Core.Formatters.V1.Monad as V1@@ -51,6 +52,8 @@ , configPrintCpuTime :: Bool , configFailFast :: Bool , configRandomize :: Bool+, configSeed :: Maybe Integer+, configQuickCheckSeed :: Maybe Integer , configFailureReport :: Maybe FilePath , configRerun :: Bool , configRerunAllOnSuccess :: Bool@@ -60,7 +63,6 @@ -- that satisfy the predicate are run. , configFilterPredicate :: Maybe (Path -> Bool) , configSkipPredicate :: Maybe (Path -> Bool)-, configQuickCheckSeed :: Maybe Integer , configQuickCheckMaxSuccess :: Maybe Int , configQuickCheckMaxDiscardRatio :: Maybe Int , configQuickCheckMaxSize :: Maybe Int@@ -91,7 +93,11 @@ , configConcurrentJobs :: Maybe Int } {-# DEPRECATED configFormatter "Use [@useFormatter@](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Formatters-V1.html#v:useFormatter) instead." #-}+{-# DEPRECATED configQuickCheckSeed "Use `configSeed` instead." #-} +deprecatedQuickCheckSeed :: Config -> Maybe Integer+deprecatedQuickCheckSeed = configQuickCheckSeed+ mkDefaultConfig :: [(String, FormatConfig -> IO Format)] -> Config mkDefaultConfig formatters = Config {   configIgnoreConfigFile = False@@ -105,17 +111,18 @@ , configPrintCpuTime = False , configFailFast = False , configRandomize = False+, configSeed = Nothing+, configQuickCheckSeed = Nothing , configFailureReport = Nothing , configRerun = False , configRerunAllOnSuccess = False , configFilterPredicate = Nothing , configSkipPredicate = Nothing-, configQuickCheckSeed = Nothing , configQuickCheckMaxSuccess = Nothing , configQuickCheckMaxDiscardRatio = Nothing , configQuickCheckMaxSize = Nothing , configQuickCheckMaxShrinks = Nothing-, configSmallCheckDepth = paramsSmallCheckDepth defaultParams+, configSmallCheckDepth = Nothing , configColorMode = ColorAuto , configUnicodeMode = UnicodeAuto , configDiff = True@@ -153,8 +160,8 @@ option :: String -> OptionSetter config -> String -> Option config option name arg help = Option name Nothing arg help True -mkFlag :: String -> (Bool -> Config -> Config) -> String -> Option Config-mkFlag name setter = option name (Flag setter)+flag :: String -> (Bool -> Config -> Config) -> String -> Option Config+flag name setter = option name (Flag setter)  mkOptionNoArg :: String -> Maybe Char -> (Config -> Config) -> String -> Option Config mkOptionNoArg name shortcut setter help = Option name shortcut (NoArg setter) help True@@ -171,22 +178,22 @@ formatterOptions :: [(String, FormatConfig -> IO Format)] -> [Option Config] formatterOptions formatters = [     mkOption "format" (Just 'f') (argument "NAME" readFormatter setFormatter) helpForFormat-  , mkFlag "color" setColor "colorize the output"-  , mkFlag "unicode" setUnicode "output unicode"-  , mkFlag "diff" setDiff "show colorized diffs"+  , flag "color" setColor "colorize the output"+  , flag "unicode" setUnicode "output unicode"+  , flag "diff" setDiff "show colorized diffs"   , option "diff-context" (argument "N" readDiffContext setDiffContext) $ unlines [         "output N lines of diff context (default: " <> show defaultDiffContext <> ")"       , "use a value of 'full' to see the full context"       ]   , option "diff-command" (argument "CMD" return setDiffCommand) "use an external diff command\nexample: --diff-command=\"git diff\""-  , mkFlag "pretty" setPretty "try to pretty-print diff values"+  , flag "pretty" setPretty "try to pretty-print diff values"   , mkOptionNoArg "show-exceptions" Nothing setShowException "use `show` when formatting exceptions"   , mkOptionNoArg "display-exceptions" Nothing setDisplayException "use `displayException` when formatting exceptions" -  , mkFlag "times" setTimes "report times for individual spec items"+  , flag "times" setTimes "report times for individual spec items"   , mkOptionNoArg "print-cpu-time" Nothing setPrintCpuTime "include used CPU time in summary"   , printSlowItemsOption-  , mkFlag "expert" setExpertMode "be less verbose"+  , flag "expert" setExpertMode "be less verbose"      -- undocumented for now, as we probably want to change this to produce a     -- standalone HTML report in the future@@ -277,7 +284,6 @@   , option "qc-max-discard" (argument "N" readMaybe setMaxDiscardRatio) "maximum number of discarded tests per successful test before giving up"   , option "qc-max-size" (argument "N" readMaybe setMaxSize) "size to use for the biggest test cases"   , option "qc-max-shrinks" (argument "N" readMaybe setMaxShrinks) "maximum number of shrinks to perform before giving up (a value of 0 turns shrinking off)"-  , option "seed" (argument "N" readMaybe setSeed) "used seed for QuickCheck properties"      -- for compatibility with test-framework   , undocumented $ option "maximum-generated-tests" (argument "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default"@@ -296,7 +302,7 @@ setMaxShrinks n c = c {configQuickCheckMaxShrinks = Just n}  setSeed :: Integer -> Config -> Config-setSeed n c = c {configQuickCheckSeed = Just n}+setSeed n c = c {configSeed = Just n}  data FailOn =     FailOnEmpty@@ -330,22 +336,23 @@  runnerOptions :: [Option Config] runnerOptions = [-    mkFlag "dry-run" setDryRun "pretend that everything passed; don't verify anything"-  , mkFlag "focused-only" setFocusedOnly "do not run anything, unless there are focused spec items"+    flag "dry-run" setDryRun "pretend that everything passed; don't verify anything"+  , flag "focused-only" setFocusedOnly "do not run anything, unless there are focused spec items" -  , undocumented $ mkFlag "fail-on-focused" setFailOnFocused "fail on focused spec items"-  , undocumented $ mkFlag "fail-on-pending" setFailOnPending "fail on pending spec items"+  , undocumented $ flag "fail-on-focused" setFailOnFocused "fail on focused spec items"+  , undocumented $ flag "fail-on-pending" setFailOnPending "fail on pending spec items"    , mkOption    "fail-on" Nothing (argument "ITEMS" readFailOnItems (setFailOnItems True )) helpForFailOn   , mkOption "no-fail-on" Nothing (argument "ITEMS" readFailOnItems (setFailOnItems False)) helpForFailOn-  , mkFlag "strict" setStrict $ "same as --fail-on=" <> showFailOnItems strict+  , flag "strict" setStrict $ "same as --fail-on=" <> showFailOnItems strict -  , mkFlag "fail-fast" setFailFast "abort on first failure"-  , mkFlag "randomize" setRandomize "randomize execution order"+  , flag "fail-fast" setFailFast "abort on first failure"+  , flag "randomize" setRandomize "randomize execution order"   , mkOptionNoArg "rerun" (Just 'r') setRerun "rerun all examples that failed in the previous test run (only works in combination with --failure-report or in GHCi)"   , option "failure-report" (argument "FILE" return setFailureReport) "read/write a failure report for use with --rerun"   , mkOptionNoArg "rerun-all-on-success" Nothing setRerunAllOnSuccess "run the whole test suite after a previously failing rerun succeeds for the first time (only works in combination with --rerun)"   , mkOption "jobs" (Just 'j') (argument "N" readMaxJobs setMaxJobs) "run at most N parallelizable tests simultaneously (default: number of available processors)"+  , option "seed" (argument "N" readMaybe setSeed) "used seed for --randomize and QuickCheck properties"   ]   where     strict = [FailOnFocused, FailOnPending]

@@ -22,6 +22,7 @@ , safeEvaluateResultStatus , exceptionToResultStatus , toLocation+, hunitFailureToResult ) where  import           Prelude ()@@ -35,11 +36,8 @@ import qualified Test.QuickCheck as QC import           Test.Hspec.Expectations (Expectation) -import qualified Test.QuickCheck.State as QC (numSuccessTests, maxSuccessTests)-import qualified Test.QuickCheck.Property as QCP--import           Test.Hspec.Core.QuickCheckUtil import           Test.Hspec.Core.Util+import           Test.Hspec.Core.QuickCheck.Util (liftHook) import           Test.Hspec.Core.Example.Location  -- | A type class for examples@@ -183,51 +181,3 @@ instance Example (a -> Expectation) where   type Arg (a -> Expectation) = a   evaluateExample e _ hook _ = hook e >> return (Result "" Success)--instance Example QC.Property where-  type Arg QC.Property = ()-  evaluateExample e = evaluateExample (\() -> e)--instance Example (a -> QC.Property) where-  type Arg (a -> QC.Property) = a-  evaluateExample p c hook progressCallback = do-    let args = paramsQuickCheckArgs c-    r <- QC.quickCheckWithResult args {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty hook p)-    return $ fromQuickCheckResult args r-    where-      qcProgressCallback = QCP.PostTest QCP.NotCounterexample $-        \st _ -> progressCallback (QC.numSuccessTests st, QC.maxSuccessTests st)--fromQuickCheckResult :: QC.Args -> QC.Result -> Result-fromQuickCheckResult args r = case parseQuickCheckResult r of-  QuickCheckResult _ info (QuickCheckOtherFailure err) -> Result info $ Failure Nothing (Reason err)-  QuickCheckResult _ info QuickCheckSuccess -> Result (if QC.chatty args then info else "") Success-  QuickCheckResult n info (QuickCheckFailure QCFailure{..}) -> case quickCheckFailureException of-    Just e | Just result <- fromException e -> Result info result-    Just e | Just hunit <- fromException e -> Result info $ hunitFailureToResult (Just hunitAssertion) hunit-    Just e -> failure (uncaughtException e)-    Nothing -> failure falsifiable-    where-      failure = Result info . Failure Nothing . Reason--      numbers = formatNumbers n quickCheckFailureNumShrinks--      hunitAssertion :: String-      hunitAssertion = intercalate "\n" [-          "Falsifiable " ++ numbers ++ ":"-        , indent (unlines quickCheckFailureCounterexample)-        ]--      uncaughtException e = intercalate "\n" [-          "uncaught exception: " ++ formatException e-        , numbers-        , indent (unlines quickCheckFailureCounterexample)-        ]--      falsifiable = intercalate "\n" [-          quickCheckFailureReason ++ " " ++ numbers ++ ":"-        , indent (unlines quickCheckFailureCounterexample)-        ]--indent :: String -> String-indent = intercalate "\n" . map ("  " ++) . lines

@@ -1,18 +1,29 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-} -- | Stability: provisional module Test.Hspec.Core.QuickCheck (-  modifyArgs-, modifyMaxSuccess+  modifyMaxSuccess , modifyMaxDiscardRatio , modifyMaxSize , modifyMaxShrinks+, modifyArgs ) where  import           Prelude () import           Test.Hspec.Core.Compat -import           Test.QuickCheck-import           Test.Hspec.Core.Spec+import           Test.QuickCheck (Args(..))+import qualified Test.QuickCheck as QC+import qualified Test.QuickCheck.State as QC (numSuccessTests, maxSuccessTests)+import qualified Test.QuickCheck.Property as QCP +import           Test.Hspec.Core.Util+import           Test.Hspec.Core.QuickCheck.Util+import           Test.Hspec.Core.Example (Example(..), Params(..), Result(..), ResultStatus(..), FailureReason(..), hunitFailureToResult)+import           Test.Hspec.Core.Spec.Monad (SpecWith, modifyParams)+ -- | Use a modified `maxSuccess` for given spec. modifyMaxSuccess :: (Int -> Int) -> SpecWith a -> SpecWith a modifyMaxSuccess = modifyArgs . modify@@ -47,3 +58,51 @@   where     modify :: (Args -> Args) -> Params -> Params     modify f p = p {paramsQuickCheckArgs = f (paramsQuickCheckArgs p)}++instance Example QC.Property where+  type Arg QC.Property = ()+  evaluateExample e = evaluateExample (\() -> e)++instance Example (a -> QC.Property) where+  type Arg (a -> QC.Property) = a+  evaluateExample p params hook progressCallback = do+    let args = paramsQuickCheckArgs params+    r <- QC.quickCheckWithResult args {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty hook p)+    return $ fromQuickCheckResult args r+    where+      qcProgressCallback = QCP.PostTest QCP.NotCounterexample $+        \st _ -> progressCallback (QC.numSuccessTests st, QC.maxSuccessTests st)++fromQuickCheckResult :: QC.Args -> QC.Result -> Result+fromQuickCheckResult args r = case parseQuickCheckResult r of+  QuickCheckResult _ info (QuickCheckOtherFailure err) -> Result info $ Failure Nothing (Reason err)+  QuickCheckResult _ info QuickCheckSuccess -> Result (if QC.chatty args then info else "") Success+  QuickCheckResult n info (QuickCheckFailure QCFailure{..}) -> case quickCheckFailureException of+    Just e | Just result <- fromException e -> Result info result+    Just e | Just hunit <- fromException e -> Result info $ hunitFailureToResult (Just hunitAssertion) hunit+    Just e -> failure (uncaughtException e)+    Nothing -> failure falsifiable+    where+      failure = Result info . Failure Nothing . Reason++      numbers = formatNumbers n quickCheckFailureNumShrinks++      hunitAssertion :: String+      hunitAssertion = intercalate "\n" [+          "Falsifiable " ++ numbers ++ ":"+        , indent (unlines quickCheckFailureCounterexample)+        ]++      uncaughtException e = intercalate "\n" [+          "uncaught exception: " ++ formatException e+        , numbers+        , indent (unlines quickCheckFailureCounterexample)+        ]++      falsifiable = intercalate "\n" [+          quickCheckFailureReason ++ " " ++ numbers ++ ":"+        , indent (unlines quickCheckFailureCounterexample)+        ]++indent :: String -> String+indent = intercalate "\n" . map ("  " ++) . lines

@@ -0,0 +1,172 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE CPP #-}+module Test.Hspec.Core.QuickCheck.Util (+  liftHook+, aroundProperty++, QuickCheckResult(..)+, Status(..)+, QuickCheckFailure(..)+, parseQuickCheckResult++, formatNumbers++, mkGen+, newSeed+#ifdef TEST+, stripSuffix+, splitBy+#endif+) where++import           Prelude ()+import           Test.Hspec.Core.Compat++import           Data.Int+import           System.Random++import           Test.QuickCheck+import           Test.QuickCheck.Text (isOneLine)+import qualified Test.QuickCheck.Property as QCP+import           Test.QuickCheck.Property hiding (Result(..))+import           Test.QuickCheck.Gen+import           Test.QuickCheck.IO ()+import           Test.QuickCheck.Random+import qualified Test.QuickCheck.Test as QC (showTestCount)+import           Test.QuickCheck.State (State(..))++import           Test.Hspec.Core.Util++liftHook :: r -> ((a -> IO ()) -> IO ()) -> (a -> IO r) -> IO r+liftHook def hook inner = do+  ref <- newIORef def+  hook $ inner >=> writeIORef ref+  readIORef ref++aroundProperty :: ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property+aroundProperty hook p = MkProperty . MkGen $ \r n -> aroundProp hook $ \a -> (unGen . unProperty $ p a) r n++aroundProp :: ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop+aroundProp hook p = MkProp $ aroundRose hook (\a -> unProp $ p a)++aroundRose :: ((a -> IO ()) -> IO ()) -> (a -> Rose QCP.Result) -> Rose QCP.Result+aroundRose hook r = ioRose $ do+  liftHook (return QCP.succeeded) hook $ \ a -> reduceRose (r a)++newSeed :: IO Int+newSeed = fst . randomR (0, fromIntegral (maxBound :: Int32)) <$>+  newQCGen++mkGen :: Int -> QCGen+mkGen = mkQCGen++formatNumbers :: Int -> Int -> String+formatNumbers n shrinks = "(after " ++ pluralize n "test" ++ shrinks_ ++ ")"+  where+    shrinks_+      | shrinks > 0 = " and " ++ pluralize shrinks "shrink"+      | otherwise = ""++data QuickCheckResult = QuickCheckResult {+  quickCheckResultNumTests :: Int+, quickCheckResultInfo :: String+, quickCheckResultStatus :: Status+} deriving Show++data Status =+    QuickCheckSuccess+  | QuickCheckFailure QuickCheckFailure+  | QuickCheckOtherFailure String+  deriving Show++data QuickCheckFailure = QCFailure {+  quickCheckFailureNumShrinks :: Int+, quickCheckFailureException :: Maybe SomeException+, quickCheckFailureReason :: String+, quickCheckFailureCounterexample :: [String]+} deriving Show++parseQuickCheckResult :: Result -> QuickCheckResult+parseQuickCheckResult r = case r of+  Success {..} -> result output QuickCheckSuccess++  Failure {..} ->+    case stripSuffix outputWithoutVerbose output of+      Just xs -> result verboseOutput (QuickCheckFailure $ QCFailure numShrinks theException reason failingTestCase)+        where+          verboseOutput+            | xs == "*** Failed! " = ""+            | otherwise = maybeStripSuffix "*** Failed!" (strip xs)+      Nothing -> couldNotParse output+    where+      outputWithoutVerbose = reasonAndNumbers ++ unlines failingTestCase+      reasonAndNumbers+        | isOneLine reason = reason ++ " " ++ numbers ++ colonNewline+        | otherwise = numbers ++ colonNewline ++ ensureTrailingNewline reason+      numbers = formatNumbers numTests numShrinks+      colonNewline = ":\n"++  GaveUp {..} ->+    case stripSuffix outputWithoutVerbose output of+      Just info -> otherFailure info ("Gave up after " ++ numbers ++ "!")+      Nothing -> couldNotParse output+    where+      numbers = showTestCount numTests numDiscarded+      outputWithoutVerbose = "*** Gave up! Passed only " ++ numbers ++ " tests.\n"++  NoExpectedFailure {..} -> case splitBy "*** Failed! " output of+    Just (info, err) -> otherFailure info err+    Nothing -> couldNotParse output++  where+    result = QuickCheckResult (numTests r) . strip+    otherFailure info err = result info (QuickCheckOtherFailure $ strip err)+    couldNotParse = result "" . QuickCheckOtherFailure++showTestCount :: Int -> Int -> String+showTestCount success discarded = QC.showTestCount state+  where+    state = MkState {+      terminal                  = undefined+    , maxSuccessTests           = undefined+    , maxDiscardedRatio         = undefined+    , coverageConfidence        = undefined+#if MIN_VERSION_QuickCheck(2,15,0)+    , maxTestSize               = 0+    , replayStartSize           = undefined+#else+    , computeSize               = undefined+#endif+    , numTotMaxShrinks          = 0+    , numSuccessTests           = success+    , numDiscardedTests         = discarded+    , numRecentlyDiscardedTests = 0+    , labels                    = mempty+    , classes                   = mempty+    , tables                    = mempty+    , requiredCoverage          = mempty+    , expected                  = True+    , randomSeed                = mkGen 0+    , numSuccessShrinks         = 0+    , numTryShrinks             = 0+    , numTotTryShrinks          = 0+    }++ensureTrailingNewline :: String -> String+ensureTrailingNewline = unlines . lines++maybeStripPrefix :: String -> String -> String+maybeStripPrefix prefix m = fromMaybe m (stripPrefix prefix m)++maybeStripSuffix :: String -> String -> String+maybeStripSuffix suffix = reverse . maybeStripPrefix (reverse suffix) . reverse++stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]+stripSuffix suffix = fmap reverse . stripPrefix (reverse suffix) . reverse++splitBy :: String -> String -> Maybe (String, String)+splitBy sep xs = listToMaybe [+    (x, y) | (x, Just y) <- zip (inits xs) (map stripSep $ tails xs)+  ]+  where+    stripSep = stripPrefix sep

@@ -1,167 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE CPP #-}-module Test.Hspec.Core.QuickCheckUtil (-  liftHook-, aroundProperty--, QuickCheckResult(..)-, Status(..)-, QuickCheckFailure(..)-, parseQuickCheckResult--, formatNumbers--, mkGen-, newSeed-#ifdef TEST-, stripSuffix-, splitBy-#endif-) where--import           Prelude ()-import           Test.Hspec.Core.Compat--import           Data.Int-import           System.Random--import           Test.QuickCheck-import           Test.QuickCheck.Text (isOneLine)-import qualified Test.QuickCheck.Property as QCP-import           Test.QuickCheck.Property hiding (Result(..))-import           Test.QuickCheck.Gen-import           Test.QuickCheck.IO ()-import           Test.QuickCheck.Random-import qualified Test.QuickCheck.Test as QC (showTestCount)-import           Test.QuickCheck.State (State(..))--import           Test.Hspec.Core.Util--liftHook :: r -> ((a -> IO ()) -> IO ()) -> (a -> IO r) -> IO r-liftHook def hook inner = do-  ref <- newIORef def-  hook $ inner >=> writeIORef ref-  readIORef ref--aroundProperty :: ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property-aroundProperty hook p = MkProperty . MkGen $ \r n -> aroundProp hook $ \a -> (unGen . unProperty $ p a) r n--aroundProp :: ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop-aroundProp hook p = MkProp $ aroundRose hook (\a -> unProp $ p a)--aroundRose :: ((a -> IO ()) -> IO ()) -> (a -> Rose QCP.Result) -> Rose QCP.Result-aroundRose hook r = ioRose $ do-  liftHook (return QCP.succeeded) hook $ \ a -> reduceRose (r a)--newSeed :: IO Int-newSeed = fst . randomR (0, fromIntegral (maxBound :: Int32)) <$>-  newQCGen--mkGen :: Int -> QCGen-mkGen = mkQCGen--formatNumbers :: Int -> Int -> String-formatNumbers n shrinks = "(after " ++ pluralize n "test" ++ shrinks_ ++ ")"-  where-    shrinks_-      | shrinks > 0 = " and " ++ pluralize shrinks "shrink"-      | otherwise = ""--data QuickCheckResult = QuickCheckResult {-  quickCheckResultNumTests :: Int-, quickCheckResultInfo :: String-, quickCheckResultStatus :: Status-} deriving Show--data Status =-    QuickCheckSuccess-  | QuickCheckFailure QuickCheckFailure-  | QuickCheckOtherFailure String-  deriving Show--data QuickCheckFailure = QCFailure {-  quickCheckFailureNumShrinks :: Int-, quickCheckFailureException :: Maybe SomeException-, quickCheckFailureReason :: String-, quickCheckFailureCounterexample :: [String]-} deriving Show--parseQuickCheckResult :: Result -> QuickCheckResult-parseQuickCheckResult r = case r of-  Success {..} -> result output QuickCheckSuccess--  Failure {..} ->-    case stripSuffix outputWithoutVerbose output of-      Just xs -> result verboseOutput (QuickCheckFailure $ QCFailure numShrinks theException reason failingTestCase)-        where-          verboseOutput-            | xs == "*** Failed! " = ""-            | otherwise = maybeStripSuffix "*** Failed!" (strip xs)-      Nothing -> couldNotParse output-    where-      outputWithoutVerbose = reasonAndNumbers ++ unlines failingTestCase-      reasonAndNumbers-        | isOneLine reason = reason ++ " " ++ numbers ++ colonNewline-        | otherwise = numbers ++ colonNewline ++ ensureTrailingNewline reason-      numbers = formatNumbers numTests numShrinks-      colonNewline = ":\n"--  GaveUp {..} ->-    case stripSuffix outputWithoutVerbose output of-      Just info -> otherFailure info ("Gave up after " ++ numbers ++ "!")-      Nothing -> couldNotParse output-    where-      numbers = showTestCount numTests numDiscarded-      outputWithoutVerbose = "*** Gave up! Passed only " ++ numbers ++ " tests.\n"--  NoExpectedFailure {..} -> case splitBy "*** Failed! " output of-    Just (info, err) -> otherFailure info err-    Nothing -> couldNotParse output--  where-    result = QuickCheckResult (numTests r) . strip-    otherFailure info err = result info (QuickCheckOtherFailure $ strip err)-    couldNotParse = result "" . QuickCheckOtherFailure--showTestCount :: Int -> Int -> String-showTestCount success discarded = QC.showTestCount state-  where-    state = MkState {-      terminal                  = undefined-    , maxSuccessTests           = undefined-    , maxDiscardedRatio         = undefined-    , coverageConfidence        = undefined-    , computeSize               = undefined-    , numTotMaxShrinks          = 0-    , numSuccessTests           = success-    , numDiscardedTests         = discarded-    , numRecentlyDiscardedTests = 0-    , labels                    = mempty-    , classes                   = mempty-    , tables                    = mempty-    , requiredCoverage          = mempty-    , expected                  = True-    , randomSeed                = mkGen 0-    , numSuccessShrinks         = 0-    , numTryShrinks             = 0-    , numTotTryShrinks          = 0-    }--ensureTrailingNewline :: String -> String-ensureTrailingNewline = unlines . lines--maybeStripPrefix :: String -> String -> String-maybeStripPrefix prefix m = fromMaybe m (stripPrefix prefix m)--maybeStripSuffix :: String -> String -> String-maybeStripSuffix suffix = reverse . maybeStripPrefix (reverse suffix) . reverse--stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]-stripSuffix suffix = fmap reverse . stripPrefix (reverse suffix) . reverse--splitBy :: String -> String -> Maybe (String, String)-splitBy sep xs = listToMaybe [-    (x, y) | (x, Just y) <- zip (inits xs) (map stripSep $ tails xs)-  ]-  where-    stripSep = stripPrefix sep

@@ -121,7 +121,7 @@ import qualified Test.Hspec.Core.Formatters.V1 as V1 import qualified Test.Hspec.Core.Formatters.V2 as V2 import           Test.Hspec.Core.FailureReport-import           Test.Hspec.Core.QuickCheckUtil+import           Test.Hspec.Core.QuickCheck.Util import           Test.Hspec.Core.Shuffle  import           Test.Hspec.Core.Runner.PrintSlowSpecItems@@ -195,12 +195,12 @@  -- Add a seed to given config if there is none.  That way the same seed is used -- for all properties.  This helps with --seed and --rerun.-ensureSeed :: Config -> IO Config-ensureSeed c = case configQuickCheckSeed c of-  Nothing -> do-    seed <- newSeed-    return c {configQuickCheckSeed = Just (fromIntegral seed)}-  _       -> return c+ensureSeed :: Config -> IO (Config, Integer)+ensureSeed config = do+  seed <- case configSeed config <|> configQuickCheckSeed config of+    Nothing -> toInteger <$> newSeed+    Just seed -> return seed+  return (config { configSeed = Just seed }, seed)  -- | Run given spec with custom options. -- This is similar to `hspec`, but more flexible.@@ -355,14 +355,13 @@ runSpecForest_ :: Maybe FailureReport -> [SpecTree ()] -> Config -> IO SpecResult runSpecForest_ oldFailureReport spec c_ = do -  config <- ensureSeed (applyFailureReport oldFailureReport c_)+  (config, seed) <- ensureSeed (applyFailureReport oldFailureReport c_)    colorMode <- colorOutputSupported (configColorMode config) (hSupportsANSI stdout)   outputUnicode <- unicodeOutputSupported (configUnicodeMode config) stdout    let-    filteredSpec = specToEvalForest config spec-    seed = (fromJust . configQuickCheckSeed) config+    filteredSpec = specToEvalForest seed config spec     qcArgs = configQuickCheckArgs config     !numberOfItems = countEvalItems filteredSpec @@ -413,8 +412,8 @@    return results -specToEvalForest :: Config -> [SpecTree ()] -> [EvalTree]-specToEvalForest config =+specToEvalForest :: Integer -> Config -> [SpecTree ()] -> [EvalTree]+specToEvalForest seed config =       failItemsWithEmptyDescription config   >>> addDefaultDescriptions   >>> failFocusedItems config@@ -426,9 +425,6 @@   >>> randomize   >>> pruneForest   where-    seed :: Integer-    seed = (fromJust . configQuickCheckSeed) config-     params :: Params     params = Params (configQuickCheckArgs config) (configSmallCheckDepth config) 

@@ -91,6 +91,7 @@ import           Test.Hspec.Core.Hooks import           Test.Hspec.Core.Tree import           Test.Hspec.Core.Spec.Monad+import           Test.Hspec.Core.QuickCheck ()  -- | The @describe@ function combines a list of specs into a larger spec. describe :: HasCallStack => String -> SpecWith a -> SpecWith a

@@ -62,7 +62,7 @@  import qualified Test.Hspec.Core.Spec as H import qualified Test.Hspec.Core.Runner as H-import           Test.Hspec.Core.QuickCheckUtil (mkGen)+import           Test.Hspec.Core.QuickCheck.Util (mkGen) import           Test.Hspec.Core.Clock import           Test.Hspec.Core.Example (Result(..), ResultStatus(..), FailureReason(..), Location(..)) import           Test.Hspec.Core.Example.Location (workaroundForIssue19236)@@ -70,7 +70,7 @@ import qualified Test.Hspec.Core.Format as Format import           Test.Hspec.Core.Formatters.V2 (formatterToFormat, silent) -import           Data.Orphans()+import           Data.Orphans ()  exceptionEq :: SomeException -> SomeException -> Bool exceptionEq a b

@@ -38,7 +38,7 @@     pathToList (xs, x) = xs ++ [x]  toEvalForest :: H.SpecWith () -> IO [EvalTree]-toEvalForest = fmap (uncurry H.specToEvalForest . first (($ H.defaultConfig) . appEndo)) . H.runSpecM+toEvalForest = fmap (uncurry (H.specToEvalForest 0) . first (($ H.defaultConfig) . appEndo)) . H.runSpecM  mkAppend :: IO (String -> IO (), IO [String]) mkAppend = do

@@ -0,0 +1,251 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}+module Test.Hspec.Core.QuickCheck.UtilSpec (spec) where++import           Prelude ()+import           Helper++import qualified Test.QuickCheck.Property as QCP++import           Test.Hspec.Core.QuickCheck.Util++deriving instance Eq QuickCheckResult+deriving instance Eq Status+deriving instance Eq QuickCheckFailure++spec :: Spec+spec = do+  describe "formatNumbers" $ do+    it "includes number of tests" $ do+      formatNumbers 1 0 `shouldBe` "(after 1 test)"++    it "pluralizes number of tests" $ do+      formatNumbers 3 0 `shouldBe` "(after 3 tests)"++    it "includes number of shrinks" $ do+      formatNumbers 3 1 `shouldBe` "(after 3 tests and 1 shrink)"++    it "pluralizes number of shrinks" $ do+      formatNumbers 3 3 `shouldBe` "(after 3 tests and 3 shrinks)"++  describe "stripSuffix" $ do+    it "drops the given suffix from a list" $ do+      stripSuffix "bar" "foobar" `shouldBe` Just "foo"++  describe "splitBy" $ do+    it "splits a string by a given infix" $ do+      splitBy "bar" "foo bar baz" `shouldBe` Just ("foo ", " baz")++  describe "parseQuickCheckResult" $ do+    let+      args = stdArgs {chatty = False, replay = Just (mkGen 0, 0)}+      qc = quickCheckWithResult args++    context "with Success" $ do+      let p :: Int -> Bool+          p n = n == n++      it "parses result" $ do+        parseQuickCheckResult <$> qc p `shouldReturn`+          QuickCheckResult 100 "+++ OK, passed 100 tests." QuickCheckSuccess++      it "includes labels" $ do+        parseQuickCheckResult <$> qc (label "unit" p) `shouldReturn`+          QuickCheckResult 100 "+++ OK, passed 100 tests (100% unit)." QuickCheckSuccess++    context "with GaveUp" $ do+      let p :: Int -> Property+          p n = (n == 1234) ==> True++          qc = quickCheckWithResult args {maxSuccess = 2, maxDiscardRatio = 1}+          result = QuickCheckResult 0 "" (QuickCheckOtherFailure "Gave up after 0 tests; 2 discarded!")++      it "parses result" $ do+        parseQuickCheckResult <$> qc p `shouldReturn` result++      it "includes verbose output" $ do+        let+          info = intercalate "\n" [+              "Skipped (precondition false):"+            , "0"+            , ""+            , "Skipped (precondition false):"+            , "0"+            ]+        parseQuickCheckResult <$> qc (verbose p) `shouldReturn` result {quickCheckResultInfo = info}++    context "with NoExpectedFailure" $ do+      let+        p :: Int -> Property+        p _ = expectFailure True++      it "parses result" $ do+        parseQuickCheckResult <$> qc p `shouldReturn`+          QuickCheckResult 100 "" (QuickCheckOtherFailure "Passed 100 tests (expected failure).")++      it "includes verbose output" $ do+        let+          info = intercalate "\n" [+              "Passed:"+            , "0"+            , ""+            , "Passed:"+            , "23"+            ]+        parseQuickCheckResult <$> quickCheckWithResult args {maxSuccess = 2} (verbose p) `shouldReturn`+          QuickCheckResult 2 info (QuickCheckOtherFailure "Passed 2 tests (expected failure).")++    context "with cover" $ do+      context "without checkCoverage" $ do+        let+          p :: Int -> Property+          p n = cover 10 (n == 5) "is 5" True++        it "parses result" $ do+          parseQuickCheckResult <$> qc p `shouldReturn`+            QuickCheckResult 100 "+++ OK, passed 100 tests (1% is 5).\n\nOnly 1% is 5, but expected 10%" QuickCheckSuccess++        it "includes verbose output" $ do+          let+            info = intercalate "\n" [+                "Passed:"+              , "0"+              , ""+              , "Passed:"+              , "23"+              , ""+#if MIN_VERSION_QuickCheck(2,15,0)+              , "+++ OK, passed 2 tests (0% is 5)."+#else+              , "+++ OK, passed 2 tests."+#endif+              , ""+              , "Only 0% is 5, but expected 10%"+              ]+          parseQuickCheckResult <$> quickCheckWithResult args {maxSuccess = 2} (verbose p) `shouldReturn`+            QuickCheckResult 2 info QuickCheckSuccess++      context "with checkCoverage" $ do+        let+          p :: Int -> Property+          p n = checkCoverage $ cover 10 (n == 23) "is 23" True++          failure :: QuickCheckFailure+          failure = QCFailure {+              quickCheckFailureNumShrinks = 0+            , quickCheckFailureException = Nothing+            , quickCheckFailureReason = "Insufficient coverage"+            , quickCheckFailureCounterexample = [+                " 0.9% is 23"+              , ""+              , "Only 0.9% is 23, but expected 10.0%"+              ]+            }++        it "parses result" $ do+          parseQuickCheckResult <$> qc p `shouldReturn`+            QuickCheckResult 800 "" (QuickCheckFailure failure)++        it "includes verbose output" $ do+-- This off-by-one error was fixed in QuickCheck 2.15+#if MIN_VERSION_QuickCheck(2,15,0)+          let info = intercalate "\n\n" (replicate 800 "Passed:")+#else+          let info = intercalate "\n\n" (replicate 799 "Passed:")+#endif+          parseQuickCheckResult <$> qc (verbose . p) `shouldReturn`+            QuickCheckResult 800 info (QuickCheckFailure failure)++    context "with Failure" $ do+      context "with single-line failure reason" $ do+        let+          p :: Int -> Bool+          p = (< 1)++          err = "Falsified"+          result = QuickCheckResult 4 "" (QuickCheckFailure $ QCFailure 2 Nothing err ["1"])++        it "parses result" $ do+          parseQuickCheckResult <$> qc p `shouldReturn` result++        it "includes verbose output" $ do+          let info = intercalate "\n" [+                  "Passed:"+                , "0"+                , ""+                , "Passed:"+                , "0"+                , ""+                , "Passed:"+                , "-2"+                , ""+                , "Failed:"+                , "3"+                , ""+                , "Passed:"+                , "0"+                , ""+                , "Failed:"+                , "2"+                , ""+                , "Passed:"+                , "0"+                , ""+                , "Failed:"+                , "1"+                , ""+                , "Passed:"+                , "0"+                ]++          parseQuickCheckResult <$> qc (verbose p) `shouldReturn` result {quickCheckResultInfo = info}++      context "with multi-line failure reason" $ do+        let+          p :: Int -> QCP.Result+          p n = if n /= 2 then QCP.succeeded else QCP.failed {QCP.reason = err}++          err = "foo\nbar"+          result = QuickCheckResult 5 "" (QuickCheckFailure $ QCFailure 0 Nothing err ["2"])++        it "parses result" $ do+          parseQuickCheckResult <$> qc p `shouldReturn` result++        it "includes verbose output" $ do+          let info = intercalate "\n" [+                  "Passed:"+                , "0"+                , ""+                , "Passed:"+                , "0"+                , ""+                , "Passed:"+                , "-2"+                , ""+                , "Passed:"+                , "3"+                , ""+                , "Failed:"+                , "2"+                , ""+                , "Passed:"+                , "0"+                , ""+                , "Passed:"+                , "1"+                ]+          parseQuickCheckResult <$> qc (verbose p) `shouldReturn` result {quickCheckResultInfo = info}++      context "with HUnit assertion" $ do+        let p :: Int -> Int -> Expectation+            p m n = do+              m `shouldBe` n++        it "includes counterexample" $ do+          result <- qc p+          let QuickCheckResult _ _ (QuickCheckFailure r) = parseQuickCheckResult result+          quickCheckFailureCounterexample r `shouldBe` ["0", "1"]

@@ -1,241 +0,0 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}-module Test.Hspec.Core.QuickCheckUtilSpec (spec) where--import           Prelude ()-import           Helper--import qualified Test.QuickCheck.Property as QCP--import           Test.Hspec.Core.QuickCheckUtil--deriving instance Eq QuickCheckResult-deriving instance Eq Status-deriving instance Eq QuickCheckFailure--spec :: Spec-spec = do-  describe "formatNumbers" $ do-    it "includes number of tests" $ do-      formatNumbers 1 0 `shouldBe` "(after 1 test)"--    it "pluralizes number of tests" $ do-      formatNumbers 3 0 `shouldBe` "(after 3 tests)"--    it "includes number of shrinks" $ do-      formatNumbers 3 1 `shouldBe` "(after 3 tests and 1 shrink)"--    it "pluralizes number of shrinks" $ do-      formatNumbers 3 3 `shouldBe` "(after 3 tests and 3 shrinks)"--  describe "stripSuffix" $ do-    it "drops the given suffix from a list" $ do-      stripSuffix "bar" "foobar" `shouldBe` Just "foo"--  describe "splitBy" $ do-    it "splits a string by a given infix" $ do-      splitBy "bar" "foo bar baz" `shouldBe` Just ("foo ", " baz")--  describe "parseQuickCheckResult" $ do-    let-      args = stdArgs {chatty = False, replay = Just (mkGen 0, 0)}-      qc = quickCheckWithResult args--    context "with Success" $ do-      let p :: Int -> Bool-          p n = n == n--      it "parses result" $ do-        parseQuickCheckResult <$> qc p `shouldReturn`-          QuickCheckResult 100 "+++ OK, passed 100 tests." QuickCheckSuccess--      it "includes labels" $ do-        parseQuickCheckResult <$> qc (label "unit" p) `shouldReturn`-          QuickCheckResult 100 "+++ OK, passed 100 tests (100% unit)." QuickCheckSuccess--    context "with GaveUp" $ do-      let p :: Int -> Property-          p n = (n == 1234) ==> True--          qc = quickCheckWithResult args {maxSuccess = 2, maxDiscardRatio = 1}-          result = QuickCheckResult 0 "" (QuickCheckOtherFailure "Gave up after 0 tests; 2 discarded!")--      it "parses result" $ do-        parseQuickCheckResult <$> qc p `shouldReturn` result--      it "includes verbose output" $ do-        let-          info = intercalate "\n" [-              "Skipped (precondition false):"-            , "0"-            , ""-            , "Skipped (precondition false):"-            , "0"-            ]-        parseQuickCheckResult <$> qc (verbose p) `shouldReturn` result {quickCheckResultInfo = info}--    context "with NoExpectedFailure" $ do-      let-        p :: Int -> Property-        p _ = expectFailure True--      it "parses result" $ do-        parseQuickCheckResult <$> qc p `shouldReturn`-          QuickCheckResult 100 "" (QuickCheckOtherFailure "Passed 100 tests (expected failure).")--      it "includes verbose output" $ do-        let-          info = intercalate "\n" [-              "Passed:"-            , "0"-            , ""-            , "Passed:"-            , "23"-            ]-        parseQuickCheckResult <$> quickCheckWithResult args {maxSuccess = 2} (verbose p) `shouldReturn`-          QuickCheckResult 2 info (QuickCheckOtherFailure "Passed 2 tests (expected failure).")--    context "with cover" $ do-      context "without checkCoverage" $ do-        let-          p :: Int -> Property-          p n = cover 10 (n == 5) "is 5" True--        it "parses result" $ do-          parseQuickCheckResult <$> qc p `shouldReturn`-            QuickCheckResult 100 "+++ OK, passed 100 tests (1% is 5).\n\nOnly 1% is 5, but expected 10%" QuickCheckSuccess--        it "includes verbose output" $ do-          let-            info = intercalate "\n" [-                "Passed:"-              , "0"-              , ""-              , "Passed:"-              , "23"-              , ""-              , "+++ OK, passed 2 tests."-              , ""-              , "Only 0% is 5, but expected 10%"-              ]-          parseQuickCheckResult <$> quickCheckWithResult args {maxSuccess = 2} (verbose p) `shouldReturn`-            QuickCheckResult 2 info QuickCheckSuccess--      context "with checkCoverage" $ do-        let-          p :: Int -> Property-          p n = checkCoverage $ cover 10 (n == 23) "is 23" True--          failure :: QuickCheckFailure-          failure = QCFailure {-              quickCheckFailureNumShrinks = 0-            , quickCheckFailureException = Nothing-            , quickCheckFailureReason = "Insufficient coverage"-            , quickCheckFailureCounterexample = [-                " 0.9% is 23"-              , ""-              , "Only 0.9% is 23, but expected 10.0%"-              ]-            }--        it "parses result" $ do-          parseQuickCheckResult <$> qc p `shouldReturn`-            QuickCheckResult 800 "" (QuickCheckFailure failure)--        it "includes verbose output" $ do-          let info = intercalate "\n\n" (replicate 799 "Passed:")-          parseQuickCheckResult <$> qc (verbose . p) `shouldReturn`-            QuickCheckResult 800 info (QuickCheckFailure failure)--    context "with Failure" $ do-      context "with single-line failure reason" $ do-        let-          p :: Int -> Bool-          p = (< 1)--          err = "Falsified"-          result = QuickCheckResult 4 "" (QuickCheckFailure $ QCFailure 2 Nothing err ["1"])--        it "parses result" $ do-          parseQuickCheckResult <$> qc p `shouldReturn` result--        it "includes verbose output" $ do-          let info = intercalate "\n" [-                  "Passed:"-                , "0"-                , ""-                , "Passed:"-                , "0"-                , ""-                , "Passed:"-                , "-2"-                , ""-                , "Failed:"-                , "3"-                , ""-                , "Passed:"-                , "0"-                , ""-                , "Failed:"-                , "2"-                , ""-                , "Passed:"-                , "0"-                , ""-                , "Failed:"-                , "1"-                , ""-                , "Passed:"-                , "0"-                ]--          parseQuickCheckResult <$> qc (verbose p) `shouldReturn` result {quickCheckResultInfo = info}--      context "with multi-line failure reason" $ do-        let-          p :: Int -> QCP.Result-          p n = if n /= 2 then QCP.succeeded else QCP.failed {QCP.reason = err}--          err = "foo\nbar"-          result = QuickCheckResult 5 "" (QuickCheckFailure $ QCFailure 0 Nothing err ["2"])--        it "parses result" $ do-          parseQuickCheckResult <$> qc p `shouldReturn` result--        it "includes verbose output" $ do-          let info = intercalate "\n" [-                  "Passed:"-                , "0"-                , ""-                , "Passed:"-                , "0"-                , ""-                , "Passed:"-                , "-2"-                , ""-                , "Passed:"-                , "3"-                , ""-                , "Failed:"-                , "2"-                , ""-                , "Passed:"-                , "0"-                , ""-                , "Passed:"-                , "1"-                ]-          parseQuickCheckResult <$> qc (verbose p) `shouldReturn` result {quickCheckResultInfo = info}--      context "with HUnit assertion" $ do-        let p :: Int -> Int -> Expectation-            p m n = do-              m `shouldBe` n--        it "includes counterexample" $ do-          result <- qc p-          let QuickCheckResult _ _ (QuickCheckFailure r) = parseQuickCheckResult result-          quickCheckFailureCounterexample r `shouldBe` ["0", "1"]

@@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-} module Test.Hspec.Core.RunnerSpec (spec) where  import           Prelude ()@@ -762,31 +764,43 @@           r `shouldContain` "invalid argument `foo' for `--format'"      context "with --qc-max-success" $ do+      let+        run :: HasCallStack => String -> IO ()+        run option = do+          m <- newMock+          hspec [option, "23"] $ do+            H.it "foo" $ property $ \(_ :: Int) -> do+              mockAction m+          mockCounter m `shouldReturn` 23+       it "tries QuickCheck properties specified number of times" $ do-        m <- newMock-        hspec ["--qc-max-success", "23"] $ do-          H.it "foo" $ property $ \(_ :: Int) -> do-            mockAction m-        mockCounter m `shouldReturn` 23+        run "--qc-max-success" +      it "accepts --maximum-generated-tests as an alias" $ do+        run "--maximum-generated-tests"+       context "when run with --rerun" $ do         it "takes precedence" $ do           ["--qc-max-success", "23"] `shouldUseArgs` (QC.maxSuccess, 23)           ["--rerun", "--qc-max-success", "42"] `shouldUseArgs` (QC.maxSuccess, 42) +    context "with --qc-max-discard" $ do+      it "passes specified maxDiscardRatio to QuickCheck properties" $ do+        ["--qc-max-discard", "23"] `shouldUseArgs` (QC.maxDiscardRatio, 23)+     context "with --qc-max-size" $ do-      it "passes specified size to QuickCheck properties" $ do+      it "passes specified maxSize to QuickCheck properties" $ do         ["--qc-max-size", "23"] `shouldUseArgs` (QC.maxSize, 23) -    context "with --qc-max-discard" $ do-      it "uses specified discard ratio to QuickCheck properties" $ do-        ["--qc-max-discard", "23"] `shouldUseArgs` (QC.maxDiscardRatio, 23)+    context "with --qc-max-shrinks" $ do+      it "passes specified maxShrinks to QuickCheck properties" $ do+        ["--qc-max-shrinks", "23"] `shouldUseArgs` (QC.maxShrinks, 23)      describe "Test.QuickCheck.Args.chatty" $ do       let         setChatty value args = args { chatty = value }         withChatty value = hspecCapture [] .  H.modifyArgs (setChatty value) $ do-          H.it "foo" $ property True+          H.it "foo" $ once $ property True        context "when True" $ do         it "includes informational output" $ do

@@ -1,4 +1,4 @@-version: &version 2.11.7+version: &version 2.11.8 synopsis: A Testing Framework for Haskell author: Simon Hengel <sol@typeful.net> maintainer: Simon Hengel <sol@typeful.net>