diff --git a/help.txt b/help.txt --- a/help.txt +++ b/help.txt @@ -11,9 +11,10 @@ anything --[no-]focused-only do not run anything, unless there are focused spec items - --[no-]fail-on-focused fail on focused spec items - --[no-]fail-on-pending fail on pending spec items - --[no-]strict enable --fail-on-focused and --fail-on-pending + --[no-]fail-on=ITEMS empty: fail if no spec items have been run + focused: fail on focused spec items + pending: fail on pending spec items + --[no-]strict same as --fail-on=empty,focused,pending --[no-]fail-fast abort on first failure --[no-]randomize randomize execution order -r --rerun rerun all examples that failed in the previous 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.10.4 +version: 2.10.5 license: MIT license-file: LICENSE copyright: (c) 2011-2022 Simon Hengel, @@ -208,6 +208,7 @@ Test.Hspec.Core.QuickCheckUtilSpec Test.Hspec.Core.Runner.EvalSpec Test.Hspec.Core.Runner.PrintSlowSpecItemsSpec + Test.Hspec.Core.Runner.ResultSpec Test.Hspec.Core.RunnerSpec Test.Hspec.Core.ShuffleSpec Test.Hspec.Core.SpecSpec 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 @@ -4,6 +4,7 @@ , module Test.Hspec.Core.Compat ) where +import Control.Arrow as Imports ((>>>), (&&&), first, second) import Control.Applicative as Imports import Control.Monad as Imports hiding ( mapM 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 @@ -13,7 +13,7 @@ , runnerOptions #ifdef TEST -, formatOrList +, splitOn #endif ) where @@ -40,6 +40,7 @@ configIgnoreConfigFile :: Bool , configDryRun :: Bool , configFocusedOnly :: Bool +, configFailOnEmpty :: Bool , configFailOnFocused :: Bool , configFailOnPending :: Bool , configPrintSlowItems :: Maybe Int @@ -79,6 +80,7 @@ configIgnoreConfigFile = False , configDryRun = False , configFocusedOnly = False +, configFailOnEmpty = False , configFailOnFocused = False , configFailOnPending = False , configPrintSlowItems = Nothing @@ -229,15 +231,46 @@ setSeed :: Integer -> Config -> Config setSeed n c = c {configQuickCheckSeed = Just n} +data FailOn = + FailOnEmpty + | FailOnFocused + | FailOnPending + deriving (Bounded, Enum) + +allFailOnItems :: [FailOn] +allFailOnItems = [minBound .. maxBound] + +showFailOn :: FailOn -> String +showFailOn item = case item of + FailOnEmpty -> "empty" + FailOnFocused -> "focused" + FailOnPending -> "pending" + +readFailOn :: String -> Maybe FailOn +readFailOn = (`lookup` items) + where + items = map (showFailOn &&& id) allFailOnItems + +splitOn :: Char -> String -> [String] +splitOn sep = go + where + go xs = case break (== sep) xs of + ("", "") -> [] + (y, "") -> [y] + (y, _ : ys) -> y : go ys + 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" - , mkFlag "fail-on-focused" setFailOnFocused "fail on focused spec items" - , mkFlag "fail-on-pending" setFailOnPending "fail on pending spec items" - , mkFlag "strict" setStrict "enable --fail-on-focused and --fail-on-pending" + , undocumented $ mkFlag "fail-on-focused" setFailOnFocused "fail on focused spec items" + , undocumented $ mkFlag "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 + , mkFlag "fail-fast" setFailFast "abort on first failure" , mkFlag "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)" @@ -246,6 +279,31 @@ , mkOption "jobs" (Just 'j') (argument "N" readMaxJobs setMaxJobs) "run at most N parallelizable tests simultaneously (default: number of available processors)" ] where + strict = allFailOnItems + + readFailOnItems :: String -> Maybe [FailOn] + readFailOnItems = mapM readFailOn . splitOn ',' + + showFailOnItems :: [FailOn] -> String + showFailOnItems = intercalate "," . map showFailOn + + helpForFailOn :: String + helpForFailOn = unlines . flip map allFailOnItems $ \ item -> + showFailOn item <> ": " <> help item + where + help item = case item of + FailOnEmpty -> "fail if no spec items have been run" + FailOnFocused -> "fail on focused spec items" + FailOnPending -> "fail on pending spec items" + + setFailOnItems :: Bool -> [FailOn] -> Config -> Config + setFailOnItems value = flip $ foldr (`setItem` value) + where + setItem item = case item of + FailOnEmpty -> setFailOnEmpty + FailOnFocused -> setFailOnFocused + FailOnPending -> setFailOnPending + readMaxJobs :: String -> Maybe Int readMaxJobs s = do n <- readMaybe s @@ -264,6 +322,9 @@ setFocusedOnly :: Bool -> Config -> Config setFocusedOnly value config = config {configFocusedOnly = value} + setFailOnEmpty :: Bool -> Config -> Config + setFailOnEmpty value config = config {configFailOnEmpty = value} + setFailOnFocused :: Bool -> Config -> Config setFailOnFocused value config = config {configFailOnFocused = value} @@ -271,9 +332,7 @@ setFailOnPending value config = config {configFailOnPending = value} setStrict :: Bool -> Config -> Config - setStrict value = - setFailOnFocused value - . setFailOnPending value + setStrict = (`setFailOnItems` strict) setFailFast :: Bool -> Config -> Config setFailFast value config = config {configFailFast = value} diff --git a/src/Test/Hspec/Core/Formatters.hs b/src/Test/Hspec/Core/Formatters.hs --- a/src/Test/Hspec/Core/Formatters.hs +++ b/src/Test/Hspec/Core/Formatters.hs @@ -1,4 +1,6 @@ +-- | +-- Deprecated\: Use "Test.Hspec.Core.Formatters.V1" instead. module Test.Hspec.Core.Formatters -{-# DEPRECATED "Use \"Test.Hspec.Core.Formatters.V1\" instead." #-} +-- {-# DEPRECATED "Use \"Test.Hspec.Core.Formatters.V1\" instead." #-} (module V1) where import Test.Hspec.Core.Formatters.V1 as V1 diff --git a/src/Test/Hspec/Core/Formatters/Pretty.hs b/src/Test/Hspec/Core/Formatters/Pretty.hs --- a/src/Test/Hspec/Core/Formatters/Pretty.hs +++ b/src/Test/Hspec/Core/Formatters/Pretty.hs @@ -11,7 +11,6 @@ import Prelude () import Test.Hspec.Core.Compat hiding (shows, intercalate) -import Control.Arrow import Data.Char import Data.String import Data.List (intersperse) 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 @@ -40,6 +40,8 @@ , UnicodeMode(..) , Path , defaultConfig +, registerFormatter +, registerDefaultFormatter , configAddFilter , readConfig @@ -88,7 +90,6 @@ import System.IO import System.Environment (getArgs, withArgs) import System.Exit -import Control.Arrow import qualified Control.Exception as E import System.Random import Control.Monad.ST @@ -100,7 +101,7 @@ import Test.Hspec.Core.Util (Path) import Test.Hspec.Core.Spec hiding (pruneTree, pruneForest) import Test.Hspec.Core.Config -import Test.Hspec.Core.Format (FormatConfig(..)) +import Test.Hspec.Core.Format (Format, FormatConfig(..)) import qualified Test.Hspec.Core.Formatters.V1 as V1 import qualified Test.Hspec.Core.Formatters.V2 as V2 import Test.Hspec.Core.FailureReport @@ -112,6 +113,16 @@ import qualified Test.Hspec.Core.Runner.Eval as Eval import Test.Hspec.Core.Runner.Result +-- | +-- Make a formatter available for use with @--format@. +registerFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config +registerFormatter formatter config = config { configAvailableFormatters = formatter : configAvailableFormatters config } + +-- | +-- Make a formatter available for use with @--format@ and use it by default. +registerDefaultFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config +registerDefaultFormatter formatter@(_, format) config = (registerFormatter formatter config) { configFormat = Just format } + applyFilterPredicates :: Config -> [Tree c EvalItem] -> [Tree c EvalItem] applyFilterPredicates c = filterForestWithLabels p where @@ -268,7 +279,7 @@ failFocused :: Item a -> Item a failFocused item = item {itemExample = example} where - failure = Failure Nothing (Reason "item is focused; failing due to --fail-on-focused") + failure = Failure Nothing (Reason "item is focused; failing due to --fail-on=focused") example | itemIsFocused item = \ params hook p -> do Result info status <- itemExample item params hook p @@ -289,7 +300,7 @@ example params hook p = do Result info status <- itemExample item params hook p return $ Result info $ case status of - Pending loc _ -> Failure loc (Reason "item is pending; failing due to --fail-on-pending") + Pending loc _ -> Failure loc (Reason "item is pending; failing due to --fail-on=pending") _ -> status focusSpec :: Config -> [SpecTree a] -> [SpecTree a] @@ -300,6 +311,7 @@ runEvalTree :: Config -> [EvalTree] -> IO SpecResult runEvalTree config spec = do let + failOnEmpty = configFailOnEmpty config seed = (fromJust . configQuickCheckSeed) config qcArgs = configQuickCheckArgs config !numberOfItems = countSpecItems spec @@ -311,7 +323,7 @@ (reportProgress, useColor) <- colorOutputSupported (configColorMode config) (hSupportsANSI stdout) outputUnicode <- unicodeOutputSupported (configUnicodeMode config) stdout - results <- fmap toSpecResult . withHiddenCursor reportProgress stdout $ do + results <- fmap (toSpecResult failOnEmpty) . withHiddenCursor reportProgress stdout $ do let formatConfig = FormatConfig { formatConfigUseColor = useColor 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 @@ -43,11 +43,11 @@ | ResultItemFailure deriving (Eq, Show) -toSpecResult :: [(Path, Format.Item)] -> SpecResult -toSpecResult results = SpecResult items success +toSpecResult :: Bool -> [(Path, Format.Item)] -> SpecResult +toSpecResult failOnEmpty results = SpecResult items success where items = map toResultItem results - success = all (not . resultItemIsFailure) items + success = not (failOnEmpty && null results) && all (not . resultItemIsFailure) items toResultItem :: (Path, Format.Item) -> ResultItem toResultItem (path, item) = ResultItem path status diff --git a/src/Test/Hspec/Core/Spec/Monad.hs b/src/Test/Hspec/Core/Spec/Monad.hs --- a/src/Test/Hspec/Core/Spec/Monad.hs +++ b/src/Test/Hspec/Core/Spec/Monad.hs @@ -23,7 +23,6 @@ import Prelude () import Test.Hspec.Core.Compat -import Control.Arrow import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Reader import Control.Monad.Trans.Writer diff --git a/src/Test/Hspec/Core/Util.hs b/src/Test/Hspec/Core/Util.hs --- a/src/Test/Hspec/Core/Util.hs +++ b/src/Test/Hspec/Core/Util.hs @@ -50,10 +50,12 @@ -- ensure that lines are not longer than given `n`, insert line breaks at word -- boundaries lineBreaksAt :: Int -> String -> [String] -lineBreaksAt n input = case words input of - [] -> [] - x:xs -> go (x, xs) +lineBreaksAt n = concatMap f . lines where + f input = case words input of + [] -> [] + x:xs -> go (x, xs) + go :: (String, [String]) -> [String] go c = case c of (s, []) -> [s] diff --git a/test/Test/Hspec/Core/Config/DefinitionSpec.hs b/test/Test/Hspec/Core/Config/DefinitionSpec.hs --- a/test/Test/Hspec/Core/Config/DefinitionSpec.hs +++ b/test/Test/Hspec/Core/Config/DefinitionSpec.hs @@ -7,6 +7,16 @@ spec :: Spec spec = do - describe "formatOrList" $ do - it "formats a list of or-options" $ do - formatOrList ["foo", "bar", "baz"] `shouldBe` "foo, bar or baz" + describe "splitOn" $ do + it "splits a string" $ do + splitOn ',' "foo,bar,baz" `shouldBe` ["foo", "bar", "baz"] + + it "splits *arbitrary* strings" $ property $ do + let + string :: Gen String + string = arbitrary `suchThat` p + + p :: String -> Bool + p = (&&) <$> not . null <*> all (/= ',') + + forAll (listOf string) $ \ xs -> splitOn ',' (intercalate "," xs) `shouldBe` xs diff --git a/test/Test/Hspec/Core/Config/OptionsSpec.hs b/test/Test/Hspec/Core/Config/OptionsSpec.hs --- a/test/Test/Hspec/Core/Config/OptionsSpec.hs +++ b/test/Test/Hspec/Core/Config/OptionsSpec.hs @@ -43,6 +43,37 @@ expected <- readFile "help.txt" help `shouldBe` expected + describe "RUNNER OPTIONS" $ do + let parseOptions_ args = snd <$> Options.parseOptions defaultConfig "my-spec" [] Nothing [] args + + context "with --fail-on-focused" $ do + it "sets configFailOnFocused to True" $ do + configFailOnFocused <$> parseOptions_ ["--fail-on-focused"] `shouldBe` Right True + + context "with --fail-on-pending" $ do + it "sets configFailOnPending to True" $ do + configFailOnPending <$> parseOptions_ ["--fail-on-pending"] `shouldBe` Right True + + context "with --fail-on" $ do + it "accepts a list of values" $ do + let config = parseOptions_ ["--fail-on=focused,pending"] + configFailOnFocused <$> config `shouldBe` Right True + configFailOnPending <$> config `shouldBe` Right True + + context "with focused" $ do + it "sets configFailOnFocused to True" $ do + configFailOnFocused <$> parseOptions_ ["--fail-on=focused"] `shouldBe` Right True + + context "with pending" $ do + it "sets configFailOnPending to True" $ do + configFailOnPending <$> parseOptions_ ["--fail-on=pending"] `shouldBe` Right True + + context "with --no-fail-on" $ do + it "inverts --fail-on" $ do + let config = parseOptions_ ["--fail-on=focused,pending", "--no-fail-on=focused,pending"] + configFailOnFocused <$> config `shouldBe` Right False + configFailOnPending <$> config `shouldBe` Right False + context "with --color" $ do it "sets configColorMode to ColorAlways" $ do configColorMode <$> parseOptions [] Nothing [] ["--color"] `shouldBe` Right ColorAlways @@ -112,13 +143,11 @@ fromLeft (parseOptions [("~/.hspec", ["--invalid"])] Nothing [] []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--invalid' in config file ~/.hspec\n") it "rejects ambiguous options" $ do - fromLeft (parseOptions [("~/.hspec", ["--fail"])] Nothing [] []) `shouldBe` (ExitFailure 1, + fromLeft (parseOptions [("~/.hspec", ["--print"])] Nothing [] []) `shouldBe` (ExitFailure 1, unlines [ - "my-spec: option `--fail' is ambiguous; could be one of:" - , " --fail-on-focused fail on focused spec items" - , " --fail-on-pending fail on pending spec items" - , " --fail-fast abort on first failure" - , " --failure-report=FILE read/write a failure report for use with --rerun" + "my-spec: option `--print' is ambiguous; could be one of:" + , " --print-cpu-time include used CPU time in summary" + , " -p[N] --print-slow-items[=N] print the N slowest spec items (default: 10)" , "in config file ~/.hspec" ] ) diff --git a/test/Test/Hspec/Core/HooksSpec.hs b/test/Test/Hspec/Core/HooksSpec.hs --- a/test/Test/Hspec/Core/HooksSpec.hs +++ b/test/Test/Hspec/Core/HooksSpec.hs @@ -7,7 +7,6 @@ import Mock import Control.Exception -import Control.Arrow import qualified Test.Hspec.Core.Runner as H import qualified Test.Hspec.Core.Spec as H diff --git a/test/Test/Hspec/Core/Runner/ResultSpec.hs b/test/Test/Hspec/Core/Runner/ResultSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Hspec/Core/Runner/ResultSpec.hs @@ -0,0 +1,36 @@ +module Test.Hspec.Core.Runner.ResultSpec (spec) where + +import Prelude () +import Helper + +import Test.Hspec.Core.Format + +import Test.Hspec.Core.Runner.Result + +spec :: Spec +spec = do + describe "specResultSuccess" $ do + let + failure = Failure Nothing NoReason + item result = (([], ""), Item Nothing 0 "" result) + + context "when all spec items passed" $ do + it "returns True" $ do + specResultSuccess (toSpecResult False [item Success]) `shouldBe` True + + context "with a failed spec item" $ do + it "returns False" $ do + specResultSuccess (toSpecResult False [item Success, item failure]) `shouldBe` False + + context "with an empty result list" $ do + it "returns True" $ do + specResultSuccess (toSpecResult False []) `shouldBe` True + + context "when configFailOnEmpty is True" $ do + context "when all spec items passed" $ do + it "returns True" $ do + specResultSuccess (toSpecResult True [item Success]) `shouldBe` True + + context "with an empty result list" $ do + it "returns False" $ do + specResultSuccess (toSpecResult True []) `shouldBe` False 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 @@ -269,8 +269,22 @@ , "0 examples, 0 failures" ] - context "with --fail-on-focused" $ do - let run = captureLines . ignoreExitCode . withArgs ["--fail-on-focused", "--seed", "23"] . H.hspec . removeLocations + context "with --fail-on=empty" $ do + it "fails if no spec items have been run" $ do + (out, r) <- capture . E.try . withArgs ["--skip=", "--fail-on=empty"] . H.hspec $ do + H.it "foo" True + H.it "bar" True + H.it "baz" True + unlines (normalizeSummary (lines out)) `shouldBe` unlines [ + "" + , "" + , "Finished in 0.0000 seconds" + , "0 examples, 0 failures" + ] + r `shouldBe` Left (ExitFailure 1) + + context "with --fail-on=focused" $ do + let run = captureLines . ignoreExitCode . withArgs ["--fail-on=focused", "--seed", "23"] . H.hspec . removeLocations it "fails on focused spec items" $ do r <- run $ do H.it "foo" True @@ -282,7 +296,7 @@ , "Failures:" , "" , " 1) bar" - , " item is focused; failing due to --fail-on-focused" + , " item is focused; failing due to --fail-on=focused" , "" , " To rerun use: --match \"/bar/\"" , "" @@ -292,8 +306,8 @@ , "1 example, 1 failure" ] - context "with --fail-on-pending" $ do - let run = captureLines . ignoreExitCode . withArgs ["--fail-on-pending", "--seed", "23"] . H.hspec . removeLocations + context "with --fail-on=pending" $ do + let run = captureLines . ignoreExitCode . withArgs ["--fail-on=pending", "--seed", "23"] . H.hspec . removeLocations it "fails on pending spec items" $ do r <- run $ do H.it "foo" True @@ -308,7 +322,7 @@ , "Failures:" , "" , " 1) bar" - , " item is pending; failing due to --fail-on-pending" + , " item is pending; failing due to --fail-on=pending" , "" , " To rerun use: --match \"/bar/\"" , "" diff --git a/test/Test/Hspec/Core/UtilSpec.hs b/test/Test/Hspec/Core/UtilSpec.hs --- a/test/Test/Hspec/Core/UtilSpec.hs +++ b/test/Test/Hspec/Core/UtilSpec.hs @@ -44,6 +44,14 @@ , "sed do eiusmod" ] + it "preserves existing line breaks" $ do + lineBreaksAt 10 "foo bar baz\none two three" `shouldBe` [ + "foo bar" + , "baz" + , "one two" + , "three" + ] + describe "safeTry" $ do it "returns Right on success" $ do Right e <- safeTry (return 23 :: IO Int) diff --git a/version.yaml b/version.yaml --- a/version.yaml +++ b/version.yaml @@ -1,1 +1,1 @@ -&version 2.10.4 +&version 2.10.5