packages feed

hspec-core 2.9.5 → 2.9.6

raw patch · 11 files changed

+123/−46 lines, 11 filesdep ~call-stack

Dependency ranges changed: call-stack

Files

hspec-core.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:             hspec-core-version:          2.9.5+version:          2.9.6 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2021 Simon Hengel,@@ -39,7 +39,7 @@     , ansi-terminal >=0.6.2     , array     , base >=4.5.0.0 && <5-    , call-stack+    , call-stack >=0.2.0     , clock >=0.7.1     , deepseq     , directory@@ -122,7 +122,7 @@     , array     , base >=4.5.0.0 && <5     , base-orphans-    , call-stack+    , call-stack >=0.2.0     , clock >=0.7.1     , deepseq     , directory
src/Test/Hspec/Core/Example.hs view
@@ -5,8 +5,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} --- NOTE: re-exported from Test.Hspec.Core.Spec module Test.Hspec.Core.Example (+-- RE-EXPORTED from Test.Hspec.Core.Spec   Example (..) , Params (..) , defaultParams@@ -19,6 +19,8 @@ , FailureReason (..) , safeEvaluate , safeEvaluateExample+-- END RE-EXPORTED from Test.Hspec.Core.Spec+, safeEvaluateResultStatus ) where  import           Prelude ()@@ -106,12 +108,19 @@  safeEvaluate :: IO Result -> IO Result safeEvaluate action = do-  r <- safeTry $ action+  r <- safeTry action   return $ case r of-    Left e | Just result <- fromException e -> Result "" result-    Left e | Just hunit <- fromException e -> Result "" $ hunitFailureToResult Nothing hunit-    Left e -> Result "" $ Failure Nothing $ Error Nothing e+    Left e -> Result "" (toResultStatus e)     Right result -> result++safeEvaluateResultStatus :: IO ResultStatus -> IO ResultStatus+safeEvaluateResultStatus action = either toResultStatus id <$> safeTry action++toResultStatus :: SomeException -> ResultStatus+toResultStatus e+  | Just result <- fromException e = result+  | Just hunit <- fromException e = hunitFailureToResult Nothing hunit+  | otherwise = Failure Nothing $ Error Nothing e  instance Example Result where   type Arg Result = ()
src/Test/Hspec/Core/Formatters/Internal.hs view
@@ -40,7 +40,9 @@ , missingChunk  #ifdef TEST+, runFormatM , overwriteWith+, splitLines #endif ) where @@ -54,6 +56,7 @@ import           Control.Monad.Trans.State hiding (state, gets, modify) import           Control.Monad.IO.Class import           Data.Char (isSpace)+import           Data.List (groupBy) import qualified System.CPUTime as CPUTime  import           Test.Hspec.Core.Formatters.V1.Monad (FailureRecord(..))@@ -145,7 +148,8 @@ , stateCpuStartTime    :: Maybe Integer , stateStartTime       :: Seconds , stateTransientOutput :: String-, stateConfig :: FormatConfig+, stateConfig          :: FormatConfig+, stateColor           :: Maybe SGR }  getConfig :: (FormatConfig -> a) -> FormatM a@@ -167,7 +171,7 @@ runFormatM config (FormatM action) = do   time <- getMonotonicTime   cpuTime <- if (formatConfigPrintCpuTime config) then Just <$> CPUTime.getCPUTime else pure Nothing-  st <- newIORef (FormatterState 0 0 [] cpuTime time "" config)+  st <- newIORef (FormatterState 0 0 [] cpuTime time "" config Nothing)   evalStateT action st  -- | Increase the counter for successful examples@@ -225,9 +229,23 @@  -- | Append some output to the report. write :: String -> FormatM ()-write s = do+write = mapM_ writeChunk . splitLines++splitLines :: String -> [String]+splitLines = groupBy (\ a b -> isNewline a == isNewline b)+  where+    isNewline = (== '\n')++writeChunk :: String -> FormatM ()+writeChunk str = do   h <- getHandle-  liftIO $ IO.hPutStr h s+  mColor <- gets stateColor+  liftIO $ case mColor of+    Just color | not (all isSpace str) -> bracket_+      (hSetSGR h [color])+      (hSetSGR h [Reset])+      (IO.hPutStr h str)+    _ -> IO.hPutStr h str  -- | Set output color to red, run given action, and finally restore the default -- color.@@ -259,21 +277,15 @@ htmlSpan cls action = write ("<span class=\"" ++ cls ++ "\">") *> action <* write "</span>"  withColor_ :: SGR -> FormatM a -> FormatM a-withColor_ color (FormatM action) = do-  useColor <- getConfig formatConfigUseColor-  h <- getHandle--  FormatM . StateT $ \st -> do-    bracket_--      -- set color-      (when useColor $ hSetSGR h [color])--      -- reset colors-      (when useColor $ hSetSGR h [Reset])+withColor_ color action = do+  oldColor <- gets stateColor+  setColor (Just color) *> action <* setColor oldColor -      -- run action-      (runStateT action st)+setColor :: Maybe SGR -> FormatM ()+setColor color = do+  useColor <- getConfig formatConfigUseColor+  when useColor $ do+    modify (\ state -> state { stateColor = color })  -- | Output given chunk in red. extraChunk :: String -> FormatM ()
src/Test/Hspec/Core/Hooks.hs view
@@ -49,19 +49,19 @@ beforeWith action = aroundWith $ \e x -> action x >>= e  -- | Run a custom action before the first spec item.-beforeAll :: IO a -> SpecWith a -> Spec+beforeAll :: HasCallStack => IO a -> SpecWith a -> Spec beforeAll action spec = do   mvar <- runIO (newMVar Empty)   before (memoize mvar action) spec  -- | Run a custom action before the first spec item.-beforeAll_ :: IO () -> SpecWith a -> SpecWith a+beforeAll_ :: HasCallStack => IO () -> SpecWith a -> SpecWith a beforeAll_ action spec = do   mvar <- runIO (newMVar Empty)   before_ (memoize mvar action) spec  -- | Run a custom action with an argument before the first spec item.-beforeAllWith :: (b -> IO a) -> SpecWith a -> SpecWith b+beforeAllWith :: HasCallStack => (b -> IO a) -> SpecWith a -> SpecWith b beforeAllWith action spec = do   mvar <- runIO (newMVar Empty)   beforeWith (memoize mvar . action) spec@@ -71,14 +71,14 @@   | Memoized a   | Failed SomeException -memoize :: MVar (Memoized a) -> IO a -> IO a+memoize :: HasCallStack => MVar (Memoized a) -> IO a -> IO a memoize mvar action = do   result <- modifyMVar mvar $ \ma -> case ma of     Empty -> do       a <- try action       return (either Failed Memoized a, a)     Memoized a -> return (ma, Right a)-    Failed _ -> throwIO (Pending Nothing (Just "exception in beforeAll-hook (see previous failure)"))+    Failed _ -> throwIO (Pending Nothing (Just $ "exception in " <> maybe "beforeAll" fst callSite <> "-hook (see previous failure)"))   either throwIO return result  -- | Run a custom action after every spec item.@@ -114,11 +114,11 @@   item{ itemExample = \params aroundAction -> e params (aroundAction . action) }  -- | Wrap an action around the given spec.-aroundAll :: (ActionWith a -> IO ()) -> SpecWith a -> Spec+aroundAll :: HasCallStack => (ActionWith a -> IO ()) -> SpecWith a -> Spec aroundAll action = aroundAllWith $ \ e () -> action e  -- | Wrap an action around the given spec.-aroundAll_ :: (IO () -> IO ()) -> SpecWith a -> SpecWith a+aroundAll_ :: HasCallStack => (IO () -> IO ()) -> SpecWith a -> SpecWith a aroundAll_ action spec = do   allSpecItemsDone <- runIO newEmptyMVar   workerRef <- runIO newEmptyMVar@@ -139,7 +139,7 @@   beforeAll_ acquire $ afterAll_ release spec  -- | Wrap an action around the given spec. Changes the arg type inside.-aroundAllWith :: forall a b. (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b+aroundAllWith :: forall a b. HasCallStack => (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b aroundAllWith action spec = do   allSpecItemsDone <- runIO newEmptyMVar   workerRef <- runIO newEmptyMVar
src/Test/Hspec/Core/Runner.hs view
@@ -320,11 +320,12 @@ colorOutputSupported :: ColorMode -> IO Bool -> IO (Bool, Bool) colorOutputSupported mode isTerminalDevice = do   github <- githubActions+  buildkite <- lookupEnv "BUILDKITE" <&> (== Just "true")   useColor <- case mode of     ColorAuto  -> (github ||) <$> colorTerminal     ColorNever -> return False     ColorAlways -> return True-  let reportProgress = not github && useColor+  let reportProgress = not github && not buildkite && useColor   return (reportProgress, useColor)   where     githubActions :: IO Bool
src/Test/Hspec/Core/Runner/Eval.hs view
@@ -47,7 +47,7 @@ import qualified Test.Hspec.Core.Format as Format import           Test.Hspec.Core.Clock import           Test.Hspec.Core.Example.Location-import           Test.Hspec.Core.Example (safeEvaluate)+import           Test.Hspec.Core.Example (safeEvaluateResultStatus)  data NonEmpty a = a :| [a]   deriving (Eq, Show, Functor, Foldable, Traversable)@@ -243,10 +243,10 @@      runCleanup :: Maybe Location -> [String] -> IO () -> EvalM ()     runCleanup loc groups action = do-      r <- liftIO $ measure $ safeEvaluate (action >> return (Result "" Success))+      (t, r) <- liftIO $ measure $ safeEvaluateResultStatus (action >> return Success)       case r of-        (_, Result "" Success) -> return ()-        _ -> reportItem path loc (return r)+        Success -> return ()+        _ -> reportItem path loc $ return (t, Result "" r)       where         path = (groups, "afterAll-hook")
src/Test/Hspec/Core/Spec.hs view
@@ -32,7 +32,18 @@ , module Test.Hspec.Core.Spec.Monad  -- * A type class for examples-, module Test.Hspec.Core.Example+, Test.Hspec.Core.Example.Example (..)+, Test.Hspec.Core.Example.Params (..)+, Test.Hspec.Core.Example.defaultParams+, Test.Hspec.Core.Example.ActionWith+, Test.Hspec.Core.Example.Progress+, Test.Hspec.Core.Example.ProgressCallback+, Test.Hspec.Core.Example.Result(..)+, Test.Hspec.Core.Example.ResultStatus (..)+, Test.Hspec.Core.Example.Location (..)+, Test.Hspec.Core.Example.FailureReason (..)+, Test.Hspec.Core.Example.safeEvaluate+, Test.Hspec.Core.Example.safeEvaluateExample  -- * Internal representation of a spec tree , module Test.Hspec.Core.Tree
test/Test/Hspec/Core/Formatters/InternalSpec.hs view
@@ -3,11 +3,36 @@ import           Prelude () import           Helper +import           System.Console.ANSI +import           Test.Hspec.Core.Format import           Test.Hspec.Core.Formatters.Internal +formatConfig :: FormatConfig+formatConfig = FormatConfig {+  formatConfigUseColor = True+, formatConfigReportProgress = False+, formatConfigOutputUnicode = False+, formatConfigUseDiff = False+, formatConfigPrettyPrint = False+, formatConfigPrintTimes = False+, formatConfigHtmlOutput = False+, formatConfigPrintCpuTime = False+, formatConfigUsedSeed = 0+, formatConfigExpectedTotalCount = 0+}++green :: String -> String+green text = setSGRCode [SetColor Foreground Dull Green] <> text <> setSGRCode [Reset]+ spec :: Spec spec = do+  describe "write" $ do+    it "does not span colored output over multiple lines" $ do+      capture_ $ runFormatM formatConfig $ do+        withSuccessColor $ write "foo\nbar\nbaz\n"+      `shouldReturn` unlines [green "foo", green "bar", green "baz"]+   describe "overwriteWith" $ do     context "when old is null" $ do       it "returns new" $ do@@ -24,3 +49,15 @@     context "when old is longer than new" $ do       it "overwrites old" $ do         ("foobar" `overwriteWith` "foo") `shouldBe` "\rfoo   "++  describe "splitLines" $ do+    it "splits a string into chunks" $ do+      splitLines "foo\nbar\nbaz" `shouldBe` ["foo", "\n", "bar", "\n", "baz"]++    it "splits *arbitrary* strings into chunks" $ do+      property $ \ xs -> do+        mconcat (splitLines xs) `shouldBe` xs++    it "puts newlines into separate chunks" $ do+      property $ \ xs -> do+        filter (notElem '\n') (splitLines xs) `shouldBe` filter (not . null) (lines xs)
test/Test/Hspec/Core/HooksSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Hspec.Core.HooksSpec (spec) where @@ -142,7 +143,7 @@             n `shouldBe` 23         `shouldReturn` [           item ["foo"] divideByZero-        , item ["bar"] (Pending Nothing (Just "exception in beforeAll-hook (see previous failure)"))+        , item ["bar"] (Pending Nothing $ exceptionIn "beforeAll")         ]      context "when used with an empty list of examples" $ do@@ -233,7 +234,7 @@                 n `shouldBe` 23         `shouldReturn` [           item ["foo"] divideByZero-        , item ["bar"] (Pending Nothing (Just "exception in beforeAll-hook (see previous failure)"))+        , item ["bar"] (Pending Nothing $ exceptionIn "beforeAllWith")         ]      context "when used with an empty list of examples" $ do@@ -520,7 +521,7 @@           H.it "foo" True       `shouldReturn` [         item ["foo"] divideByZero-      , item ["afterAll-hook"] (Pending Nothing (Just "exception in beforeAll-hook (see previous failure)"))+      , item ["afterAll-hook"] (Pending Nothing $ exceptionIn "aroundAll_")       ]      it "reports exceptions on release" $ do@@ -554,7 +555,7 @@           H.it "foo" H.pending       `shouldReturn` [         item ["foo"] divideByZero-      , item ["afterAll-hook"] (Pending Nothing (Just "exception in beforeAll-hook (see previous failure)"))+      , item ["afterAll-hook"] (Pending Nothing $ exceptionIn "aroundAllWith")       ]      it "reports exceptions on release" $ do@@ -572,3 +573,9 @@      item :: [String] -> Result -> ([String], Item)     item path result = (path, Item Nothing 0 "" result)++#if MIN_VERSION_base(4,8,1)+    exceptionIn name = Just ("exception in " <> name <> "-hook (see previous failure)")+#else+    exceptionIn _ = Just "exception in beforeAll-hook (see previous failure)"+#endif
test/Test/Hspec/Core/RunnerSpec.hs view
@@ -425,7 +425,7 @@           , ""           , "Slow spec items:" #if MIN_VERSION_base(4,8,1)-          , "  test" </> "Test" </> "Hspec" </> "Core" </> "RunnerSpec.hs:418:11: /foo/ (2ms)"+          , "  test" </> "Test" </> "Hspec" </> "Core" </> "RunnerSpec.hs:" <> show (__LINE__ - 10 :: Int) <> ":11: /foo/ (2ms)" #else           , "  /foo/ (2ms)" #endif
version.yaml view
@@ -1,1 +1,1 @@-&version 2.9.5+&version 2.9.6