hspec 1.4.3 → 1.4.4

raw patch · 12 files changed

+204/−50 lines, 12 filesdep ~ansi-terminalPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ansi-terminal

API changes (from Hackage documentation)

Files

• hspec.cabal +2/−2
• src/Test/Hspec/Compat.hs +9/−1
• src/Test/Hspec/Config.hs +17/−9
• src/Test/Hspec/Formatters.hs +31/−13
• src/Test/Hspec/Formatters/Internal.hs +39/−18
• src/Test/Hspec/Runner.hs +14/−4
• src/Test/Hspec/Util.hs +16/−0
• test/Test/Hspec/CompatSpec.hs +5/−1
• test/Test/Hspec/FormattersSpec.hs +1/−1
• test/Test/Hspec/RunnerSpec.hs +58/−0
• test/Test/Hspec/UtilSpec.hs +11/−0
• test/doctests.hs +1/−1

@@ -1,5 +1,5 @@ name:             hspec-version:          1.4.3+version:          1.4.4 license:          BSD3 license-file:     LICENSE copyright:        (c) 2011-2012 Trystan Spangler, (c) 2011-2012 Simon Hengel, (c) 2011 Greg Weber@@ -51,7 +51,7 @@       base          == 4.*     , setenv     , silently      >= 1.1.1-    , ansi-terminal == 0.5.*+    , ansi-terminal >= 0.5     , time     , transformers  >= 0.2.2.0 && < 0.4.0     , HUnit         >= 1.2.5

@@ -7,9 +7,17 @@ import           Data.Typeable.Internal (tyConModule, tyConName) #endif - showType :: Typeable a => a -> String showType a = let t = typeRepTyCon (typeOf a) in+#if MIN_VERSION_base(4,4,0)+  show t+#else+  (reverse . takeWhile (/= '.') . reverse . show) t+#endif+++showFullType :: Typeable a => a -> String+showFullType a = let t = typeRepTyCon (typeOf a) in #if MIN_VERSION_base(4,4,0)   tyConModule t ++ "." ++ tyConName t #else

@@ -26,6 +26,7 @@ , configDryRun          :: Bool , configPrintCpuTime    :: Bool , configReRun           :: Bool+, configFastFail        :: Bool  -- | -- A predicate that is used to filter the spec before it is run.  Only examples@@ -41,7 +42,7 @@ data ColorMode = ColorAuto | ColorNever | ColorAlway  defaultConfig :: Config-defaultConfig = Config False False False False Nothing defaultParams ColorAuto specdoc False stdout+defaultConfig = Config False False False False False Nothing defaultParams ColorAuto specdoc False stdout  formatters :: [(String, Formatter)] formatters = [@@ -52,7 +53,7 @@   ]  formatHelp :: String-formatHelp = unlines ("Use a custom formatter.  This can be one of:" : map (("  " ++) . fst) formatters)+formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map (("   " ++) . fst) formatters)  type Result = Either NoConfig Config @@ -73,24 +74,31 @@     mapParams :: (Params -> Params) -> Config -> Config     mapParams f c = c {configParams = f (configParams c)} +addLineBreaks :: String -> [String]+addLineBreaks = lineBreaksAt 44+ options :: [OptDescr (Result -> Result)] options = [-    Option []  ["help"]                    (NoArg (const $ Left Help))        "display this help and exit"-  , Option "v" ["verbose"]                 (NoArg setVerbose)                 "do not suppress output to stdout when\nevaluating examples"-  , Option "m" ["match"]                   (ReqArg setFilter "PATTERN")       "only run examples that match given PATTERN"-  , Option []  ["color"]                   (OptArg setColor "WHEN")           "colorize the output.  WHEN defaults to\n`always' or can be `never' or `auto'."+    Option []  ["help"]                    (NoArg (const $ Left Help))        (h "display this help and exit")+  , Option "v" ["verbose"]                 (NoArg setVerbose)                 (h "do not suppress output to stdout when evaluating examples")+  , Option "m" ["match"]                   (ReqArg setFilter "PATTERN")       (h "only run examples that match given PATTERN")+  , Option []  ["color"]                   (OptArg setColor "WHEN")           (h "colorize the output; WHEN defaults to `always' or can be `never' or `auto'")   , Option "f" ["format"]                  (ReqArg setFormatter "FORMATTER")  formatHelp-  , Option "a" ["qc-max-success"]          (ReqArg setQC_MaxSuccess "N")      "maximum number of successful tests before a\nQuickCheck property succeeds"-  , Option []  ["print-cpu-time"]          (NoArg setPrintCpuTime)            "include used CPU time in summary"-  , Option []  ["dry-run"]                 (NoArg setDryRun)                  "pretend that everything passed; don't verify\nanything"+  , Option "a" ["qc-max-success"]          (ReqArg setQC_MaxSuccess "N")      (h "maximum number of successful tests before a QuickCheck property succeeds")+  , Option []  ["print-cpu-time"]          (NoArg setPrintCpuTime)            (h "include used CPU time in summary")+  , Option []  ["dry-run"]                 (NoArg setDryRun)                  (h "pretend that everything passed; don't verify anything")+  , Option []  ["fast-fail"]               (NoArg setFastFail)                (h "stop after first failure")   ]   where+    h = unlines . addLineBreaks+     setFilter :: String -> Result -> Result     setFilter pattern x = configAddFilter (filterPredicate pattern) <$> x      setVerbose      x = x >>= \c -> return c {configVerbose      = True}     setPrintCpuTime x = x >>= \c -> return c {configPrintCpuTime = True}     setDryRun       x = x >>= \c -> return c {configDryRun       = True}+    setFastFail     x = x >>= \c -> return c {configFastFail     = True}      setFormatter name x = x >>= \c -> case lookup name formatters of       Nothing -> Left (InvalidArgument "format" name)

@@ -42,14 +42,16 @@ , withSuccessColor , withPendingColor , withFailColor++-- ** Helpers+, formatException ) where  import           Data.Maybe import           Test.Hspec.Util import           Test.Hspec.Compat-import           Data.List (intersperse) import           Text.Printf-import           Control.Monad (unless)+import           Control.Monad (unless, forM_) import           Control.Applicative import qualified Control.Exception as E @@ -149,20 +151,36 @@ defaultFailedFormatter :: FormatM () defaultFailedFormatter = do   newParagraph-  withFailColor $ do-    failures <- map formatFailure . zip [1..] <$> getFailMessages-    mapM_ writeLine (intersperse "" failures)-    unless (null failures) (writeLine "")++  failures <- getFailMessages++  forM_ (zip [1..] failures) $ \x -> do+    formatFailure x+    writeLine ""   where-    formatFailure :: (Int, FailureRecord) -> String-    formatFailure (i, FailureRecord path reason) =-      show i ++ ") " ++ formatRequirement path ++ " FAILED" ++ err+    formatFailure :: (Int, FailureRecord) -> FormatM ()+    formatFailure (n, FailureRecord path reason) = do+      write (show n ++ ") ")+      withFailColor $ do+        write (formatRequirement path ++ " FAILED")+        write $ case reason of+          Right _ -> "\n"+          Left _  -> " (uncaught exception)\n"+        unless (null err) $ do+          writeLine err       where-        err = case reason of-          Left (E.SomeException e)  -> " (uncaught exception)\n" ++ formatException e-          Right e -> if null e then "" else "\n" ++ e+        err = either formatException id reason -        formatException e = showType e ++ " (" ++ show e ++ ")"+-- | Convert an exception to a string.+--+-- The type of the exception is included.  Here is an example:+--+-- >>> import Control.Applicative+-- >>> import Control.Exception+-- >>> either formatException show <$> (try . evaluate) (1 `div` 0)+-- "ArithException (divide by zero)"+formatException :: E.SomeException -> String+formatException (E.SomeException e) = showType e ++ " (" ++ show e ++ ")"  defaultFooter :: FormatM () defaultFooter = do

@@ -31,29 +31,32 @@ , increasePendingCount , increaseFailCount , addFailMessage+, finally_ ) where  import qualified System.IO as IO import           System.IO (Handle) import           Control.Monad (when, unless) import           Control.Applicative-import           Control.Exception (SomeException, bracket_)+import           Control.Exception (SomeException, AsyncException(..), bracket_, try, throwIO) import           System.Console.ANSI import           Control.Monad.Trans.State hiding (gets, modify)-import qualified Control.Monad.Trans.State as State import qualified Control.Monad.IO.Class as IOClass import qualified System.CPUTime as CPUTime+import           Data.IORef import           Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)  import           Test.Hspec.Util (Path) --- | A lifted version of `State.gets`+-- | A lifted version of `Control.Monad.Trans.State.gets` gets :: (FormatterState -> a) -> FormatM a-gets f = FormatM (State.gets f)+gets f = FormatM $ do+  f <$> (get >>= IOClass.liftIO . readIORef) --- | A lifted version of `State.modify`+-- | A lifted version of `Control.Monad.Trans.State.modify` modify :: (FormatterState -> FormatterState) -> FormatM ()-modify f = FormatM (State.modify f)+modify f = FormatM $ do+  get >>= IOClass.liftIO . (`modifyIORef` f)  -- | A lifted version of `IOClass.liftIO` --@@ -80,14 +83,17 @@ totalCount :: FormatterState -> Int totalCount s = successCount s + pendingCount s + failCount s -newtype FormatM a = FormatM (StateT FormatterState IO a)+-- NOTE: We use an IORef here, so that the state persists when UserInterrupt is+-- thrown.+newtype FormatM a = FormatM (StateT (IORef FormatterState) IO a)   deriving (Functor, Applicative, Monad)  runFormatM :: Bool -> Bool -> Bool -> Handle -> FormatM a -> IO a runFormatM useColor produceHTML_ printCpuTime handle (FormatM action) = do   time <- getPOSIXTime   cpuTime <- if printCpuTime then Just <$> CPUTime.getCPUTime else pure Nothing-  evalStateT action (FormatterState handle useColor produceHTML_ False 0 0 0 [] cpuTime time)+  st <- newIORef (FormatterState handle useColor produceHTML_ False 0 0 0 [] cpuTime time)+  evalStateT action st  -- | Increase the counter for successful examples increaseSuccessCount :: FormatM ()@@ -207,20 +213,35 @@ htmlSpan cls action = write ("<span class=\"" ++ cls ++ "\">") *> action <* write "</span>"  withColor_ :: SGR -> FormatM a -> FormatM a-withColor_ color (FormatM action) = FormatM . StateT $ \st -> do-  let useColor = stateUseColor st-      h        = stateHandle st+withColor_ color (FormatM action) = do+  useColor <- gets stateUseColor+  h        <- gets stateHandle -  bracket_+  FormatM . StateT $ \st -> do+    bracket_ -    -- set color-    (when useColor $ hSetSGR h [color])+      -- set color+      (when useColor $ hSetSGR h [color]) -    -- reset colors-    (when useColor $ hSetSGR h [Reset])+      -- reset colors+      (when useColor $ hSetSGR h [Reset]) -    -- run action-    (runStateT action st)+      -- run action+      (runStateT action st)++-- |+-- @finally_ actionA actionB@ runs @actionA@ and then @actionB@.  @actionB@ is+-- run even when a `UserInterrupt` occurs during @actionA@.+finally_ :: FormatM () -> FormatM () -> FormatM ()+finally_ (FormatM actionA) (FormatM actionB) = FormatM . StateT $ \st -> do+  r <- try (execStateT actionA st)+  case r of+    Left e -> do+      when (e == UserInterrupt) $+        runStateT actionB st >> return ()+      throwIO e+    Right st_ -> do+      runStateT actionB st_  -- | Get the used CPU time since the test run has been started. getCPUTime :: FormatM (Maybe Double)

@@ -48,8 +48,17 @@  -- | Evaluate all examples of a given spec and produce a report. runFormatter :: Config -> Formatter -> [SpecTree] -> FormatM ()-runFormatter c formatter specs = headerFormatter formatter >> mapM_ (go []) (zip [0..] specs)+runFormatter c formatter specs = headerFormatter formatter >> zip [0..] specs `each` go []   where+    -- like forM_, but respects --fast-fail+    each :: [a] -> (a -> FormatM ()) -> FormatM ()+    each []     _ = pure ()+    each (x:xs) f = do+      f x+      fails <- getFailCount+      unless (configFastFail c && fails /= 0) $ do+        xs `each` f+     silence_       | configVerbose c = id       | otherwise       = silence@@ -61,7 +70,7 @@     go :: [String] -> (Int, SpecTree) -> FormatM ()     go rGroups (n, SpecGroup group xs) = do       exampleGroupStarted formatter n (reverse rGroups) group-      mapM_ (go (group : rGroups)) (zip [0..] xs)+      zip [0..] xs `each` go (group : rGroups)       exampleGroupDone formatter     go rGroups (_, SpecItem requirement example) = do       result <- eval (example $ configParams c)@@ -115,8 +124,9 @@    useColor <- doesUseColor h c   runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) h $ do-    runFormatter c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec)-    failedFormatter formatter+    runFormatter c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_`+      failedFormatter formatter+     footerFormatter formatter      -- dump failure report

@@ -1,5 +1,6 @@ module Test.Hspec.Util (   quantify+, lineBreaksAt , safeEvaluate , Path , filterPredicate@@ -78,3 +79,18 @@  getEnv :: String -> IO (Maybe String) getEnv key = either (const Nothing) Just <$> safeEvaluate (Environment.getEnv key)++-- ensure that lines are not longer then given `n`, insert line beraks at word+-- boundaries+lineBreaksAt :: Int -> String -> [String]+lineBreaksAt n input = case words input of+  []   -> []+  x:xs -> go (x, xs)+  where+    go :: (String, [String]) -> [String]+    go c = case c of+      (s, [])   -> [s]+      (s, y:ys) -> let r = s ++ " " ++ y in+        if length r <= n+          then go (r, ys)+          else s : go (y, ys)

@@ -15,5 +15,9 @@ spec :: Spec spec = do   describe "showType" $ do+    it "shows unqualified name of type" $ do+      showType SomeType `shouldBe` "SomeType"++  describe "showFullType (currently unused)" $ do     it "shows fully qualified name of type" $ do-      showType SomeType `shouldBe` "Test.Hspec.CompatSpec.SomeType"+      showFullType SomeType `shouldBe` "Test.Hspec.CompatSpec.SomeType"

@@ -180,7 +180,7 @@         H.it "foobar" (undefined :: Bool)       r `shouldContain` [           "1) foobar FAILED (uncaught exception)"-        , "GHC.Exception.ErrorCall (Prelude.undefined)"+        , "ErrorCall (Prelude.undefined)"         ]      it "prints all descriptions when a nested requirement fails" $ do

@@ -4,6 +4,7 @@ import           System.IO.Silently import           System.IO (stderr) import           Control.Applicative+import           Control.Monad (unless) import           System.Environment (withArgs, withProgName, getArgs) import           System.Exit import qualified Control.Exception as E@@ -20,6 +21,9 @@ ignoreExitCode :: IO () -> IO () ignoreExitCode action = action `E.catch` \e -> let _ = e :: ExitCode in return () +ignoreUserInterrupt :: IO () -> IO ()+ignoreUserInterrupt action = action `E.catch` \e -> unless (e == E.UserInterrupt) (E.throwIO e)+ main :: IO () main = hspec spec @@ -58,6 +62,27 @@             getArgs `shouldReturn` []         `shouldReturn` () +    context "when interrupted with ctrl-c" $ do+      it "prints summary immediately" $ do+        r <- captureLines . ignoreUserInterrupt . H.hspec $ do+          H.it "foo" False+          H.it "bar" $ do+            E.throwIO E.UserInterrupt :: IO ()+          H.it "baz" True+        normalizeSummary r `shouldBe` [+            ""+          , "- foo FAILED [1]"+          , ""+          , "1) foo FAILED"+          , ""+          ]++      it "throws UserInterrupt" $ do+        H.hspec $ do+          H.it "foo" $ do+            E.throwIO E.UserInterrupt :: IO ()+        `shouldThrow` (== E.UserInterrupt)+     context "with --help" $ do       let printHelp = withProgName "spec" . withArgs ["--help"] . H.hspec $ pure ()       it "prints help" $ do@@ -97,6 +122,39 @@           H.it "foo" (mockAction e)           H.it "bar" False         mockCounter e `shouldReturn` 0++    context "with --fast-fail" $ do+      it "stops after first failure" $ do+        r <- captureLines . ignoreExitCode . withArgs ["--fast-fail"] . H.hspec $ do+          H.it "foo" True+          H.it "bar" False+          H.it "baz" False+        normalizeSummary r `shouldBe` [+            ""+          , "- foo"+          , "- bar FAILED [1]"+          , ""+          , "1) bar FAILED"+          , ""+          , "Finished in 0.0000 seconds"+          , "2 examples, 1 failure"+          ]++      it "works for nested specs" $ do+        r <- captureLines . ignoreExitCode . withArgs ["--fast-fail"] . H.hspec $ do+          H.describe "foo" $ do+            H.it "bar" False+            H.it "baz" True+        normalizeSummary r `shouldBe` [+            ""+          , "foo"+          , "  - bar FAILED [1]"+          , ""+          , "1) foo bar FAILED"+          , ""+          , "Finished in 0.0000 seconds"+          , "1 example, 1 failure"+          ]      context "with --match" $ do       it "only runs examples that match a given pattern" $ do

@@ -25,6 +25,17 @@     it "returns a plural word given the number 0" $ do       quantify 0 "thing" `shouldBe` "0 things" +  describe "lineBreaksAt" $ do+    it "inserts line breaks at word boundaries" $ do+      lineBreaksAt 20 "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod"+      `shouldBe` [+          "Lorem ipsum dolor"+        , "sit amet,"+        , "consectetur"+        , "adipisicing elit,"+        , "sed do eiusmod"+        ]+   describe "safeEvaluate" $ do     it "returns Right on success" $ do       Right e <- safeEvaluate (return 23 :: IO Int)

@@ -3,4 +3,4 @@ import           Test.DocTest  main :: IO ()-main = doctest ["-isrc", "src/Test/Hspec/Util.hs"]+main = doctest ["-isrc", "-optP-include", "-optPdist/build/autogen/cabal_macros.h", "src/Test/Hspec/Util.hs", "src/Test/Hspec/Formatters.hs"]