hspec 1.5.1 → 1.5.2
raw patch · 11 files changed
+274/−68 lines, 11 filesdep +deepseqdep +randomPVP ok
version bump matches the API change (PVP)
Dependencies added: deepseq, random
API changes (from Hackage documentation)
+ Test.Hspec.Formatters: usedSeed :: FormatM Integer
Files
- hspec.cabal +5/−1
- src/Test/Hspec/Config.hs +42/−17
- src/Test/Hspec/Core/Type.hs +8/−1
- src/Test/Hspec/FailureReport.hs +20/−8
- src/Test/Hspec/Formatters.hs +4/−0
- src/Test/Hspec/Formatters/Internal.hs +9/−3
- src/Test/Hspec/Runner.hs +44/−18
- src/Test/Hspec/Util.hs +23/−5
- test/Test/Hspec/FailureReportSpec.hs +1/−1
- test/Test/Hspec/RunnerSpec.hs +93/−9
- test/Test/Hspec/UtilSpec.hs +25/−5
hspec.cabal view
@@ -1,5 +1,5 @@ name: hspec-version: 1.5.1+version: 1.5.2 license: BSD3 license-file: LICENSE copyright: (c) 2011-2013 Simon Hengel, (c) 2011-2012 Trystan Spangler, (c) 2011 Greg Weber@@ -51,10 +51,12 @@ src build-depends: base == 4.*+ , random == 1.0.* , setenv , ansi-terminal >= 0.5 , time , transformers >= 0.2.2.0 && < 0.4.0+ , deepseq , HUnit >= 1.2.5 , QuickCheck >= 2.5.1 , quickcheck-io@@ -100,11 +102,13 @@ -Wall -Werror build-depends: base == 4.*+ , random == 1.0.* , setenv , silently >= 1.2.4 , ansi-terminal , time , transformers+ , deepseq , HUnit , QuickCheck , quickcheck-io
src/Test/Hspec/Config.hs view
@@ -4,6 +4,10 @@ , defaultConfig , getConfig , configAddFilter+, configSetSeed++-- exported to silence warnings+, Arg (..) ) where import Control.Monad (unless)@@ -69,37 +73,58 @@ p = maybe p1 (\p0 path -> p0 path || p1 path) mp mp = configFilterPredicate c -setQC_MaxSuccess :: String -> Result -> Result-setQC_MaxSuccess n x = (\c -> c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.maxSuccess = read n}}) <$> x+setMaxSuccess :: Int -> Config -> Config+setMaxSuccess n c = c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.maxSuccess = n}} +configSetSeed :: Integer -> Config -> Config+configSetSeed n c = c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.replay = Just (stdGenFromInteger n, 0)}}+++data Arg a = Arg {+ argumentName :: String+, argumentParser :: String -> Maybe a+, argumentSetter :: a -> Config -> Config+}++mkOption :: [Char] -> [Char] -> Arg a -> String -> OptDescr (Result -> Result)+mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help+ where+ arg :: String -> Result -> Result+ arg input x = x >>= \c -> case parser input of+ Just n -> Right (setter n c)+ Nothing -> Left (InvalidArgument name input)+ addLineBreaks :: String -> [String] addLineBreaks = lineBreaksAt 44 options :: [OptDescr (Result -> Result)] options = [- Option [] ["help"] (NoArg (const $ Left Help)) (h "display this help and exit")- , 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") (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 [] ["fail-fast"] (NoArg setFastFail) (h "abort on first failure")+ Option [] ["help"] (NoArg (const $ Left Help)) (h "display this help and exit")+ , mkOption "m" "match" (Arg "PATTERN" return setFilter) (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'")+ , mkOption "f" "format" (Arg "FORMATTER" readFormatter setFormatter) formatHelp+ , mkOption "a" "qc-max-success" (Arg "N" readMaybe setMaxSuccess) (h "maximum number of successful tests before a QuickCheck property succeeds")+ , mkOption [] "seed" (Arg "N" readMaybe configSetSeed) (h "used seed for QuickCheck properties")+ , 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 [] ["fail-fast"] (NoArg setFastFail) (h "abort on first failure") ] where h = unlines . addLineBreaks - setFilter :: String -> Result -> Result- setFilter pattern x = configAddFilter (filterPredicate pattern) <$> x+ setFilter :: String -> Config -> Config+ setFilter = configAddFilter . filterPredicate + readFormatter :: String -> Maybe Formatter+ readFormatter = (`lookup` formatters)++ setFormatter :: Formatter -> Config -> Config+ setFormatter f c = c {configFormatter = f}+ 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)- Just f -> return c {configFormatter = f}- setColor mValue x = x >>= \c -> parseColor mValue >>= \v -> return c {configColorMode = v} where parseColor s = case s of@@ -114,7 +139,7 @@ Option "r" ["re-run"] (NoArg setReRun) "only re-run examples that previously failed" -- for compatibility with test-framework- , Option "" ["maximum-generated-tests"] (ReqArg setQC_MaxSuccess "NUMBER") "how many automated tests something like QuickCheck should try, by default"+ , mkOption [] "maximum-generated-tests" (Arg "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default" -- undocumented for now, as we probably want to change this to produce a -- standalone HTML report in the future
src/Test/Hspec/Core/Type.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.Core.Type ( Spec , SpecM (..)@@ -13,6 +12,7 @@ , describe , it+, forceResult , pending , pendingWith@@ -35,6 +35,7 @@ import qualified Test.QuickCheck.IO () import Test.Hspec.Compat (isUserInterrupt)+import Control.DeepSeq (deepseq) type Spec = SpecM ()@@ -54,6 +55,12 @@ -- | The result of running an example. data Result = Success | Pending (Maybe String) | Fail String deriving (Eq, Show, Read, Typeable)++forceResult :: Result -> Result+forceResult r = case r of+ Success -> r `seq` r+ Pending m -> r `seq` m `deepseq` r+ Fail m -> r `seq` m `deepseq` r instance E.Exception Result
src/Test/Hspec/FailureReport.hs view
@@ -1,16 +1,21 @@-module Test.Hspec.FailureReport where+module Test.Hspec.FailureReport (+ writeFailureReport+, readFailureReport+) where import System.IO import System.SetEnv+import qualified Test.QuickCheck as QC import Test.Hspec.Config-import Test.Hspec.Util (safeEvaluate, readMaybe, getEnv)+import Test.Hspec.Util (Path, safeTry, readMaybe, getEnv) -writeFailureReport :: String -> IO ()+type Seed = Integer++writeFailureReport :: (Seed, [Path]) -> IO () writeFailureReport x = do -- on Windows this can throw an exception when the input is too large, hence- -- we use `safeEvaluate` here- r <- safeEvaluate (setEnv "HSPEC_FAILURES" x)- either onError return r+ -- we use `safeTry` here+ safeTry (setEnv "HSPEC_FAILURES" $ show x) >>= either onError return where onError err = do hPutStrLn stderr ("WARNING: Could not write environment variable HSPEC_FAILURES (" ++ show err ++ ")")@@ -22,5 +27,12 @@ Nothing -> do hPutStrLn stderr "WARNING: Could not read environment variable HSPEC_FAILURES; `--re-run' is ignored!" return c- Just xs -> do- return $ configAddFilter (`elem` xs) c+ Just (seed, xs) -> do+ (return . setSeed seed . configAddFilter (`elem` xs)) c++setSeed :: Seed -> Config -> Config+setSeed seed c+ | hasSeed = c+ | otherwise = configSetSeed seed c+ where+ hasSeed = maybe False (const True) (QC.replay $ configQuickCheckArgs c)
src/Test/Hspec/Formatters.hs view
@@ -29,6 +29,7 @@ , FailureRecord (..) , getFailMessages+, usedSeed , getCPUTime , getRealTime@@ -72,6 +73,7 @@ , FailureRecord (..) , getFailMessages+ , usedSeed , getCPUTime , getRealTime@@ -161,6 +163,8 @@ forM_ (zip [1..] failures) $ \x -> do formatFailure x+ writeLine ""+ write "Randomized with seed " >> usedSeed >>= writeLine . show writeLine "" where formatFailure :: (Int, FailureRecord) -> FormatM ()
src/Test/Hspec/Formatters/Internal.hs view
@@ -12,6 +12,7 @@ , FailureRecord (..) , getFailMessages+, usedSeed , getCPUTime , getRealTime@@ -76,10 +77,15 @@ , pendingCount :: Int , failCount :: Int , failMessages :: [FailureRecord]+, stateUsedSeed :: Integer , cpuStartTime :: Maybe Integer , startTime :: POSIXTime } +-- | The random seed that is used for QuickCheck.+usedSeed :: FormatM Integer+usedSeed = gets stateUsedSeed+ -- | The total number of examples encountered so far. totalCount :: FormatterState -> Int totalCount s = successCount s + pendingCount s + failCount s@@ -89,11 +95,11 @@ 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+runFormatM :: Bool -> Bool -> Bool -> Integer -> Handle -> FormatM a -> IO a+runFormatM useColor produceHTML_ printCpuTime seed handle (FormatM action) = do time <- getPOSIXTime cpuTime <- if printCpuTime then Just <$> CPUTime.getCPUTime else pure Nothing- st <- newIORef (FormatterState handle useColor produceHTML_ False 0 0 0 [] cpuTime time)+ st <- newIORef (FormatterState handle useColor produceHTML_ False 0 0 0 [] seed cpuTime time) evalStateT action st -- | Increase the counter for successful examples
src/Test/Hspec/Runner.hs view
@@ -21,14 +21,18 @@ import System.IO import System.Environment import System.Exit+import qualified Control.Exception as E -import Test.Hspec.Util (Path, safeEvaluate)+import System.Console.ANSI (hHideCursor, hShowCursor)+import qualified Test.QuickCheck as QC+import System.Random (newStdGen)++import Test.Hspec.Util import Test.Hspec.Core.Type import Test.Hspec.Config import Test.Hspec.Formatters import Test.Hspec.Formatters.Internal import Test.Hspec.FailureReport-import System.Console.ANSI (hHideCursor, hShowCursor) import Test.Hspec.Timer -- | Filter specs by given predicate.@@ -60,9 +64,10 @@ unless (configFastFail c && fails /= 0) $ do xs `each` f + eval :: IO Result -> FormatM (Either E.SomeException Result) eval | configDryRun c = \_ -> return (Right Success)- | otherwise = liftIO . safeEvaluate+ | otherwise = liftIO . safeTry . fmap forceResult go :: [String] -> (Int, SpecTree) -> FormatM () go rGroups (n, SpecGroup group xs) = do@@ -110,6 +115,25 @@ r <- hspecWith c spec unless (summaryFailures r == 0) exitFailure +handleReRun :: Config -> IO Config+handleReRun c = do+ if configReRun c+ then do+ readFailureReport c+ else do+ return c++-- Add a StdGen to configQuickCheckArgs if there is none. That way the same+-- seed is used for all properties. This helps with --seed and --re-run.+ensureStdGen :: Config -> IO Config+ensureStdGen c = case QC.replay qcArgs of+ Nothing -> do+ stdGen <- newStdGen+ return c {configQuickCheckArgs = qcArgs {QC.replay = Just (stdGen, 0)}}+ _ -> return c+ where+ qcArgs = configQuickCheckArgs c+ -- | Run given spec with custom options. -- This is similar to `hspec`, but more flexible. --@@ -119,30 +143,32 @@ hspecWith :: Config -> Spec -> IO Summary hspecWith c_ spec = do -- read failure report on --re-run- c <- if configReRun c_- then do- readFailureReport c_- else do- return c_+ c <- handleReRun c_ >>= ensureStdGen let formatter = configFormatter c h = configHandle c+ seed = (stdGenToInteger . fst . fromJust . QC.replay . configQuickCheckArgs) c useColor <- doesUseColor h c- when useColor (hHideCursor h)- runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) h $ do- runFormatter useColor c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_` do- failedFormatter formatter- liftIO $ when useColor (hShowCursor h) - footerFormatter formatter+ withHiddenCursor useColor h $+ runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do+ runFormatter useColor c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_` do+ failedFormatter formatter - -- dump failure report- xs <- map failureRecordPath <$> getFailMessages- liftIO $ writeFailureReport (show xs)+ footerFormatter formatter - Summary <$> getTotalCount <*> getFailCount+ -- dump failure report+ xs <- map failureRecordPath <$> getFailMessages+ liftIO $ writeFailureReport (seed, xs)++ Summary <$> getTotalCount <*> getFailCount where+ withHiddenCursor :: Bool -> Handle -> IO a -> IO a+ withHiddenCursor useColor h+ | useColor = E.bracket_ (hHideCursor h) (hShowCursor h)+ | otherwise = id+ doesUseColor :: Handle -> Config -> IO Bool doesUseColor h c = case configColorMode c of ColorAuto -> hIsTerminalDevice h
src/Test/Hspec/Util.hs view
@@ -1,21 +1,25 @@ module Test.Hspec.Util ( quantify , lineBreaksAt-, safeEvaluate+, safeTry , Path , filterPredicate , formatRequirement , readMaybe , getEnv , strip+, stdGenToInteger+, stdGenFromInteger ) where +import Data.Int (Int32) import Data.List import Data.Maybe import Data.Char (isSpace) import Control.Applicative import qualified Control.Exception as E import qualified System.Environment as Environment+import System.Random (StdGen) -- | Create a more readable display of a quantity of something. --@@ -33,13 +37,13 @@ quantify 1 s = "1 " ++ s quantify n s = show n ++ " " ++ s ++ "s" -safeEvaluate :: IO a -> IO (Either E.SomeException a)-safeEvaluate action = (Right <$> (action >>= E.evaluate)) `E.catches` [+safeTry :: IO a -> IO (Either E.SomeException a)+safeTry action = (Right <$> (action >>= E.evaluate)) `E.catches` [ -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT -- (ctrl-c). All AsyncExceptions are re-thrown (not just UserInterrupt) -- because all of them indicate severe conditions and should not occur during -- normal operation.- E.Handler $ \e -> E.throw (e :: E.AsyncException)+ E.Handler $ \e -> E.throwIO (e :: E.AsyncException) , E.Handler $ \e -> (return . Left) (e :: E.SomeException) ]@@ -79,7 +83,7 @@ readMaybe = fmap fst . listToMaybe . reads getEnv :: String -> IO (Maybe String)-getEnv key = either (const Nothing) Just <$> safeEvaluate (Environment.getEnv key)+getEnv key = either (const Nothing) Just <$> safeTry (Environment.getEnv key) -- ensure that lines are not longer then given `n`, insert line beraks at word -- boundaries@@ -98,3 +102,17 @@ strip :: String -> String strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse++-- | Converts a 'StdGen' into an 'Integer'. Assumes+-- StdGens to be encoded as two positive 'Int32's and+-- $show (StdGen a b) = show a ++ " " ++ show b$.+stdGenToInteger :: StdGen -> Integer+stdGenToInteger stdGen =+ let [a, b] = map read . words $ show stdGen+ in b * fromIntegral (maxBound :: Int32) + a++-- | Inverse of 'stdGenToInteger'.+stdGenFromInteger :: Integer -> StdGen+stdGenFromInteger n =+ let (a, b) = quotRem n (fromIntegral (maxBound :: Int32))+ in read (show b ++ " " ++ show a)
test/Test/Hspec/FailureReportSpec.hs view
@@ -16,7 +16,7 @@ spec = do describe "writeFailureReport" $ do it "prints a warning on unexpected exceptions" $ do- (r, ()) <- hCapture [stderr] $ writeFailureReport (error "some error")+ r <- hCapture_ [stderr] $ writeFailureReport (error "some error") r `shouldBe` "WARNING: Could not write environment variable HSPEC_FAILURES (some error)\n" -- GHCi needs to keep the environment on :reload, so that we can store
test/Test/Hspec/RunnerSpec.hs view
@@ -15,6 +15,7 @@ import Test.QuickCheck import qualified Test.Hspec.Runner as H+import qualified Test.Hspec.Core as H (Result(..)) import qualified Test.Hspec as H (describe, it, pending) import qualified Test.Hspec.Formatters as H (silent) @@ -64,7 +65,7 @@ context "when interrupted with ctrl-c" $ do it "prints summary immediately" $ do- r <- captureLines . ignoreUserInterrupt . H.hspec $ do+ r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec $ do H.it "foo" False H.it "bar" $ do E.throwIO E.UserInterrupt :: IO ()@@ -75,6 +76,8 @@ , "" , "1) foo FAILED" , ""+ , "Randomized with seed 23"+ , "" ] it "throws UserInterrupt" $ do@@ -118,7 +121,7 @@ context "with --fail-fast" $ do it "stops after first failure" $ do- r <- captureLines . ignoreExitCode . withArgs ["--fail-fast"] . H.hspec $ do+ r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec $ do H.it "foo" True H.it "bar" False H.it "baz" False@@ -129,12 +132,14 @@ , "" , "1) bar FAILED" , ""+ , "Randomized with seed 23"+ , "" , "Finished in 0.0000 seconds" , "2 examples, 1 failure" ] it "works for nested specs" $ do- r <- captureLines . ignoreExitCode . withArgs ["--fail-fast"] . H.hspec $ do+ r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec $ do H.describe "foo" $ do H.it "bar" False H.it "baz" True@@ -145,6 +150,8 @@ , "" , "1) foo bar FAILED" , ""+ , "Randomized with seed 23"+ , "" , "Finished in 0.0000 seconds" , "1 example, 1 failure" ]@@ -176,14 +183,70 @@ H.it "example 3" $ mockAction e3 (,,) <$> mockCounter e1 <*> mockCounter e2 <*> mockCounter e3 `shouldReturn` (1, 0, 1) + context "with --format" $ do+ it "uses specified formatter" $ do+ r <- capture_ . ignoreExitCode . withArgs ["--format", "progress"] . H.hspec $ do+ H.it "foo" True+ H.it "bar" True+ H.it "baz" False+ H.it "qux" True+ r `shouldContain` "..F."++ context "when given an invalid argument" $ do+ it "prints an error message to stderr" $ do+ r <- hCapture_ [stderr] . ignoreExitCode . withArgs ["--format", "foo"] . H.hspec $ do+ H.it "foo" True+ r `shouldContain` "invalid argument `foo' for `--format'"+ context "with --maximum-generated-tests=n" $ do it "tries QuickCheck properties n times" $ do m <- newMock- silence . withArgs ["--maximum-generated-tests=23"] . H.hspec $ do+ silence . withArgs ["--qc-max-succes", "23"] . H.hspec $ do H.it "foo" $ property $ do mockAction m mockCounter m `shouldReturn` 23 + context "when given an invalid argument" $ do+ it "prints an error message to stderr" $ do+ r <- hCapture_ [stderr] . ignoreExitCode . withArgs ["--qc-max-succes", "foo"] . H.hspec $ do+ H.it "foo" True+ r `shouldContain` "invalid argument `foo' for `--qc-max-success'"++ context "with --seed" $ do+ it "uses specified seed" $ do+ r <- captureLines . ignoreExitCode . withArgs ["--seed", "2413421499272008081"] . H.hspec $ do+ H.it "foo" $+ property $ \n -> ((17 + 31 * n) `mod` 50) /= (23 :: Int)+ r `shouldContain` [+ "Falsifiable (after 55 tests): "+ , "1190445426"+ ]++ context "when run with --re-run" $ do+ it "takes precedence" $ do+ let runSpec args = capture_ . ignoreExitCode . withArgs args . H.hspec $ do+ H.it "foo" $+ property $ \n -> ((17 + 31 * n) `mod` 50) /= (23 :: Int)++ r0 <- runSpec ["--seed", "23"]+ r0 `shouldContain` "(after 13 tests)"++ r1 <- runSpec ["--seed", "42"]+ r1 `shouldContain` "(after 18 tests)"++ r2 <- runSpec ["--re-run", "--seed", "23"]+ r2 `shouldContain` "(after 13 tests)"++ context "when given an invalid argument" $ do+ let run = withArgs ["--seed", "foo"] . H.hspec $ do+ H.it "foo" True+ it "prints an error message to stderr" $ do+ r <- hCapture_ [stderr] (ignoreExitCode run)+ r `shouldContain` "invalid argument `foo' for `--seed'"++ it "exits with exitFailure" $ do+ hSilence [stderr] run `shouldThrow` (== ExitFailure 1)+ context "with --print-cpu-time" $ do it "includes used CPU time in summary" $ do r <- capture_ $ withArgs ["--print-cpu-time"] (H.hspec $ pure ())@@ -211,15 +274,15 @@ r `shouldContain` "<span class=\"hspec-failure\">- foo" describe "hspec (experimental features)" $ do- it "stores a failure report in environment HSPEC_FAILURES" $ do- silence . ignoreExitCode . H.hspec $ do+ it "stores a failure report in environment" $ do+ silence . ignoreExitCode . withArgs ["--seed", "23"] . H.hspec $ do H.describe "foo" $ do H.describe "bar" $ do H.it "example 1" True H.it "example 2" False H.describe "baz" $ do H.it "example 3" False- getEnv "HSPEC_FAILURES" `shouldReturn` Just "[([\"foo\",\"bar\"],\"example 2\"),([\"baz\"],\"example 3\")]"+ getEnv "HSPEC_FAILURES" `shouldReturn` Just "(23,[([\"foo\",\"bar\"],\"example 2\"),([\"baz\"],\"example 3\")])" describe "with --re-run" $ do let runSpec = (captureLines . ignoreExitCode . H.hspec) $ do@@ -236,6 +299,22 @@ r1 <- withArgs ["-r"] runSpec r1 `shouldSatisfy` elem "3 examples, 3 failures" + it "reuses the same seed" $ do+ let runSpec_ = (captureLines . ignoreExitCode . H.hspec) $ do+ H.it "foo" $ property $ \n -> ((17 + 31 * n) `mod` 50) /= (23 :: Int)++ r0 <- withArgs ["--seed", "2413421499272008081"] runSpec_+ r0 `shouldContain` [+ "Falsifiable (after 55 tests): "+ , "1190445426"+ ]++ r1 <- withArgs ["-r"] runSpec_+ r1 `shouldContain` [+ "Falsifiable (after 55 tests): "+ , "1190445426"+ ]+ context "when there is no failure report in the environment" $ do it "runs everything" $ do unsetEnv "HSPEC_FAILURES"@@ -244,8 +323,8 @@ it "prints a warning to stderr" $ do unsetEnv "HSPEC_FAILURES"- r <- hCapture [stderr] $ withArgs ["-r"] runSpec- fst r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--re-run' is ignored!\n"+ r <- hCapture_ [stderr] $ withArgs ["-r"] runSpec+ r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--re-run' is ignored!\n" context "when parsing of failure report fails" $ do it "runs everything" $ do@@ -284,3 +363,8 @@ H.describe "Foo.Bar" $ do H.it "some example" True r `shouldBe` ""++ it "does not let escape error thunks from failure messages" $ do+ r <- silence . H.hspecWith H.defaultConfig $ do+ H.it "some example" (H.Fail $ "foobar" ++ undefined)+ r `shouldBe` H.Summary 1 1
test/Test/Hspec/UtilSpec.hs view
@@ -1,6 +1,10 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.UtilSpec (main, spec) where import Test.Hspec.Meta+import Test.QuickCheck+import Data.Int (Int32)+import System.Random (StdGen) import qualified Control.Exception as E import Test.Hspec.Util@@ -36,21 +40,21 @@ , "sed do eiusmod" ] - describe "safeEvaluate" $ do+ describe "safeTry" $ do it "returns Right on success" $ do- Right e <- safeEvaluate (return 23 :: IO Int)+ Right e <- safeTry (return 23 :: IO Int) e `shouldBe` 23 it "returns Left on exception" $ do- Left e <- safeEvaluate (E.throwIO E.DivideByZero :: IO Int)+ Left e <- safeTry (E.throwIO E.DivideByZero :: IO Int) show e `shouldBe` "divide by zero" it "evaluates result to weak head normal form" $ do- Left e <- safeEvaluate (return undefined)+ Left e <- safeTry (return undefined) show e `shouldBe` "Prelude.undefined" it "re-throws AsyncException" $ do- safeEvaluate (E.throwIO E.UserInterrupt :: IO Int) `shouldThrow` (== E.UserInterrupt)+ safeTry (E.throwIO E.UserInterrupt :: IO Int) `shouldThrow` (== E.UserInterrupt) describe "filterPredicate" $ do it "tries to match a pattern against a path" $ do@@ -98,3 +102,19 @@ it "returns Nothing if specified environment variable is not set" $ do unsetEnv "FOO" getEnv "FOO" `shouldReturn` Nothing++ describe "stdGenToInteger" $ do+ it "is inverse to stdGenFromInteger" $ property $+ \(NonNegative i) -> (stdGenToInteger . stdGenFromInteger) i `shouldBe` i++ describe "stdGenFromInteger" $ do+ it "is inverse to stdGenToInteger" $ property $+ \stdGen -> (stdGenFromInteger . stdGenToInteger) stdGen `shouldBe` stdGen++instance Eq StdGen where+ a == b = show a == show b++instance Arbitrary StdGen where+ arbitrary = do+ (Positive a, Positive b) <- arbitrary+ return $ read (show (a :: Int32) ++ " " ++ show (b :: Int32))