diff --git a/hspec-core.cabal b/hspec-core.cabal --- a/hspec-core.cabal +++ b/hspec-core.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hspec-core -version: 2.11.2 +version: 2.11.3 license: MIT license-file: LICENSE copyright: (c) 2011-2023 Simon Hengel, @@ -129,7 +129,7 @@ , filepath , haskell-lexer , hspec-expectations ==0.8.3.* - , hspec-meta ==2.11.2 + , hspec-meta ==2.11.3 , process , quickcheck-io >=0.2.0 , random diff --git a/src/Test/Hspec/Core/Example.hs b/src/Test/Hspec/Core/Example.hs --- a/src/Test/Hspec/Core/Example.hs +++ b/src/Test/Hspec/Core/Example.hs @@ -191,16 +191,17 @@ instance Example (a -> QC.Property) where type Arg (a -> QC.Property) = a evaluateExample p c hook progressCallback = do - r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty hook p) - return $ fromQuickCheckResult r + 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.Result -> Result -fromQuickCheckResult r = case parseQuickCheckResult r of +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 info Success + 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 diff --git a/test/Helper.hs b/test/Helper.hs --- a/test/Helper.hs +++ b/test/Helper.hs @@ -28,6 +28,7 @@ , hspecSilent , hspecResultSilent +, hspecCapture , shouldUseArgs , removeLocations @@ -133,6 +134,9 @@ hspecResultSilent :: H.Spec -> IO H.Summary hspecResultSilent = H.hspecWithResult silentConfig + +hspecCapture :: [String] -> H.Spec -> IO String +hspecCapture args = fmap (unlines . normalizeSummary) . captureLines . ignoreExitCode . withArgs args . H.hspec . removeLocations shouldUseArgs :: HasCallStack => (Eq n, Show n) => [String] -> (Args -> n, n) -> Expectation shouldUseArgs args (accessor, expected) = do 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 @@ -248,12 +248,12 @@ takeMVar mvar `shouldReturn` UserInterrupt context "with --dry-run" $ do - let withDryRun = captureLines . withArgs ["--dry-run"] . H.hspec + let withDryRun = hspecCapture ["--dry-run"] it "produces a report" $ do - r <- withDryRun $ do + withDryRun $ do H.it "foo" True H.it "bar" True - normalizeSummary r `shouldBe` [ + `shouldReturn` unlines [ "" , "foo [✔]" , "bar [✔]" @@ -277,13 +277,13 @@ readIORef ref `shouldReturn` False context "with --focused-only" $ do - let run = captureLines . withArgs ["--focused-only"] . H.hspec + let run = hspecCapture ["--focused-only"] context "when there aren't any focused spec items" $ do it "does not run anything" $ do - r <- run $ do + run $ do H.it "foo" True H.it "bar" True - normalizeSummary r `shouldBe` [ + `shouldReturn` unlines [ "" , "" , "Finished in 0.0000 seconds" @@ -302,12 +302,12 @@ r `shouldBe` Left (ExitFailure 1) context "with --fail-on=focused" $ do - let run = captureLines . ignoreExitCode . withArgs ["--fail-on=focused", "--seed", "23"] . H.hspec . removeLocations + let run = hspecCapture ["--fail-on=focused", "--seed", "23"] it "fails on focused spec items" $ do - r <- run $ do + run $ do H.it "foo" True H.fit "bar" True - normalizeSummary r `shouldBe` [ + `shouldReturn` unlines [ "" , "bar [✘]" , "" @@ -325,12 +325,12 @@ ] context "with --fail-on=empty-description" $ do - let run = captureLines . ignoreExitCode . withArgs ["--fail-on=empty-description", "--seed", "23"] . H.hspec . removeLocations + let run = hspecCapture ["--fail-on=empty-description", "--seed", "23"] it "fails on items with empty requirement" $ do - r <- run $ do + run $ do H.it "foo" True H.it "" True - normalizeSummary r `shouldBe` [ + `shouldReturn` unlines [ "" , "foo [✔]" , "(unspecified behavior) [✘]" @@ -349,14 +349,13 @@ ] context "with --fail-on=pending" $ do - let run = captureLines . ignoreExitCode . withArgs ["--fail-on=pending", "--seed", "23"] . H.hspec . removeLocations + let run = hspecCapture ["--fail-on=pending", "--seed", "23"] it "fails on pending spec items" $ do - r <- run $ do + run $ do H.it "foo" True H.it "bar" $ do void $ throwIO (H.Pending Nothing Nothing) - - normalizeSummary r `shouldBe` [ + `shouldReturn` unlines [ "" , "foo [✔]" , "bar [✘]" @@ -376,11 +375,11 @@ context "with --fail-fast" $ do it "stops after first failure" $ do - r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec . removeLocations $ do + hspecCapture ["--fail-fast", "--seed", "23"] $ do H.it "foo" True H.it "bar" False H.it "baz" False - normalizeSummary r `shouldBe` [ + `shouldReturn` unlines [ "" , "foo [✔]" , "bar [✘]" @@ -416,11 +415,11 @@ readIORef ref `shouldReturn` "" it "works for nested specs" $ do - r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec . removeLocations $ do + hspecCapture ["--fail-fast", "--seed", "23"] $ do H.describe "foo" $ do H.it "bar" False H.it "baz" True - normalizeSummary r `shouldBe` [ + `shouldReturn` unlines [ "" , "foo" , " bar [✘]" @@ -541,9 +540,9 @@ context "with --color" $ do it "outputs ColorizedReason" $ do - r <- capture_ . ignoreExitCode . withArgs ["--seed=0", "--format=failed-examples", "--color"] . H.hspec . removeLocations $ do + hspecCapture ["--seed=0", "--format=failed-examples", "--color"] $ do H.it "foo" resultWithColorizedReason - normalizeSummary (lines r) `shouldBe` [ + `shouldReturn` unlines [ "\ESC[?25l" , "Failures:" , "" @@ -561,9 +560,9 @@ context "with --no-color" $ do it "strips ANSI sequences from ColorizedReason" $ do - r <- capture_ . ignoreExitCode . withArgs ["--seed=0", "--format=failed-examples", "--no-color"] . H.hspec . removeLocations $ do + hspecCapture ["--seed=0", "--format=failed-examples", "--no-color"] $ do H.it "foo" resultWithColorizedReason - normalizeSummary (lines r) `shouldBe` [ + `shouldReturn` unlines [ "" , "Failures:" , "" @@ -717,6 +716,33 @@ context "with --qc-max-discard" $ do it "uses specified discard ratio to QuickCheck properties" $ do ["--qc-max-discard", "23"] `shouldUseArgs` (QC.maxDiscardRatio, 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 + + context "when True" $ do + it "includes informational output" $ do + withChatty True `shouldReturn` unlines [ + "" + , "foo [✔]" + , " +++ OK, passed 1 test." + , "" + , "Finished in 0.0000 seconds" + , "1 example, 0 failures" + ] + + context "when False" $ do + it "suppresses informational output" $ do + withChatty False `shouldReturn` unlines [ + "" + , "foo [✔]" + , "" + , "Finished in 0.0000 seconds" + , "1 example, 0 failures" + ] context "with --seed" $ do it "uses specified seed" $ do diff --git a/version.yaml b/version.yaml --- a/version.yaml +++ b/version.yaml @@ -1,4 +1,4 @@ -version: &version 2.11.2 +version: &version 2.11.3 synopsis: A Testing Framework for Haskell maintainer: Simon Hengel category: Testing