hspec-core 2.10.5 → 2.10.6
raw patch · 24 files changed
+491/−57 lines, 24 filesdep ~hspec-meta
Dependency ranges changed: hspec-meta
Files
- help.txt +15/−12
- hspec-core.cabal +4/−3
- src/Test/Hspec/Core/Compat.hs +4/−0
- src/Test/Hspec/Core/Config.hs +1/−1
- src/Test/Hspec/Core/Config/Definition.hs +59/−4
- src/Test/Hspec/Core/Format.hs +2/−0
- src/Test/Hspec/Core/Formatters/Diff.hs +65/−3
- src/Test/Hspec/Core/Formatters/Internal.hs +21/−0
- src/Test/Hspec/Core/Formatters/V1.hs +3/−1
- src/Test/Hspec/Core/Formatters/V2.hs +30/−11
- src/Test/Hspec/Core/Runner.hs +11/−1
- src/Test/Hspec/Core/Runner/Result.hs +16/−0
- src/Test/Hspec/Core/Spec/Monad.hs +2/−0
- src/Test/Hspec/Core/Util.hs +19/−1
- test/All.hs +0/−2
- test/Helper.hs +17/−1
- test/Spec.hs +1/−13
- test/SpecHook.hs +17/−0
- test/Test/Hspec/Core/Config/OptionsSpec.hs +35/−0
- test/Test/Hspec/Core/Formatters/DiffSpec.hs +80/−0
- test/Test/Hspec/Core/Formatters/InternalSpec.hs +2/−0
- test/Test/Hspec/Core/Formatters/V2Spec.hs +2/−0
- test/Test/Hspec/Core/RunnerSpec.hs +84/−3
- version.yaml +1/−1
help.txt view
@@ -14,7 +14,7 @@ --[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-]strict same as --fail-on=focused,pending --[no-]fail-fast abort on first failure --[no-]randomize randomize execution order -r --rerun rerun all examples that failed in the previous@@ -29,17 +29,20 @@ processors) FORMATTER OPTIONS- -f FORMATTER --format=FORMATTER use a custom formatter; this can be one- of checks, specdoc, progress,- failed-examples or silent- --[no-]color colorize the output- --[no-]unicode output unicode- --[no-]diff show colorized diffs- --[no-]pretty try to pretty-print diff values- --[no-]times report times for individual spec items- --print-cpu-time include used CPU time in summary- -p[N] --print-slow-items[=N] print the N slowest spec items (default:- 10)+ -f NAME --format=NAME use a custom formatter; this can be one of+ checks, specdoc, progress, failed-examples or+ silent+ --[no-]color colorize the output+ --[no-]unicode output unicode+ --[no-]diff show colorized diffs+ --diff-context=N output N lines of diff context (default: 3)+ use a value of 'full' to see the full context+ --diff-command=CMD use an external diff command+ example: --diff-command="git diff"+ --[no-]pretty try to pretty-print diff values+ --[no-]times report times for individual spec items+ --print-cpu-time include used CPU time in summary+ -p[N] --print-slow-items[=N] print the N slowest spec items (default: 10) OPTIONS FOR QUICKCHECK -a N --qc-max-success=N maximum number of successful tests before a
hspec-core.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hspec-core-version: 2.10.5+version: 2.10.6 license: MIT license-file: LICENSE copyright: (c) 2011-2022 Simon Hengel,@@ -44,6 +44,7 @@ , directory , filepath , hspec-expectations ==0.8.2.*+ , process , quickcheck-io >=0.2.0 , random , setenv@@ -129,7 +130,7 @@ , directory , filepath , hspec-expectations ==0.8.2.*- , hspec-meta ==2.9.3+ , hspec-meta ==2.10.5 , process , quickcheck-io >=0.2.0 , random@@ -183,11 +184,11 @@ Test.Hspec.Core.Util Control.Concurrent.Async Data.Algorithm.Diff- All GetOpt.Declarative.EnvironmentSpec GetOpt.Declarative.UtilSpec Helper Mock+ SpecHook Test.Hspec.Core.ClockSpec Test.Hspec.Core.CompatSpec Test.Hspec.Core.Config.DefinitionSpec
src/Test/Hspec/Core/Compat.hs view
@@ -27,6 +27,7 @@ stripPrefix , isPrefixOf , isInfixOf+ , isSuffixOf , intercalate , inits , tails@@ -171,3 +172,6 @@ (<&>) :: Functor f => f a -> (a -> b) -> f b (<&>) = flip (<$>) #endif++endsWith :: Eq a => [a] -> [a] -> Bool+endsWith = flip isSuffixOf
src/Test/Hspec/Core/Config.hs view
@@ -95,7 +95,7 @@ -- -- 1. @~/.hspec@ (a config file in the user's home directory) -- 1. @.hspec@ (a config file in the current working directory)--- 1. the environment variable @HSPEC_OPTIONS@+-- 1. [environment variables starting with @HSPEC_@](https://hspec.github.io/options.html#specifying-options-through-environment-variables) -- 1. the provided list of command-line options (the second argument to @readConfig@) -- -- (precedence from low to high)
src/Test/Hspec/Core/Config/Definition.hs view
@@ -20,6 +20,11 @@ import Prelude () import Test.Hspec.Core.Compat +import Control.Exception (bracket)+import System.Directory (getTemporaryDirectory, removeFile)+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)@@ -65,6 +70,16 @@ , configColorMode :: ColorMode , configUnicodeMode :: UnicodeMode , configDiff :: Bool+, configDiffContext :: Maybe Int++-- |+-- An action that is used to print diffs. The first argument is the value of+-- `configDiffContext`. The remaining two arguments are the @expected@ and+-- @actual@ value.+--+-- @since 2.10.6+, configExternalDiff :: Maybe (Maybe Int -> String -> String -> IO ())+ , configPrettyPrint :: Bool , configPrettyPrintFunction :: Bool -> String -> String -> (String, String) , configTimes :: Bool@@ -101,6 +116,8 @@ , configColorMode = ColorAuto , configUnicodeMode = UnicodeAuto , configDiff = True+, configDiffContext = Just defaultDiffContext+, configExternalDiff = Nothing , configPrettyPrint = True , configPrettyPrintFunction = pretty2 , configTimes = False@@ -117,6 +134,23 @@ , configConcurrentJobs = Nothing } +defaultDiffContext :: Int+defaultDiffContext = 3++externalDiff :: String -> String -> String -> IO ()+externalDiff command expected actual = do+ tmp <- getTemporaryDirectory+ withTempFile tmp "hspec-expected" expected $ \ expectedFile -> do+ withTempFile tmp "hspec-actual" actual $ \ actualFile -> do+ void . system $ unwords [command, expectedFile, actualFile]++withTempFile :: FilePath -> FilePath -> String -> (FilePath -> IO a) -> IO a+withTempFile dir file contents action = do+ bracket (openTempFile dir file) (removeFile . fst) $ \ (path, h) -> do+ hClose h+ writeFile path contents+ action path+ option :: String -> OptionSetter config -> String -> Option config option name arg help = Option name Nothing arg help True @@ -137,10 +171,15 @@ formatterOptions :: [(String, FormatConfig -> IO Format)] -> [Option Config] formatterOptions formatters = [- mkOption "format" (Just 'f') (argument "FORMATTER" readFormatter setFormatter) helpForFormat+ 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"+ , 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" , mkFlag "times" setTimes "report times for individual spec items" , mkOptionNoArg "print-cpu-time" Nothing setPrintCpuTime "include used CPU time in summary"@@ -151,6 +190,13 @@ , undocumented $ mkOptionNoArg "html" Nothing setHtml "produce HTML output" ] where+ setDiffCommand :: String -> Config -> Config+ setDiffCommand command config = config {+ configExternalDiff = case strip command of+ "" -> Nothing+ _ -> Just $ \ _context -> externalDiff command+ }+ setHtml config = config {configHtmlOutput = True} helpForFormat :: String@@ -171,6 +217,16 @@ setDiff :: Bool -> Config -> Config setDiff v config = config {configDiff = v} + readDiffContext :: String -> Maybe (Maybe Int)+ readDiffContext input = case input of+ "full" -> Just Nothing+ _ -> case readMaybe input of+ Nothing -> Nothing+ mn -> Just (find (>= 0) mn)++ setDiffContext :: Maybe Int -> Config -> Config+ setDiffContext value c = c { configDiffContext = value }+ setPretty :: Bool -> Config -> Config setPretty v config = config {configPrettyPrint = v} @@ -192,9 +248,8 @@ parseArg :: String -> Config -> Maybe Config parseArg input c = case readMaybe input of- Just 0 -> Just (setter Nothing c)- Just n -> Just (setter (Just n) c) Nothing -> Nothing+ mn -> Just (setter (find (> 0) mn) c) smallCheckOptions :: [Option Config] smallCheckOptions = [@@ -279,7 +334,7 @@ , mkOption "jobs" (Just 'j') (argument "N" readMaxJobs setMaxJobs) "run at most N parallelizable tests simultaneously (default: number of available processors)" ] where- strict = allFailOnItems+ strict = [FailOnFocused, FailOnPending] readFailOnItems :: String -> Maybe [FailOn] readFailOnItems = mapM readFailOn . splitOn ','
src/Test/Hspec/Core/Format.hs view
@@ -59,6 +59,8 @@ , formatConfigReportProgress :: Bool , formatConfigOutputUnicode :: Bool , formatConfigUseDiff :: Bool+, formatConfigDiffContext :: Maybe Int+, formatConfigExternalDiff :: Maybe (String -> String -> IO ()) , formatConfigPrettyPrint :: Bool -- ^ Deprecated: use `formatConfigPrettyPrintFunction` instead , formatConfigPrettyPrintFunction :: Maybe (String -> String -> (String, String)) , formatConfigPrintTimes :: Bool
src/Test/Hspec/Core/Formatters/Diff.hs view
@@ -15,11 +15,73 @@ import Data.Char import qualified Data.Algorithm.Diff as Diff -data Diff = First String | Second String | Both String+data Diff = First String | Second String | Both String | Omitted Int deriving (Eq, Show) -diff :: String -> String -> [Diff]-diff expected actual = map (toDiff . fmap concat) $ Diff.getGroupedDiff (partition expected) (partition actual)+-- |+-- Split a string at line boundaries.+--+-- >>> splitLines "foo\nbar\nbaz"+-- ["foo\n","bar\n","baz"]+--+-- prop> concat (splitLines xs) == xs+splitLines :: String -> [String]+splitLines = go+ where+ go xs = case break (== '\n') xs of+ (ys, '\n' : zs) -> (ys ++ ['\n']) : go zs+ ("", "") -> []+ _ -> [xs]++data TrimMode = FirstChunck | Chunck | LastChunck++trim :: Int -> [Diff] -> [Diff]+trim context = \ chunks -> case chunks of+ [] -> []+ x : xs -> trimChunk FirstChunck x (go xs)+ where+ omitThreshold = 3++ go chunks = case chunks of+ [] -> []+ [x] -> trimChunk LastChunck x []+ x : xs -> trimChunk Chunck x (go xs)++ trimChunk mode chunk = case chunk of+ Both xs | omitted >= omitThreshold -> keep start . (Omitted omitted :) . keep end+ where+ omitted :: Int+ omitted = n - keepStart - keepEnd++ keepStart :: Int+ keepStart = case mode of+ FirstChunck -> 0+ _ -> succ context++ keepEnd :: Int+ keepEnd = case mode of+ LastChunck -> 0+ _ -> if xs `endsWith` "\n" then context else succ context++ n :: Int+ n = length allLines++ allLines :: [String]+ allLines = splitLines xs++ start :: [String]+ start = take keepStart allLines++ end :: [String]+ end = drop (keepStart + omitted) allLines+ _ -> (chunk :)++ keep xs+ | null xs = id+ | otherwise = (Both (concat xs) :)++diff :: Maybe Int -> String -> String -> [Diff]+diff context expected actual = maybe id trim context $ map (toDiff . fmap concat) $ Diff.getGroupedDiff (partition expected) (partition actual) toDiff :: Diff.Diff String -> Diff toDiff d = case d of
src/Test/Hspec/Core/Formatters/Internal.hs view
@@ -35,6 +35,8 @@ , outputUnicode , useDiff+, diffContext+, externalDiffAction , prettyPrint , prettyPrintFunction , extraChunk@@ -110,6 +112,25 @@ -- | Return `True` if the user requested colorized diffs, `False` otherwise. useDiff :: FormatM Bool useDiff = getConfig formatConfigUseDiff++-- |+-- Return the value of `Test.Hspec.Core.Runner.configDiffContext`.+--+-- @since 2.10.6+diffContext :: FormatM (Maybe Int)+diffContext = getConfig formatConfigDiffContext++-- | An action for printing diffs.+--+-- The action takes @expected@ and @actual@ as arguments.+--+-- When this is a `Just`-value then it should be used instead of any built-in+-- diff implementation. A `Just`-value also implies that `useDiff` returns+-- `True`.+--+-- @since 2.10.6+externalDiffAction :: FormatM (Maybe (String -> String -> IO ()))+externalDiffAction = getConfig formatConfigExternalDiff -- | Return `True` if the user requested pretty diffs, `False` otherwise. prettyPrint :: FormatM Bool
src/Test/Hspec/Core/Formatters/V1.hs view
@@ -288,7 +288,7 @@ let threshold = 2 :: Seconds mchunks <- liftIO $ if b- then timeout threshold (evaluate $ diff expected actual)+ then timeout threshold (evaluate $ diff Nothing expected actual) else return Nothing case mchunks of@@ -307,6 +307,7 @@ Both a -> indented write a First a -> indented extra a Second _ -> return ()+ Omitted _ -> return () writeLine "" withFailColor $ write (indentation ++ " but got: ")@@ -314,6 +315,7 @@ Both a -> indented write a First _ -> return () Second a -> indented missing a+ Omitted _ -> return () writeLine "" Error _ e -> withFailColor . indent $ (("uncaught exception: " ++) . formatException) e
src/Test/Hspec/Core/Formatters/V2.hs view
@@ -58,6 +58,8 @@ , outputUnicode , useDiff+, diffContext+, externalDiffAction , prettyPrint , prettyPrintFunction , extraChunk@@ -126,6 +128,8 @@ , outputUnicode , useDiff+ , diffContext+ , externalDiffAction , prettyPrint , prettyPrintFunction , extraChunk@@ -288,15 +292,24 @@ let threshold = 2 :: Seconds - mchunks <- liftIO $ if b- then timeout threshold (evaluate $ diff expected actual)- else return Nothing - case mchunks of- Just chunks -> do- writeDiff chunks extraChunk missingChunk+ mExternalDiff <- externalDiffAction++ case mExternalDiff of+ Just externalDiff -> do+ liftIO $ externalDiff expected actual+ Nothing -> do- writeDiff [First expected, Second actual] write write+ context <- diffContext+ mchunks <- liftIO $ if b+ then timeout threshold (evaluate $ diff context expected actual)+ else return Nothing++ case mchunks of+ Just chunks -> do+ writeDiff chunks extraChunk missingChunk+ Nothing -> do+ writeDiff [First expected, Second actual] write write where writeDiff chunks extra missing = do writeChunks "expected: " (expectedChunks chunks) extra@@ -308,6 +321,7 @@ forM_ (indentChunks indentation_ chunks) $ \ chunk -> case chunk of PlainChunk a -> write a ColorChunk a -> colorize a+ Informational a -> withInfoColor $ write a writeLine "" where indentation_ = indentation ++ replicate (length pre) ' '@@ -326,7 +340,7 @@ forM_ (lines message) $ \line -> do writeLine (indentation ++ line) -data Chunk = Original String | Modified String+data Chunk = Original String | Modified String | OmittedLines Int deriving (Eq, Show) expectedChunks :: [Diff] -> [Chunk]@@ -334,20 +348,23 @@ Both a -> Just $ Original a First a -> Just $ Modified a Second _ -> Nothing+ Omitted n -> Just $ OmittedLines n actualChunks :: [Diff] -> [Chunk] actualChunks = mapMaybe $ \ chunk -> case chunk of Both a -> Just $ Original a First _ -> Nothing Second a -> Just $ Modified a+ Omitted n -> Just $ OmittedLines n -data ColorChunk = PlainChunk String | ColorChunk String+data ColorChunk = PlainChunk String | ColorChunk String | Informational String deriving (Eq, Show) indentChunks :: String -> [Chunk] -> [ColorChunk] indentChunks indentation = concatMap $ \ chunk -> case chunk of Original y -> [indentOriginal indentation y] Modified y -> indentModified indentation y+ OmittedLines n -> [Informational $ "@@ " <> show n <> " lines omitted @@\n" <> indentation] indentOriginal :: String -> String -> ColorChunk indentOriginal indentation = PlainChunk . go@@ -388,10 +405,12 @@ pluralize total "example" ++ ", " ++ pluralize fails "failure" ++ if pending == 0 then "" else ", " ++ show pending ++ " pending"- c | fails /= 0 = withFailColor++ color+ | fails /= 0 = withFailColor | pending /= 0 = withPendingColor | otherwise = withSuccessColor- c $ writeLine output+ color $ writeLine output formatLocation :: Location -> String formatLocation (Location file line column) = file ++ ":" ++ show line ++ ":" ++ show column ++ ": "
src/Test/Hspec/Core/Runner.hs view
@@ -115,11 +115,15 @@ -- | -- Make a formatter available for use with @--format@.+--+-- @since 2.10.5 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.+--+-- @since 2.10.5 registerDefaultFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config registerDefaultFormatter formatter@(_, format) config = (registerFormatter formatter config) { configFormat = Just format } @@ -187,7 +191,11 @@ -- | Run given spec with custom options. -- This is similar to `hspec`, but more flexible. hspecWith :: Config -> Spec -> IO ()-hspecWith defaults = hspecWithResult defaults >=> evaluateSummary+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.@@ -330,6 +338,8 @@ , formatConfigReportProgress = reportProgress , formatConfigOutputUnicode = outputUnicode , formatConfigUseDiff = configDiff config+ , formatConfigDiffContext = configDiffContext config+ , formatConfigExternalDiff = if configDiff config then ($ configDiffContext config) <$> configExternalDiff config else Nothing , formatConfigPrettyPrint = configPrettyPrint config , formatConfigPrettyPrintFunction = if configPrettyPrint config then Just (configPrettyPrintFunction config outputUnicode) else Nothing , formatConfigPrintTimes = configTimes config
src/Test/Hspec/Core/Runner/Result.hs view
@@ -21,16 +21,32 @@ import Test.Hspec.Core.Util import qualified Test.Hspec.Core.Format as Format +-- |+-- @since 2.10.0 data SpecResult = SpecResult {+ -- |+ -- @since 2.10.0 specResultItems :: [ResultItem]++ -- |+ -- @since 2.10.0 , specResultSuccess :: !Bool } deriving (Eq, Show) +-- |+-- @since 2.10.0 data ResultItem = ResultItem {+ -- |+ -- @since 2.10.0 resultItemPath :: Path++ -- |+ -- @since 2.10.0 , resultItemStatus :: ResultItemStatus } deriving (Eq, Show) +-- |+-- @since 2.10.0 resultItemIsFailure :: ResultItem -> Bool resultItemIsFailure item = case resultItemStatus item of ResultItemSuccess -> False
src/Test/Hspec/Core/Spec/Monad.hs view
@@ -71,6 +71,8 @@ mapSpecForest :: ([SpecTree a] -> [SpecTree b]) -> SpecM a r -> SpecM b r mapSpecForest f (SpecM specs) = SpecM (mapWriterT (fmap (fmap (second f))) specs) +-- {-# DEPRECATED mapSpecItem "Use `mapSpecItem_` instead." #-}+-- | Deprecated: Use `mapSpecItem_` instead. mapSpecItem :: (ActionWith a -> ActionWith b) -> (Item a -> Item b) -> SpecWith a -> SpecWith b mapSpecItem _ = mapSpecItem_
src/Test/Hspec/Core/Util.hs view
@@ -38,17 +38,23 @@ -- -- >>> pluralize 2 "example" -- "2 examples"+--+-- @since 2.0.0 pluralize :: Int -> String -> String pluralize 1 s = "1 " ++ s pluralize n s = show n ++ " " ++ s ++ "s" -- | Strip leading and trailing whitespace+--+-- @since 2.0.0 strip :: String -> String strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse -- |--- ensure that lines are not longer than given `n`, insert line breaks at word+-- Ensure that lines are not longer than given `n`, insert line breaks at word -- boundaries+--+-- @since 2.0.0 lineBreaksAt :: Int -> String -> [String] lineBreaksAt n = concatMap f . lines where@@ -68,17 +74,23 @@ -- A `Path` describes the location of a spec item within a spec tree. -- -- It consists of a list of group descriptions and a requirement description.+--+-- @since 2.0.0 type Path = ([String], String) -- | -- Join a `Path` with slashes. The result will have a leading and a trailing -- slash.+--+-- @since 2.5.4 joinPath :: Path -> String joinPath (groups, requirement) = "/" ++ intercalate "/" (groups ++ [requirement]) ++ "/" -- | -- Try to create a proper English sentence from a path by applying some -- heuristics.+--+-- @since 2.0.0 formatRequirement :: Path -> String formatRequirement (groups, requirement) = groups_ ++ requirement where@@ -91,6 +103,8 @@ ys -> concatMap (++ ", ") ys -- | A predicate that can be used to filter a spec tree.+--+-- @since 2.0.0 filterPredicate :: String -> Path -> Bool filterPredicate pattern path = pattern `isInfixOf` plain@@ -107,6 +121,8 @@ -- "ArithException\ndivide by zero" -- -- For `IOException`s the `IOErrorType` is included, as well.+--+-- @since 2.0.0 formatException :: SomeException -> String formatException err@(SomeException e) = case fromException err of Just ioe -> showType ioe ++ " of type " ++ showIOErrorType ioe ++ "\n" ++ show ioe@@ -137,5 +153,7 @@ -- | @safeTry@ evaluates given action and returns its result. If an exception -- occurs, the exception is returned instead. Unlike `try` it is agnostic to -- asynchronous exceptions.+--+-- @since 2.0.0 safeTry :: IO a -> IO (Either SomeException a) safeTry action = withAsync (action >>= evaluate) waitCatch
− test/All.hs
@@ -1,2 +0,0 @@-{-# OPTIONS -fno-warn-implicit-prelude #-}-{-# OPTIONS_GHC -fforce-recomp -F -pgmF hspec-meta-discover -optF --module-name=All #-}
test/Helper.hs view
@@ -31,6 +31,8 @@ , (</>) , mkLocation , workaroundForIssue19236++, replace ) where import Prelude ()@@ -126,8 +128,17 @@ readIORef spy >>= (`shouldSatisfy` p) removeLocations :: H.SpecWith a -> H.SpecWith a-removeLocations = H.mapSpecItem_ (\item -> item{H.itemLocation = Nothing})+removeLocations = H.mapSpecItem_ $ \ item -> item {+ H.itemLocation = Nothing+, H.itemExample = \ params action progressCallback -> removeResultLocation <$> H.itemExample item params action progressCallback+} +removeResultLocation :: Result -> Result+removeResultLocation (Result info status) = case status of+ Success -> Result info status+ Pending _loc reason -> Result info (Pending Nothing reason)+ Failure _loc reason -> Result info (Failure Nothing reason)+ withEnvironment :: [(String, String)] -> IO a -> IO a withEnvironment environment action = bracket saveEnv restoreEnv $ const action where@@ -158,3 +169,8 @@ #else mkLocation _ _ _ = Nothing #endif++replace :: Eq a => a -> a -> [a] -> [a]+replace x y xs = case break (== x) xs of+ (ys, _: zs) -> ys ++ y : zs+ _ -> xs
test/Spec.hs view
@@ -1,13 +1,1 @@-module Main where--import Prelude ()-import Helper--import Test.Hspec.Meta-import qualified All--spec :: Spec-spec = aroundAll_ (withEnvironment [("IGNORE_DOT_HSPEC", "yes")]) All.spec--main :: IO ()-main = hspec spec+{-# OPTIONS_GHC -fforce-recomp -F -pgmF hspec-meta-discover #-}
+ test/SpecHook.hs view
@@ -0,0 +1,17 @@+module SpecHook (hook) where++import Prelude ()+import Helper++import System.Environment (getEnvironment)++ignoreHspecConfig :: IO a -> IO a+ignoreHspecConfig action = do+ env <- getEnvironment+ let filteredEnv = ("IGNORE_DOT_HSPEC", "yes") : filter p env+ withEnvironment filteredEnv action+ where+ p (name, _value) = name == "COMSPEC" || name == "PATH"++hook :: Spec -> Spec+hook = aroundAll_ ignoreHspecConfig
test/Test/Hspec/Core/Config/OptionsSpec.hs view
@@ -46,6 +46,14 @@ describe "RUNNER OPTIONS" $ do let parseOptions_ args = snd <$> Options.parseOptions defaultConfig "my-spec" [] Nothing [] args + it "gives HSPEC_FAIL_ON precedence over HSPEC_STRICT" $ do+ (configFailOnFocused &&& configFailOnPending) <$> parseOptions [] Nothing [("HSPEC_STRICT", "no"), ("HSPEC_FAIL_ON", "focused")] []+ `shouldBe` Right (True, False)++ it "gives HSPEC_NO_FAIL_ON precedence over HSPEC_STRICT" $ do+ (configFailOnFocused &&& configFailOnPending) <$> parseOptions [] Nothing [("HSPEC_STRICT", "yes"), ("HSPEC_NO_FAIL_ON", "focused")] []+ `shouldBe` Right (False, True)+ context "with --fail-on-focused" $ do it "sets configFailOnFocused to True" $ do configFailOnFocused <$> parseOptions_ ["--fail-on-focused"] `shouldBe` Right True@@ -90,6 +98,29 @@ it "sets configDiff to False" $ do configDiff <$> parseOptions [] Nothing [] ["--no-diff"] `shouldBe` Right False + context "with --diff-context" $ do+ it "accepts 0" $ do+ configDiffContext <$> parseOptions [] Nothing [] ["--diff-context=0"] `shouldBe` Right (Just 0)++ it "accepts positive values" $ do+ configDiffContext <$> parseOptions [] Nothing [] ["--diff-context=5"] `shouldBe` Right (Just 5)++ it "rejects invalid values" $ do+ let msg = "my-spec: invalid argument `foo' for `--diff-context'\nTry `my-spec --help' for more information.\n"+ void (parseOptions [] Nothing [] ["--diff-context=foo"]) `shouldBe` Left (ExitFailure 1, msg)++ context "with negative values" $ do+ it "disables the option" $ do+ configDiffContext <$> parseOptions [] Nothing [] ["--diff-context=-1"] `shouldBe` Right Nothing++ context "with 'full'" $ do+ it "disables the option" $ do+ configDiffContext <$> parseOptions [] Nothing [] ["--diff-context=full"] `shouldBe` Right Nothing++ context "with --diff-command=" $ do+ it "sets configExternalDiff to Nothing" $ do+ fmap (const ()) . configExternalDiff <$> parseOptions [] Nothing [] ["--diff-command="] `shouldBe` Right Nothing+ context "with --print-slow-items" $ do it "sets configPrintSlowItems to N" $ do configPrintSlowItems <$> parseOptions [] Nothing [] ["--print-slow-items=5"] `shouldBe` Right (Just 5)@@ -104,6 +135,10 @@ context "when N is 0" $ do it "disables the option" $ do configPrintSlowItems <$> parseOptions [] Nothing [] ["-p0"] `shouldBe` Right Nothing++ context "when N is negative" $ do+ it "disables the option" $ do+ configPrintSlowItems <$> parseOptions [] Nothing [] ["--print-slow-items=-23"] `shouldBe` Right Nothing context "with --qc-max-success" $ do it "sets QuickCheck maxSuccess" $ do
test/Test/Hspec/Core/Formatters/DiffSpec.hs view
@@ -12,6 +12,86 @@ spec :: Spec spec = do+ describe "diff" $ do+ let+ enumerate name n = map ((name ++) . show) [1 .. n :: Int]+ diff_ expected actual = diff (Just 2) (unlines expected) (unlines actual)++ it "suppresses excessive diff output" $ do+ let+ expected = enumerate "foo" 99+ actual = replace "foo50" "bar50" expected++ diff_ expected actual `shouldBe` [+ Omitted 47+ , Both $ unlines [+ "foo48"+ , "foo49"+ ]+ , First "foo50"+ , Second "bar50"+ , Both $ unlines [+ ""+ , "foo51"+ , "foo52"+ ]+ , Omitted 47+ ]++ it "ensures that omitted sections are at least three lines in size" $ do+ forAll (elements [1..20]) $ \ size -> do+ let expected = enumerate "" size+ forAll (elements expected) $ \ i -> do+ let actual = replace i "bar" expected+ [n | Omitted n <- diff_ expected actual] `shouldSatisfy` all (>= 3)++ context "with modifications within a line" $ do+ it "suppresses excessive diff output" $ do+ let+ expected = enumerate "foo " 99+ actual = replace "foo 42" "foo 23" expected++ diff_ expected actual `shouldBe` [+ Omitted 39+ , Both $ concat [+ "foo 40\n"+ , "foo 41\n"+ , "foo "+ ]+ , First "42"+ , Second "23"+ , Both $ concat [+ "\n"+ , "foo 43\n"+ , "foo 44\n"+ ]+ , Omitted 55+ ]++ context "with modifications at start / end" $ do+ it "suppresses excessive diff output" $ do+ let+ expected = enumerate "foo" 9+ actual = replace "foo9" "bar9" $ replace "foo1" "bar1" expected++ diff_ expected actual `shouldBe` [+ First "foo1"+ , Second "bar1"+ , Both $ unlines [+ ""+ , "foo2"+ , "foo3"+ ]+ , Omitted 3+ , Both $ unlines [+ "foo7"+ , "foo8"+ ]+ , First "foo9"+ , Second "bar9"+ , Both "\n"+ ]+ describe "partition" $ do context "with a single shown Char" $ do it "never partitions a character escape" $ do
test/Test/Hspec/Core/Formatters/InternalSpec.hs view
@@ -14,6 +14,8 @@ , formatConfigReportProgress = False , formatConfigOutputUnicode = False , formatConfigUseDiff = True+, formatConfigDiffContext = Just 3+, formatConfigExternalDiff = Nothing , formatConfigPrettyPrint = False , formatConfigPrettyPrintFunction = Nothing , formatConfigPrintTimes = False
test/Test/Hspec/Core/Formatters/V2Spec.hs view
@@ -27,6 +27,8 @@ , formatConfigReportProgress = False , formatConfigOutputUnicode = unicode , formatConfigUseDiff = True+, formatConfigDiffContext = Just 3+, formatConfigExternalDiff = Nothing , formatConfigPrettyPrint = True , formatConfigPrettyPrintFunction = Just (H.configPrettyPrintFunction H.defaultConfig unicode) , formatConfigPrintTimes = False
test/Test/Hspec/Core/RunnerSpec.hs view
@@ -441,11 +441,16 @@ #if __GLASGOW_HASKELL__ >= 802 context "with --pretty" $ do it "pretty-prints Haskell values" $ do- r <- capture_ . ignoreExitCode . withArgs ["--pretty"] . H.hspec $ do+ let args = ["--pretty", "--seed=0", "--format=failed-examples"]+ r <- fmap (unlines . normalizeSummary . lines) . capture_ . ignoreExitCode . withArgs args . H.hspec . removeLocations $ do H.it "foo" $ do person 23 `H.shouldBe` person 42- r `shouldContain` unlines [- " expected: Person {"+ r `shouldBe` unlines [+ ""+ , "Failures:"+ , ""+ , " 1) foo"+ , " expected: Person {" , " personName = \"Joe\"," , " personAge = 42" , " }"@@ -453,6 +458,13 @@ , " personName = \"Joe\"," , " personAge = 23" , " }"+ , ""+ , " To rerun use: --match \"/foo/\""+ , ""+ , "Randomized with seed 0"+ , ""+ , "Finished in 0.0000 seconds"+ , "1 example, 1 failure" ] #endif @@ -496,6 +508,75 @@ r `shouldContain` unlines [ red ++ " expected: " ++ reset ++ "42" , red ++ " but got: " ++ reset ++ "23"+ ]++ context "with --diff-context" $ do+ it "suppresses excessive diff output" $ do+ let+ args = ["--seed=0", "--format=failed-examples", "--diff-context=1"]+ expected = map show [1 .. 99 :: Int]+ actual = replace "50" "foo" expected+ r <- fmap (unlines . normalizeSummary . lines) . capture_ . ignoreExitCode . withArgs args . H.hspec . removeLocations $ do+ H.it "foo" $ do+ unlines actual `H.shouldBe` unlines expected+ r `shouldBe` unlines [+ ""+ , "Failures:"+ , ""+ , " 1) foo"+ , " expected: @@ 48 lines omitted @@"+ , " 49"+ , " 50"+ , " 51"+ , " @@ 48 lines omitted @@"+ , " "+ , " but got: @@ 48 lines omitted @@"+ , " 49"+ , " foo"+ , " 51"+ , " @@ 48 lines omitted @@"+ , " "+ , ""+ , " To rerun use: --match \"/foo/\""+ , ""+ , "Randomized with seed 0"+ , ""+ , "Finished in 0.0000 seconds"+ , "1 example, 1 failure"+ ]++ context "with --diff-command" $ do+ it "uses an external diff command" $ do+ let+ args = ["--seed=0", "--format=failed-examples", "--diff-command", "diff -u -L expected -L actual"]+ expected = map show [1 .. 99 :: Int]+ actual = replace "50" "foo" expected+ r <- fmap (unlines . normalizeSummary . lines) . capture_ . ignoreExitCode . withArgs args . H.hspec . removeLocations $ do+ H.it "foo" $ do+ unlines actual `H.shouldBe` unlines expected+ r `shouldBe` unlines [+ ""+ , "Failures:"+ , ""+ , " 1) foo"+ , "--- expected"+ , "+++ actual"+ , "@@ -47,7 +47,7 @@"+ , " 47"+ , " 48"+ , " 49"+ , "-50"+ , "+foo"+ , " 51"+ , " 52"+ , " 53"+ , ""+ , " To rerun use: --match \"/foo/\""+ , ""+ , "Randomized with seed 0"+ , ""+ , "Finished in 0.0000 seconds"+ , "1 example, 1 failure" ] context "with --print-slow-items" $ do
version.yaml view
@@ -1,1 +1,1 @@-&version 2.10.5+&version 2.10.6