packages feed

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 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