diff --git a/hspec-core.cabal b/hspec-core.cabal --- a/hspec-core.cabal +++ b/hspec-core.cabal @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.15.0. +-- This file has been generated from package.yaml by hpack version 0.17.0. -- -- see: https://github.com/sol/hpack name: hspec-core -version: 2.4.1 +version: 2.4.2 license: MIT license-file: LICENSE copyright: (c) 2011-2017 Simon Hengel, diff --git a/src/Test/Hspec/Core/Config.hs b/src/Test/Hspec/Core/Config.hs --- a/src/Test/Hspec/Core/Config.hs +++ b/src/Test/Hspec/Core/Config.hs @@ -88,7 +88,7 @@ case parseOptions opts_ prog configFiles args of Left (err, msg) -> exitWithMessage err msg Right opts -> do - r <- if configRerun opts then readFailureReport else return Nothing + r <- if configRerun opts then readFailureReport opts else return Nothing return (r, mkConfig r opts) readConfigFiles :: IO [ConfigFile] diff --git a/src/Test/Hspec/Core/FailureReport.hs b/src/Test/Hspec/Core/FailureReport.hs --- a/src/Test/Hspec/Core/FailureReport.hs +++ b/src/Test/Hspec/Core/FailureReport.hs @@ -9,9 +9,12 @@ import System.SetEnv import Test.Hspec.Core.Util (safeTry) #endif +import Control.Monad import System.IO +import System.Directory import Test.Hspec.Core.Compat import Test.Hspec.Core.Util (Path) +import Test.Hspec.Core.Options (Config(..)) data FailureReport = FailureReport { failureReportSeed :: Integer @@ -21,29 +24,42 @@ , failureReportPaths :: [Path] } deriving (Eq, Show, Read) -writeFailureReport :: FailureReport -> IO () +writeFailureReport :: Config -> FailureReport -> IO () +writeFailureReport config report = case configFailureReport config of + Just file -> writeFile file (show report) + Nothing -> do #ifdef __GHCJS__ -writeFailureReport _ = return () - -- ghcjs currently does not support setting environment variables - -- (https://github.com/ghcjs/ghcjs/issues/263). Since writing a failure report - -- into the environment is a non-essential feature we just disable this to be - -- able to run hspec test-suites with ghcjs at all. Should be reverted once - -- the issue is fixed. + -- ghcjs currently does not support setting environment variables + -- (https://github.com/ghcjs/ghcjs/issues/263). Since writing a failure report + -- into the environment is a non-essential feature we just disable this to be + -- able to run hspec test-suites with ghcjs at all. Should be reverted once + -- the issue is fixed. + return () #else -writeFailureReport x = do - -- on Windows this can throw an exception when the input is too large, hence - -- 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 ++ ")") + -- on Windows this can throw an exception when the input is too large, hence + -- we use `safeTry` here + safeTry (setEnv "HSPEC_FAILURES" $ show report) >>= either onError return + where + onError err = do + hPutStrLn stderr ("WARNING: Could not write environment variable HSPEC_FAILURES (" ++ show err ++ ")") #endif -readFailureReport :: IO (Maybe FailureReport) -readFailureReport = do - mx <- lookupEnv "HSPEC_FAILURES" - case mx >>= readMaybe of - Nothing -> do - hPutStrLn stderr "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!" - return Nothing - x -> return x +readFailureReport :: Config -> IO (Maybe FailureReport) +readFailureReport config = case configFailureReport config of + Just file -> do + exists <- doesFileExist file + if exists + then do + r <- readFile file + let report = readMaybe r + when (report == Nothing) $ do + hPutStrLn stderr ("WARNING: Could not read failure report from file " ++ show file ++ "!") + return report + else return Nothing + Nothing -> do + mx <- lookupEnv "HSPEC_FAILURES" + case mx >>= readMaybe of + Nothing -> do + hPutStrLn stderr "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!" + return Nothing + report -> return report diff --git a/src/Test/Hspec/Core/Options.hs b/src/Test/Hspec/Core/Options.hs --- a/src/Test/Hspec/Core/Options.hs +++ b/src/Test/Hspec/Core/Options.hs @@ -28,6 +28,7 @@ , configDryRun :: Bool , configPrintCpuTime :: Bool , configFastFail :: Bool +, configFailureReport :: Maybe FilePath , configRerun :: Bool , configRerunAllOnSuccess :: Bool @@ -55,6 +56,7 @@ , configDryRun = False , configPrintCpuTime = False , configFastFail = False +, configFailureReport = Nothing , configRerun = False , configRerunAllOnSuccess = False , configFilterPredicate = Nothing @@ -65,7 +67,7 @@ , configQuickCheckMaxSize = Nothing , configSmallCheckDepth = paramsSmallCheckDepth defaultParams , configColorMode = ColorAuto -, configDiff = False +, configDiff = True , configFormatter = Nothing , configHtmlOutput = False , configOutputFile = Left stdout @@ -161,7 +163,8 @@ , 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 "r" ["rerun"] (NoArg setRerun) (h "rerun all examples that failed in the previous test run (only works in GHCi)") + , Option "r" ["rerun"] (NoArg setRerun) (h "rerun all examples that failed in the previous test run (only works in combination with --failure-report or in GHCi)") + , mkOption [] "failure-report" (Arg "FILE" return setFailureReport)(h "read/write a failure report for use with --rerun") , Option [] ["rerun-all-on-success"] (NoArg setRerunAllOnSuccess) (h "run the whole test suite after a previously failing rerun succeeds for the first time (only works in combination with --rerun)") , mkOption "j" "jobs" (Arg "N" readMaxJobs setMaxJobs) (h "run at most N parallelizable tests simultaneously (default: number of available processors)") ] @@ -180,6 +183,9 @@ setOutputFile :: String -> Config -> Config setOutputFile file c = c {configOutputFile = Right file} + + setFailureReport :: String -> Config -> Config + setFailureReport file c = c {configFailureReport = Just file} setMaxJobs :: Int -> Config -> Config setMaxJobs n c = c {configConcurrentJobs = Just n} diff --git a/src/Test/Hspec/Core/Runner.hs b/src/Test/Hspec/Core/Runner.hs --- a/src/Test/Hspec/Core/Runner.hs +++ b/src/Test/Hspec/Core/Runner.hs @@ -176,13 +176,13 @@ Formatter.interpret $ footerFormatter formatter xs <- map failureRecordPath <$> Formatter.interpret getFailMessages - liftIO $ dumpFailureReport seed qcArgs xs + liftIO $ dumpFailureReport config seed qcArgs xs Summary <$> Formatter.interpret getTotalCount <*> Formatter.interpret getFailCount -dumpFailureReport :: Integer -> QC.Args -> [Path] -> IO () -dumpFailureReport seed qcArgs xs = do - writeFailureReport FailureReport { +dumpFailureReport :: Config -> Integer -> QC.Args -> [Path] -> IO () +dumpFailureReport config seed qcArgs xs = do + writeFailureReport config FailureReport { failureReportSeed = seed , failureReportMaxSuccess = QC.maxSuccess qcArgs , failureReportMaxSize = QC.maxSize qcArgs diff --git a/test/Test/Hspec/Core/FailureReportSpec.hs b/test/Test/Hspec/Core/FailureReportSpec.hs --- a/test/Test/Hspec/Core/FailureReportSpec.hs +++ b/test/Test/Hspec/Core/FailureReportSpec.hs @@ -5,6 +5,7 @@ import System.IO import qualified Control.Exception as E import Test.Hspec.Core.FailureReport +import Test.Hspec.Core.Config main :: IO () main = hspec spec @@ -13,5 +14,38 @@ spec = do describe "writeFailureReport" $ do it "prints a warning on unexpected exceptions" $ do - r <- hCapture_ [stderr] $ writeFailureReport (E.throw (E.ErrorCall "some error")) + r <- hCapture_ [stderr] $ writeFailureReport defaultConfig (E.throw (E.ErrorCall "some error")) r `shouldBe` "WARNING: Could not write environment variable HSPEC_FAILURES (some error)\n" + + describe "readFailureReport" $ do + context "when configFailureReport is specified" $ do + let + file = "report" + config = defaultConfig {configFailureReport = Just file} + report = FailureReport { + failureReportSeed = 23 + , failureReportMaxSuccess = 42 + , failureReportMaxSize = 65 + , failureReportMaxDiscardRatio = 123 + , failureReportPaths = [(["foo", "bar"], "baz")] + } + it "reads a failure report from a file" $ do + inTempDirectory $ do + writeFailureReport config report + readFailureReport config `shouldReturn` Just report + + context "when file does not exist" $ do + it "returns Nothing" $ do + inTempDirectory $ do + readFailureReport config `shouldReturn` Nothing + + context "when file is malformed" $ do + it "returns Nothing" $ do + hSilence [stderr] $ inTempDirectory $ do + writeFile file "foo" + readFailureReport config `shouldReturn` Nothing + + it "prints a warning" $ do + inTempDirectory $ do + writeFile file "foo" + hCapture_ [stderr] (readFailureReport config) `shouldReturn` "WARNING: Could not read failure report from file \"report\"!\n"