diff --git a/hspec.cabal b/hspec.cabal --- a/hspec.cabal +++ b/hspec.cabal @@ -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 diff --git a/src/Test/Hspec/Config.hs b/src/Test/Hspec/Config.hs --- a/src/Test/Hspec/Config.hs +++ b/src/Test/Hspec/Config.hs @@ -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 diff --git a/src/Test/Hspec/Core/Type.hs b/src/Test/Hspec/Core/Type.hs --- a/src/Test/Hspec/Core/Type.hs +++ b/src/Test/Hspec/Core/Type.hs @@ -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 diff --git a/src/Test/Hspec/FailureReport.hs b/src/Test/Hspec/FailureReport.hs --- a/src/Test/Hspec/FailureReport.hs +++ b/src/Test/Hspec/FailureReport.hs @@ -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) diff --git a/src/Test/Hspec/Formatters.hs b/src/Test/Hspec/Formatters.hs --- a/src/Test/Hspec/Formatters.hs +++ b/src/Test/Hspec/Formatters.hs @@ -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 () diff --git a/src/Test/Hspec/Formatters/Internal.hs b/src/Test/Hspec/Formatters/Internal.hs --- a/src/Test/Hspec/Formatters/Internal.hs +++ b/src/Test/Hspec/Formatters/Internal.hs @@ -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 diff --git a/src/Test/Hspec/Runner.hs b/src/Test/Hspec/Runner.hs --- a/src/Test/Hspec/Runner.hs +++ b/src/Test/Hspec/Runner.hs @@ -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 diff --git a/src/Test/Hspec/Util.hs b/src/Test/Hspec/Util.hs --- a/src/Test/Hspec/Util.hs +++ b/src/Test/Hspec/Util.hs @@ -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) diff --git a/test/Test/Hspec/FailureReportSpec.hs b/test/Test/Hspec/FailureReportSpec.hs --- a/test/Test/Hspec/FailureReportSpec.hs +++ b/test/Test/Hspec/FailureReportSpec.hs @@ -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 diff --git a/test/Test/Hspec/RunnerSpec.hs b/test/Test/Hspec/RunnerSpec.hs --- a/test/Test/Hspec/RunnerSpec.hs +++ b/test/Test/Hspec/RunnerSpec.hs @@ -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` "- 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 diff --git a/test/Test/Hspec/UtilSpec.hs b/test/Test/Hspec/UtilSpec.hs --- a/test/Test/Hspec/UtilSpec.hs +++ b/test/Test/Hspec/UtilSpec.hs @@ -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))