diff --git a/hspec-core.cabal b/hspec-core.cabal --- a/hspec-core.cabal +++ b/hspec-core.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.1. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack name: hspec-core -version: 2.10.9 +version: 2.10.10 license: MIT license-file: LICENSE copyright: (c) 2011-2023 Simon Hengel, diff --git a/src/Test/Hspec/Core/Compat.hs b/src/Test/Hspec/Core/Compat.hs --- a/src/Test/Hspec/Core/Compat.hs +++ b/src/Test/Hspec/Core/Compat.hs @@ -85,6 +85,10 @@ import Data.Ord (comparing) #endif +#if MIN_VERSION_base(4,7,0) +import Data.Bool as Imports (bool) +#endif + import Data.Typeable (tyConModule, tyConName) import Control.Concurrent @@ -168,6 +172,12 @@ sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) +#endif + +#if !MIN_VERSION_base(4,7,0) +bool :: a -> a -> Bool -> a +bool f _ False = f +bool _ t True = t #endif #if !MIN_VERSION_base(4,11,0) diff --git a/src/Test/Hspec/Core/Config/Definition.hs b/src/Test/Hspec/Core/Config/Definition.hs --- a/src/Test/Hspec/Core/Config/Definition.hs +++ b/src/Test/Hspec/Core/Config/Definition.hs @@ -81,7 +81,7 @@ , configPrettyPrint :: Bool , configPrettyPrintFunction :: Bool -> String -> String -> (String, String) , configTimes :: Bool -, configAvailableFormatters :: [(String, FormatConfig -> IO Format)] +, configAvailableFormatters :: [(String, FormatConfig -> IO Format)] -- ^ @since 2.9.0 , configFormat :: Maybe (FormatConfig -> IO Format) , configFormatter :: Maybe V1.Formatter -- ^ deprecated, use `configFormat` instead , configHtmlOutput :: Bool diff --git a/src/Test/Hspec/Core/Formatters/Internal.hs b/src/Test/Hspec/Core/Formatters/Internal.hs --- a/src/Test/Hspec/Core/Formatters/Internal.hs +++ b/src/Test/Hspec/Core/Formatters/Internal.hs @@ -144,6 +144,8 @@ prettyPrintFunction = getConfig formatConfigPrettyPrintFunction -- | Return `True` if the user requested unicode output, `False` otherwise. +-- +-- @since 2.9.0 outputUnicode :: FormatM Bool outputUnicode = getConfig formatConfigOutputUnicode @@ -239,6 +241,8 @@ -- | Get the number of spec items that will have been encountered when this run -- completes (if it is not terminated early). +-- +-- @since 2.9.0 getExpectedTotalCount :: FormatM Int getExpectedTotalCount = getConfig formatConfigExpectedTotalCount diff --git a/src/Test/Hspec/Core/Runner.hs b/src/Test/Hspec/Core/Runner.hs --- a/src/Test/Hspec/Core/Runner.hs +++ b/src/Test/Hspec/Core/Runner.hs @@ -80,6 +80,8 @@ , SpecWith #ifdef TEST +, UseColor(..) +, ProgressReporting(..) , rerunAll , specToEvalForest , colorOutputSupported @@ -163,11 +165,7 @@ -- is not always desirable. Use `evalSpec` and `runSpecForest` if you need -- more control over these aspects. hspec :: Spec -> IO () -hspec = evalSpec defaultConfig >=> \ (config, spec) -> - getArgs - >>= readConfig config - >>= doNotLeakCommandLineArgumentsToExamples . runSpecForest spec - >>= evaluateResult +hspec = hspecWith defaultConfig -- | -- Evaluate a `Spec` to a forest of `SpecTree`s. This does not execute any @@ -195,16 +193,7 @@ -- | Run given spec with custom options. -- This is similar to `hspec`, but more flexible. hspecWith :: Config -> Spec -> IO () -hspecWith defaults = evalSpec defaults >=> \ (config, spec) -> - getArgs - >>= readConfig config - >>= doNotLeakCommandLineArgumentsToExamples . runSpecForest spec - >>= evaluateResult - --- | `True` if the given `Summary` indicates that there were no --- failures, `False` otherwise. -isSuccess :: Summary -> Bool -isSuccess summary = summaryFailures summary == 0 +hspecWith defaults = hspecWithSpecResult defaults >=> evaluateResult -- | Exit with `exitFailure` if the given `Summary` indicates that there was at -- least one failure. @@ -228,11 +217,39 @@ -- items. If you need this, you have to check the `Summary` yourself and act -- accordingly. hspecWithResult :: Config -> Spec -> IO Summary -hspecWithResult defaults = evalSpec defaults >=> \ (config, spec) -> - getArgs - >>= readConfig config - >>= doNotLeakCommandLineArgumentsToExamples . fmap toSummary . runSpecForest spec +hspecWithResult config = fmap toSummary . hspecWithSpecResult config +hspecWithSpecResult :: Config -> Spec -> IO SpecResult +hspecWithSpecResult defaults spec = do + (c, forest) <- evalSpec defaults spec + config <- getArgs >>= readConfig c + oldFailureReport <- readFailureReportOnRerun config + + let + normalMode :: IO SpecResult + normalMode = doNotLeakCommandLineArgumentsToExamples $ runSpecForest_ oldFailureReport forest config + + rerunAllMode :: IO SpecResult + rerunAllMode = do + result <- normalMode + if rerunAll config oldFailureReport result then + hspecWithSpecResult defaults spec + else + return result + + -- With --rerun-all we may run the spec twice. For that reason GHC can not + -- optimize away the spec tree. That means that the whole spec tree has to + -- be constructed in memory and we loose constant space behavior. + -- + -- By separating between rerunAllMode and normalMode here, we retain + -- constant space behavior in normalMode. + -- + -- see: https://github.com/hspec/hspec/issues/169 + if configRerunAllOnSuccess config then do + rerunAllMode + else do + normalMode + -- | -- /Note/: `runSpec` is deprecated. It ignores any modifications applied -- through `modifyConfig`. Use `evalSpec` and `runSpecForest` instead. @@ -253,29 +270,9 @@ -- -- @since 2.10.0 runSpecForest :: [SpecTree ()] -> Config -> IO SpecResult -runSpecForest spec c_ = do - oldFailureReport <- readFailureReportOnRerun c_ - - c <- ensureSeed (applyFailureReport oldFailureReport c_) - - if configRerunAllOnSuccess c - -- With --rerun-all we may run the spec twice. For that reason GHC can not - -- optimize away the spec tree. That means that the whole spec tree has to - -- be constructed in memory and we loose constant space behavior. - -- - -- By separating between rerunAllMode and normalMode here, we retain - -- constant space behavior in normalMode. - -- - -- see: https://github.com/hspec/hspec/issues/169 - then rerunAllMode c oldFailureReport - else normalMode c - where - normalMode c = runSpecForest_ c spec - rerunAllMode c oldFailureReport = do - result <- runSpecForest_ c spec - if rerunAll c oldFailureReport result - then runSpecForest spec c_ - else return result +runSpecForest spec config = do + oldFailureReport <- readFailureReportOnRerun config + runSpecForest_ oldFailureReport spec config mapItem :: (Item a -> Item b) -> [SpecTree a] -> [SpecTree b] mapItem f = map (fmap f) @@ -321,8 +318,14 @@ | configFocusedOnly config = spec | otherwise = focusForest spec -runSpecForest_ :: Config -> [SpecTree ()] -> IO SpecResult -runSpecForest_ config spec = do +runSpecForest_ :: Maybe FailureReport -> [SpecTree ()] -> Config -> IO SpecResult +runSpecForest_ oldFailureReport spec c_ = do + + config <- ensureSeed (applyFailureReport oldFailureReport c_) + + colorMode <- colorOutputSupported (configColorMode config) (hSupportsANSI stdout) + outputUnicode <- unicodeOutputSupported (configUnicodeMode config) stdout + let filteredSpec = specToEvalForest config spec seed = (fromJust . configQuickCheckSeed) config @@ -333,18 +336,13 @@ when (countSpecItems spec /= 0) $ do die "all spec items have been filtered; failing due to --fail-on=empty" - concurrentJobs <- case configConcurrentJobs config of - Nothing -> getDefaultConcurrentJobs - Just n -> return n - - (reportProgress, useColor) <- colorOutputSupported (configColorMode config) (hSupportsANSI stdout) - outputUnicode <- unicodeOutputSupported (configUnicodeMode config) stdout + concurrentJobs <- maybe getDefaultConcurrentJobs return $ configConcurrentJobs config - results <- fmap toSpecResult . withHiddenCursor reportProgress stdout $ do + results <- fmap toSpecResult . withHiddenCursor (progressReporting colorMode) stdout $ do let formatConfig = FormatConfig { - formatConfigUseColor = useColor - , formatConfigReportProgress = reportProgress + formatConfigUseColor = shouldUseColor colorMode + , formatConfigReportProgress = progressReporting colorMode == ProgressReportingEnabled , formatConfigOutputUnicode = outputUnicode , formatConfigUseDiff = configDiff config , formatConfigDiffContext = configDiffContext config @@ -378,14 +376,6 @@ return results -toSummary :: SpecResult -> Summary -toSummary result = Summary { - summaryExamples = length items -, summaryFailures = length failures -} where - items = specResultItems result - failures = filter resultItemIsFailure items - specToEvalForest :: Config -> [SpecTree ()] -> [EvalTree] specToEvalForest config = failFocusedItems config @@ -448,21 +438,43 @@ doNotLeakCommandLineArgumentsToExamples :: IO a -> IO a doNotLeakCommandLineArgumentsToExamples = withArgs [] -withHiddenCursor :: Bool -> Handle -> IO a -> IO a -withHiddenCursor reportProgress h - | reportProgress = bracket_ (hHideCursor h) (hShowCursor h) - | otherwise = id +withHiddenCursor :: ProgressReporting -> Handle -> IO a -> IO a +withHiddenCursor progress h = case progress of + ProgressReportingDisabled -> id + ProgressReportingEnabled -> bracket_ (hHideCursor h) (hShowCursor h) -colorOutputSupported :: ColorMode -> IO Bool -> IO (Bool, Bool) +data UseColor = ColorDisabled | ColorEnabled ProgressReporting + deriving (Eq, Show) + +data ProgressReporting = ProgressReportingDisabled | ProgressReportingEnabled + deriving (Eq, Show) + +shouldUseColor :: UseColor -> Bool +shouldUseColor c = case c of + ColorDisabled -> False + ColorEnabled _ -> True + +progressReporting :: UseColor -> ProgressReporting +progressReporting c = case c of + ColorDisabled -> ProgressReportingDisabled + ColorEnabled r -> r + +colorOutputSupported :: ColorMode -> IO Bool -> IO UseColor colorOutputSupported mode isTerminalDevice = do github <- githubActions buildkite <- lookupEnv "BUILDKITE" <&> (== Just "true") - useColor <- case mode of - ColorAuto -> (github ||) <$> colorTerminal - ColorNever -> return False - ColorAlways -> return True - let reportProgress = not github && not buildkite && useColor - return (reportProgress, useColor) + let + progress :: ProgressReporting + progress + | github || buildkite = ProgressReportingDisabled + | otherwise = ProgressReportingEnabled + + colorEnabled :: UseColor + colorEnabled = ColorEnabled progress + case mode of + ColorAuto -> bool ColorDisabled colorEnabled . (github ||) <$> colorTerminal + ColorNever -> return ColorDisabled + ColorAlways -> return colorEnabled where githubActions :: IO Bool githubActions = lookupEnv "GITHUB_ACTIONS" <&> (== Just "true") @@ -487,25 +499,6 @@ && configRerun config && specResultSuccess result && (not . null) (failureReportPaths oldFailureReport) - --- | Summary of a test run. -data Summary = Summary { - summaryExamples :: !Int -, summaryFailures :: !Int -} deriving (Eq, Show) - -instance Monoid Summary where - mempty = Summary 0 0 -#if MIN_VERSION_base(4,11,0) -instance Semigroup Summary where -#endif - (Summary x1 x2) -#if MIN_VERSION_base(4,11,0) - <> -#else - `mappend` -#endif - (Summary y1 y2) = Summary (x1 + y1) (x2 + y2) randomizeForest :: Integer -> [Tree c a] -> [Tree c a] randomizeForest seed t = runST $ do diff --git a/src/Test/Hspec/Core/Runner/Result.hs b/src/Test/Hspec/Core/Runner/Result.hs --- a/src/Test/Hspec/Core/Runner/Result.hs +++ b/src/Test/Hspec/Core/Runner/Result.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Test.Hspec.Core.Runner.Result ( -- RE-EXPORTED from Test.Hspec.Core.Runner SpecResult(SpecResult) @@ -10,6 +11,10 @@ , resultItemIsFailure , ResultItemStatus(..) + +, Summary(..) +, toSummary +, isSuccess -- END RE-EXPORTED from Test.Hspec.Core.Runner , toSpecResult @@ -72,3 +77,35 @@ Format.Success{} -> ResultItemSuccess Format.Pending{} -> ResultItemPending Format.Failure{} -> ResultItemFailure + +-- | Summary of a test run. +data Summary = Summary { + summaryExamples :: !Int +, summaryFailures :: !Int +} deriving (Eq, Show) + +instance Monoid Summary where + mempty = Summary 0 0 +#if MIN_VERSION_base(4,11,0) +instance Semigroup Summary where +#endif + (Summary x1 x2) +#if MIN_VERSION_base(4,11,0) + <> +#else + `mappend` +#endif + (Summary y1 y2) = Summary (x1 + y1) (x2 + y2) + +toSummary :: SpecResult -> Summary +toSummary result = Summary { + summaryExamples = length items +, summaryFailures = length failures +} where + items = specResultItems result + failures = filter resultItemIsFailure items + +-- | `True` if the given `Summary` indicates that there were no +-- failures, `False` otherwise. +isSuccess :: Summary -> Bool +isSuccess summary = summaryFailures summary == 0 diff --git a/test/Helper.hs b/test/Helper.hs --- a/test/Helper.hs +++ b/test/Helper.hs @@ -25,6 +25,8 @@ , withEnvironment , inTempDirectory +, hspecSilent +, hspecResultSilent , shouldUseArgs , removeLocations @@ -60,6 +62,7 @@ import Test.Hspec.Core.Example.Location (workaroundForIssue19236) import Test.Hspec.Core.Util import qualified Test.Hspec.Core.Format as Format +import Test.Hspec.Core.Formatters.V2 (formatterToFormat, silent) import Data.Orphans() @@ -117,14 +120,29 @@ noOpProgressCallback :: H.ProgressCallback noOpProgressCallback _ = pass -shouldUseArgs :: HasCallStack => [String] -> (Args -> Bool) -> Expectation -shouldUseArgs args p = do - spy <- newIORef (H.paramsQuickCheckArgs defaultParams) - let interceptArgs item = item {H.itemExample = \params action progressCallback -> writeIORef spy (H.paramsQuickCheckArgs params) >> H.itemExample item params action progressCallback} - spec = H.mapSpecItem_ interceptArgs $ - H.it "foo" False - (silence . ignoreExitCode . withArgs args . H.hspec) spec - readIORef spy >>= (`shouldSatisfy` p) +silentConfig :: H.Config +silentConfig = H.defaultConfig {H.configFormat = Just $ formatterToFormat silent} + +hspecSilent :: H.Spec -> IO () +hspecSilent = H.hspecWith silentConfig + +hspecResultSilent :: H.Spec -> IO H.Summary +hspecResultSilent = H.hspecWithResult silentConfig + +shouldUseArgs :: HasCallStack => (Eq n, Show n) => [String] -> (Args -> n, n) -> Expectation +shouldUseArgs args (accessor, expected) = do + spy <- newIORef stdArgs + let + interceptArgs :: H.Item a -> H.Item a + interceptArgs item = item { + H.itemExample = \ params action progressCallback -> do + writeIORef spy (H.paramsQuickCheckArgs params) + H.itemExample item params action progressCallback + } + spec :: H.Spec + spec = H.mapSpecItem_ interceptArgs $ H.it "" True + withArgs args $ hspecSilent spec + accessor <$> readIORef spy `shouldReturn` expected removeLocations :: H.SpecWith a -> H.SpecWith a removeLocations = H.mapSpecItem_ $ \ item -> item { diff --git a/test/Test/Hspec/Core/ExampleSpec.hs b/test/Test/Hspec/Core/ExampleSpec.hs --- a/test/Test/Hspec/Core/ExampleSpec.hs +++ b/test/Test/Hspec/Core/ExampleSpec.hs @@ -243,14 +243,14 @@ context "as a QuickCheck property" $ do it "can be quantified" $ do e <- newMock - silence . H.hspec $ do + hspecSilent $ do H.it "some behavior" $ property $ \xs -> do mockAction e (reverse . reverse) xs `shouldBe` (xs :: [Int]) mockCounter e `shouldReturn` 100 it "can be used with expectations/HUnit assertions" $ do - silence . H.hspecResult $ do + hspecResultSilent $ do H.describe "readIO" $ do H.it "is inverse to show" $ property $ \x -> do (readIO . show) x `shouldReturn` (x :: Int) diff --git a/test/Test/Hspec/Core/Runner/ResultSpec.hs b/test/Test/Hspec/Core/Runner/ResultSpec.hs --- a/test/Test/Hspec/Core/Runner/ResultSpec.hs +++ b/test/Test/Hspec/Core/Runner/ResultSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module Test.Hspec.Core.Runner.ResultSpec (spec) where import Prelude () @@ -9,11 +10,23 @@ spec :: Spec spec = do - describe "specResultSuccess" $ do + describe "Summary" $ do let - failure = Failure Nothing NoReason - item result = (([], ""), Item Nothing 0 "" result) + summary :: Summary + summary = toSummary $ toSpecResult [item Success, item failure] + it "can be deconstructed via accessor functions" $ do + (summaryExamples &&& summaryFailures) summary `shouldBe` (2, 1) + + it "can be deconstructed via pattern matching" $ do + let Summary examples failures = summary + (examples, failures) `shouldBe` (2, 1) + + it "can be deconstructed via RecordWildCards" $ do + let Summary{..} = summary + (summaryExamples, summaryFailures) `shouldBe` (2, 1) + + describe "specResultSuccess" $ do context "when all spec items passed" $ do it "returns True" $ do specResultSuccess (toSpecResult [item Success]) `shouldBe` True @@ -25,3 +38,6 @@ context "with an empty result list" $ do it "returns True" $ do specResultSuccess (toSpecResult []) `shouldBe` True + where + failure = Failure Nothing NoReason + item result = (([], ""), Item Nothing 0 "" result) diff --git a/test/Test/Hspec/Core/RunnerSpec.hs b/test/Test/Hspec/Core/RunnerSpec.hs --- a/test/Test/Hspec/Core/RunnerSpec.hs +++ b/test/Test/Hspec/Core/RunnerSpec.hs @@ -24,9 +24,9 @@ import Test.Hspec.Core.FailureReport (FailureReport(..)) import qualified Test.Hspec.Expectations as H import qualified Test.Hspec.Core.Spec as H +import Test.Hspec.Core.Runner (UseColor(..), ProgressReporting(..)) import qualified Test.Hspec.Core.Runner as H import Test.Hspec.Core.Runner.Result -import qualified Test.Hspec.Core.Formatters.V2 as V2 import qualified Test.Hspec.Core.QuickCheck as H import qualified Test.QuickCheck as QC @@ -34,9 +34,6 @@ import Test.Hspec.Core.Formatters.Pretty.ParserSpec (Person(..)) -quickCheckOptions :: [([Char], Args -> Int)] -quickCheckOptions = [("--qc-max-success", QC.maxSuccess), ("--qc-max-size", QC.maxSize), ("--qc-max-discard", QC.maxDiscardRatio)] - runPropFoo :: [String] -> IO String runPropFoo args = unlines . normalizeSummary . lines <$> do capture_ . ignoreExitCode . withArgs args . H.hspec . H.modifyMaxSuccess (const 1000000) $ do @@ -51,8 +48,8 @@ describe "hspec" $ do let - hspec args = withArgs ("--format=silent" : args) . H.hspec - hspec_ = hspec [] + hspec args = withArgs args . hspecSilent + hspec_ = hspecSilent it "evaluates examples Unmasked" $ do mvar <- newEmptyMVar @@ -115,66 +112,99 @@ ] } - describe "with --rerun" $ do - let runSpec = (captureLines . ignoreExitCode . H.hspec) $ do - H.it "example 1" True - H.it "example 2" False - H.it "example 3" False - H.it "example 4" True - H.it "example 5" False + context "with --rerun" $ do + let + failingSpec = do + H.it "example 1" True + H.it "example 2" False + H.it "example 3" False + H.it "example 4" True + H.it "example 5" False - it "reruns examples that previously failed" $ do - r0 <- runSpec - r0 `shouldSatisfy` elem "5 examples, 3 failures" + succeedingSpec = do + H.it "example 1" True + H.it "example 2" True + H.it "example 3" True + H.it "example 4" True + H.it "example 5" True - r1 <- withArgs ["--rerun"] runSpec - r1 `shouldSatisfy` elem "3 examples, 3 failures" + run = captureLines . H.hspecResult + rerun = withArgs ["--rerun"] . run - it "reuses the same seed" $ do + it "reuses same --seed" $ do r <- runPropFoo ["--seed", "42"] runPropFoo ["--rerun"] `shouldReturn` r - forM_ quickCheckOptions $ \(name, accessor) -> do - it ("reuses same " ++ name) $ do - [name, "23"] `shouldUseArgs` ((== 23) . accessor) - ["--rerun"] `shouldUseArgs` ((== 23) . accessor) + it "reuses same --qc-max-success" $ do + n <- generate arbitrary + ["--qc-max-success", show n] `shouldUseArgs` (QC.maxSuccess, n) + ["--rerun"] `shouldUseArgs` (QC.maxSuccess, n) - context "when no examples failed previously" $ do - it "runs all examples" $ do - let run = capture_ . H.hspec $ do - H.it "example 1" True - H.it "example 2" True - H.it "example 3" True + it "reuses same --qc-max-discard" $ do + n <- generate arbitrary + ["--qc-max-discard", show n] `shouldUseArgs` (QC.maxDiscardRatio, n) + ["--rerun"] `shouldUseArgs` (QC.maxDiscardRatio, n) - r0 <- run - r0 `shouldContain` "3 examples, 0 failures" + it "reuses same --qc-max-size" $ do + n <- generate arbitrary + ["--qc-max-size", show n] `shouldUseArgs` (QC.maxSize, n) + ["--rerun"] `shouldUseArgs` (QC.maxSize, n) - r1 <- withArgs ["--rerun"] run - r1 `shouldContain` "3 examples, 0 failures" + context "with failing examples" $ do + it "only reruns failing examples" $ do + r0 <- run failingSpec + last r0 `shouldBe` "5 examples, 3 failures" + r1 <- rerun failingSpec + last r1 `shouldBe` "3 examples, 3 failures" + + context "without failing examples" $ do + it "runs all examples" $ do + r0 <- run succeedingSpec + last r0 `shouldBe` "5 examples, 0 failures" + + r1 <- rerun succeedingSpec + last r1 `shouldBe` "5 examples, 0 failures" + context "when there is no failure report in the environment" $ do - it "runs everything" $ do + it "runs all examples" $ do unsetEnv "HSPEC_FAILURES" - r <- hSilence [stderr] $ withArgs ["--rerun"] runSpec + r <- hSilence [stderr] $ rerun failingSpec r `shouldSatisfy` elem "5 examples, 3 failures" it "prints a warning to stderr" $ do unsetEnv "HSPEC_FAILURES" - r <- hCapture_ [stderr] $ withArgs ["--rerun"] runSpec + r <- hCapture_ [stderr] $ rerun failingSpec r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n" context "when parsing of failure report fails" $ do - it "runs everything" $ do + it "runs all examples" $ do setEnv "HSPEC_FAILURES" "some invalid report" - r <- hSilence [stderr] $ withArgs ["--rerun"] runSpec + r <- hSilence [stderr] $ rerun failingSpec r `shouldSatisfy` elem "5 examples, 3 failures" it "prints a warning to stderr" $ do setEnv "HSPEC_FAILURES" "some invalid report" - r <- hCapture_ [stderr] $ withArgs ["--rerun"] runSpec + r <- hCapture_ [stderr] $ rerun failingSpec r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n" + context "with --rerun-all-on-success" $ do + let rerunAllOnSuccess = withArgs ["--rerun", "--rerun-all-on-success"] . run + context "after a previously failing rerun succeeds for the first time" $ do + it "runs the whole test suite" $ do + _ <- run failingSpec + output <- rerunAllOnSuccess succeedingSpec + output `shouldSatisfy` elem "3 examples, 0 failures" + last output `shouldBe` "5 examples, 0 failures" + it "reruns runIO-actions" $ do + ref <- newIORef (0 :: Int) + let succeedingSpecWithRunIO = H.runIO (modifyIORef ref succ) >> succeedingSpec + + _ <- run failingSpec + _ <- rerunAllOnSuccess succeedingSpecWithRunIO + readIORef ref `shouldReturn` 2 + it "does not leak command-line options to examples" $ do hspec ["--diff"] $ do H.it "foobar" $ do @@ -619,16 +649,16 @@ context "when run with --rerun" $ do it "takes precedence" $ do - ["--qc-max-success", "23"] `shouldUseArgs` ((== 23) . QC.maxSuccess) - ["--rerun", "--qc-max-success", "42"] `shouldUseArgs` ((== 42) . QC.maxSuccess) + ["--qc-max-success", "23"] `shouldUseArgs` (QC.maxSuccess, 23) + ["--rerun", "--qc-max-success", "42"] `shouldUseArgs` (QC.maxSuccess, 42) context "with --qc-max-size" $ do it "passes specified size to QuickCheck properties" $ do - ["--qc-max-size", "23"] `shouldUseArgs` ((== 23) . QC.maxSize) + ["--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` ((== 23) . QC.maxDiscardRatio) + ["--qc-max-discard", "23"] `shouldUseArgs` (QC.maxDiscardRatio, 23) context "with --seed" $ do it "uses specified seed" $ do @@ -679,8 +709,8 @@ describe "hspecResult" $ do let - hspecResult args = withArgs ("--format=silent" : args) . H.hspecResult - hspecResult_ = hspecResult [] + hspecResult args = withArgs args . hspecResultSilent + hspecResult_ = hspecResultSilent it "returns a summary of the test run" $ do hspecResult_ $ do @@ -712,12 +742,6 @@ H.it "some example" True r `shouldBe` "Foo.Bar" - it "can use a custom formatter" $ do - r <- capture_ . H.hspecWithResult H.defaultConfig {H.configFormat = Just $ V2.formatterToFormat V2.silent} $ do - H.describe "Foo.Bar" $ do - H.it "some example" True - r `shouldBe` "" - it "does not let escape error thunks from failure messages" $ do r <- hspecResult_ $ do H.it "some example" (H.Result "" $ H.Failure Nothing . H.Reason $ "foobar" ++ undefined) @@ -749,35 +773,34 @@ high `shouldBe` j describe "colorOutputSupported" $ do - context "without a terminal device" $ do let isTerminalDevice = return False - it "returns False" $ do - H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` (False, False) + it "disables color output" $ do + H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` ColorDisabled context "with GITHUB_ACTIONS=true" $ do - it "returns True" $ do + it "enable color output" $ do withEnvironment [("GITHUB_ACTIONS", "true")] $ do - H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` (False, True) + H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` ColorEnabled ProgressReportingDisabled context "with a terminal device" $ do let isTerminalDevice = return True - it "returns True" $ do - H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` (True, True) + it "enable color output" $ do + H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` ColorEnabled ProgressReportingEnabled context "with BUILDKITE=true" $ do it "disables progress reporting" $ do withEnvironment [("BUILDKITE", "true")] $ do - H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` (False, True) + H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` ColorEnabled ProgressReportingDisabled context "when NO_COLOR is set" $ do - it "returns False" $ do + it "disables color output" $ do withEnvironment [("NO_COLOR", "yes")] $ do - H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` (False, False) + H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` ColorDisabled describe "unicodeOutputSupported" $ do context "with UnicodeAlways" $ do diff --git a/version.yaml b/version.yaml --- a/version.yaml +++ b/version.yaml @@ -1,1 +1,1 @@ -&version 2.10.9 +&version 2.10.10