diff --git a/hspec.cabal b/hspec.cabal --- a/hspec.cabal +++ b/hspec.cabal @@ -1,5 +1,5 @@ name: hspec -version: 1.6.1 +version: 1.6.2 license: MIT license-file: LICENSE copyright: (c) 2011-2013 Simon Hengel, diff --git a/src/Test/Hspec.hs b/src/Test/Hspec.hs --- a/src/Test/Hspec.hs +++ b/src/Test/Hspec.hs @@ -32,6 +32,7 @@ , example , pending , pendingWith +, before , parallel -- * Running a spec @@ -145,9 +146,16 @@ -- | Run examples of given spec in parallel. parallel :: Spec -> Spec -parallel = fromSpecList . map go . runSpecM +parallel = mapSpecItem $ \_ r e -> SpecItem True r e + +-- | Run a custom action before every spec item. +before :: IO () -> Spec -> Spec +before action = mapSpecItem $ \b r e -> SpecItem b r (\params -> (action >> (e params))) + +mapSpecItem :: (Bool -> String -> (Params -> IO Result) -> SpecTree) -> Spec -> Spec +mapSpecItem f = fromSpecList . map go . runSpecM where go :: SpecTree -> SpecTree go spec = case spec of - SpecItem _ r e -> SpecItem True r e + SpecItem b r e -> f b r e SpecGroup d es -> SpecGroup d (map go es) 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 @@ -68,15 +68,25 @@ , configHandle = maybe (configHandle defaultConfig) Right (optionsOutputFile opts) } where - qcArgs = maybe id setSeed mSeed args - where - args = maybe id setMaxSuccess mMaxSuccess QC.stdArgs + qcArgs = ( + maybe id setSeed mSeed + . maybe id setMaxDiscardRatio mMaxDiscardRatio + . maybe id setMaxSize mMaxSize + . maybe id setMaxSuccess mMaxSuccess) QC.stdArgs mSeed = optionsSeed opts <|> (failureReportSeed <$> mFailureReport) mMaxSuccess = optionsMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport) + mMaxSize = optionsMaxSize opts <|> (failureReportMaxSize <$> mFailureReport) + mMaxDiscardRatio = optionsMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport) setMaxSuccess :: Int -> QC.Args -> QC.Args setMaxSuccess n args = args {QC.maxSuccess = n} + + setMaxSize :: Int -> QC.Args -> QC.Args + setMaxSize n args = args {QC.maxSize = n} + + setMaxDiscardRatio :: Int -> QC.Args -> QC.Args + setMaxDiscardRatio n args = args {QC.maxDiscardRatio = n} setSeed :: Integer -> QC.Args -> QC.Args setSeed n args = args {QC.replay = Just (stdGenFromInteger n, 0)} 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 @@ -11,6 +11,8 @@ data FailureReport = FailureReport { failureReportSeed :: Integer , failureReportMaxSuccess :: Int +, failureReportMaxSize :: Int +, failureReportMaxDiscardRatio :: Int , failureReportPaths :: [Path] } deriving (Eq, Show, Read) diff --git a/src/Test/Hspec/Options.hs b/src/Test/Hspec/Options.hs --- a/src/Test/Hspec/Options.hs +++ b/src/Test/Hspec/Options.hs @@ -26,6 +26,8 @@ , optionsMatch :: [String] , optionsMaxSuccess :: Maybe Int , optionsSeed :: Maybe Integer +, optionsMaxSize :: Maybe Int +, optionsMaxDiscardRatio :: Maybe Int , optionsColorMode :: ColorMode , optionsFormatter :: Formatter , optionsHtmlOutput :: Bool @@ -38,6 +40,12 @@ setMaxSuccess :: Int -> Options -> Options setMaxSuccess n c = c {optionsMaxSuccess = Just n} +setMaxSize :: Int -> Options -> Options +setMaxSize n c = c {optionsMaxSize = Just n} + +setMaxDiscardRatio :: Int -> Options -> Options +setMaxDiscardRatio n c = c {optionsMaxDiscardRatio = Just n} + setSeed :: Integer -> Options -> Options setSeed n c = c {optionsSeed = Just n} @@ -45,7 +53,7 @@ deriving (Eq, Show) defaultOptions :: Options -defaultOptions = Options False False False False [] Nothing Nothing ColorAuto specdoc False Nothing +defaultOptions = Options False False False False [] Nothing Nothing Nothing Nothing ColorAuto specdoc False Nothing formatters :: [(String, Formatter)] formatters = [ @@ -88,6 +96,8 @@ , mkOption "f" "format" (Arg "FORMATTER" readFormatter setFormatter) formatHelp , mkOption "o" "out" (Arg "FILE" return setOutputFile) (h "write output to a file instead of STDOUT") , mkOption "a" "qc-max-success" (Arg "N" readMaybe setMaxSuccess) (h "maximum number of successful tests before a QuickCheck property succeeds") + , mkOption "" "qc-max-size" (Arg "N" readMaybe setMaxSize) (h "size to use for the biggest test cases") + , mkOption "" "qc-max-discard" (Arg "N" readMaybe setMaxDiscardRatio) (h "maximum number of discarded tests per successful test before giving up") , mkOption [] "seed" (Arg "N" readMaybe setSeed) (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") 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 @@ -125,6 +125,8 @@ liftIO $ writeFailureReport FailureReport { failureReportSeed = seed , failureReportMaxSuccess = QC.maxSuccess (configQuickCheckArgs c) + , failureReportMaxSize = QC.maxSize (configQuickCheckArgs c) + , failureReportMaxDiscardRatio = QC.maxDiscardRatio (configQuickCheckArgs c) , failureReportPaths = xs } diff --git a/test/Helper.hs b/test/Helper.hs --- a/test/Helper.hs +++ b/test/Helper.hs @@ -9,24 +9,41 @@ , captureLines , normalizeSummary +, ignoreExitCode +, ignoreUserInterrupt + , shouldStartWith , shouldEndWith , shouldContain + +, shouldUseArgs ) where +import Data.List +import Data.Char +import Data.IORef +import Control.Monad import Control.Applicative +import System.Environment (withArgs) +import System.Exit +import Control.Concurrent +import qualified Control.Exception as E +import qualified System.Timeout as System +import Data.Time.Clock.POSIX +import System.IO.Silently + import Test.Hspec.Meta import Test.QuickCheck hiding (Result(..)) -import qualified Test.Hspec.Core as H +import qualified Test.Hspec.Core as H (Result(..), Params(..), fromSpecList, SpecTree(..)) import qualified Test.Hspec.Runner as H -import Data.List -import Data.Char -import System.IO.Silently -import Data.Time.Clock.POSIX -import Control.Concurrent -import qualified System.Timeout as System +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) + captureLines :: IO a -> IO [String] captureLines = fmap lines . capture_ @@ -56,3 +73,10 @@ timeout :: POSIXTime -> IO a -> IO (Maybe a) timeout = System.timeout . floor . (* 1000000) + +shouldUseArgs :: [String] -> (Args -> Bool) -> Expectation +shouldUseArgs args p = do + spy <- newIORef (H.paramsQuickCheckArgs defaultParams) + let spec = H.fromSpecList [H.SpecItem False "foo" $ \params -> writeIORef spy (H.paramsQuickCheckArgs params) >> return (H.Fail "example failed")] + (silence . ignoreExitCode . withArgs args . H.hspec) spec + readIORef spy >>= (`shouldSatisfy` p) diff --git a/test/Test/Hspec/OptionsSpec.hs b/test/Test/Hspec/OptionsSpec.hs --- a/test/Test/Hspec/OptionsSpec.hs +++ b/test/Test/Hspec/OptionsSpec.hs @@ -1,6 +1,7 @@ module Test.Hspec.OptionsSpec (main, spec) where import Helper +import System.Exit import Test.Hspec.Options hiding (parseOptions) import qualified Test.Hspec.Options as Options @@ -8,6 +9,10 @@ main :: IO () main = hspec spec +fromLeft :: Either a b -> a +fromLeft (Left a) = a +fromLeft _ = error "fromLeft: No left value!" + spec :: Spec spec = do describe "parseOptions" $ do @@ -26,5 +31,10 @@ optionsColorMode <$> parseOptions ["--color"] `shouldBe` Right ColorAlways context "with --out" $ do - it "sets optionsColorMode to ColorAlways" $ do + it "sets optionsOutputFile" $ do optionsOutputFile <$> parseOptions ["--out", "foo"] `shouldBe` Right (Just "foo") + + context "with --qc-max-success" $ do + context "when given an invalid argument" $ do + it "returns an error message" $ do + fromLeft (parseOptions ["--qc-max-success", "foo"]) `shouldBe` (ExitFailure 1, "my-spec: invalid argument `foo' for `--qc-max-success'\nTry `my-spec --help' for more information.\n") 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 @@ -10,23 +10,22 @@ import System.SetEnv import Test.Hspec.Util (getEnv) +import Test.Hspec.FailureReport (FailureReport(..)) import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H import qualified Test.Hspec.Core as H (Result(..)) import qualified Test.Hspec.Formatters as H (silent) -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) +import qualified Test.QuickCheck as QC main :: IO () main = hspec spec +quickCheckOptions :: [([Char], Args -> Int)] +quickCheckOptions = [("--qc-max-success", QC.maxSuccess), ("--qc-max-size", QC.maxSize), ("--qc-max-discard", QC.maxDiscardRatio)] + spec :: Spec spec = do - describe "hspec" $ do it "runs a spec" $ do silence . H.hspec $ do @@ -60,10 +59,16 @@ H.it "example 2" False H.describe "baz" $ do H.it "example 3" False - getEnv "HSPEC_FAILURES" `shouldReturn` Just ("FailureReport {" - ++ "failureReportSeed = 23, " - ++ "failureReportMaxSuccess = 100, " - ++ "failureReportPaths = [([\"foo\",\"bar\"],\"example 2\"),([\"baz\"],\"example 3\")]}") + getEnv "HSPEC_FAILURES" `shouldReturn` (Just . show) FailureReport { + failureReportSeed = 23 + , failureReportMaxSuccess = 100 + , failureReportMaxSize = 100 + , failureReportMaxDiscardRatio = 10 + , failureReportPaths = [ + (["foo", "bar"], "example 2") + , (["baz"], "example 3") + ] + } describe "with --rerun" $ do let runSpec = (captureLines . ignoreExitCode . H.hspec) $ do @@ -96,15 +101,10 @@ , "26" ] - it "reuses same --qc-max-success" $ do - silence . ignoreExitCode . withArgs ["--qc-max-success", "23"] . H.hspec $ do - H.it "foo" False - - m <- newMock - silence . withArgs ["--rerun"] . H.hspec $ do - H.it "foo" $ property $ do - mockAction m - mockCounter m `shouldReturn` 23 + forM_ quickCheckOptions $ \(flag, accessor) -> do + it ("reuses same " ++ flag) $ do + [flag, "23"] `shouldUseArgs` ((== 23) . accessor) + ["--rerun"] `shouldUseArgs` ((== 23) . accessor) context "when there is no failure report in the environment" $ do it "runs everything" $ do @@ -125,8 +125,8 @@ it "prints a warning to stderr" $ do setEnv "HSPEC_FAILURES" "some invalid report" - r <- hCapture [stderr] $ withArgs ["-r"] runSpec - fst r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n" + r <- hCapture_ [stderr] $ withArgs ["-r"] runSpec + r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n" it "does not leak command-line flags to examples" $ do @@ -281,20 +281,16 @@ context "when run with --rerun" $ do it "takes precedence" $ do - silence . ignoreExitCode . withArgs ["--qc-max-success", "23"] . H.hspec $ do - H.it "foo" False + ["--qc-max-success", "23"] `shouldUseArgs` ((== 23) . QC.maxSuccess) + ["--rerun", "--qc-max-success", "42"] `shouldUseArgs` ((== 42) . QC.maxSuccess) - m <- newMock - silence . withArgs ["--rerun", "--qc-max-success", "42"] . H.hspec $ do - H.it "foo" $ property $ do - mockAction m - mockCounter m `shouldReturn` 42 + context "with --qc-max-size" $ do + it "passes specified size to QuickCheck properties" $ do + ["--qc-max-size", "23"] `shouldUseArgs` ((== 23) . QC.maxSize) - context "when given an invalid argument" $ do - it "prints an error message to stderr" $ do - r <- hCapture_ [stderr] . ignoreExitCode . withArgs ["--qc-max-success", "foo"] . H.hspec $ do - H.it "foo" True - r `shouldContain` "invalid argument `foo' for `--qc-max-success'" + context "with --qc-max-discard" $ do + it "uses specified discard ratio to QuickCheck properties" $ do + ["--qc-max-discard", "23"] `shouldUseArgs` ((== 23) . QC.maxDiscardRatio) context "with --seed" $ do it "uses specified seed" $ do diff --git a/test/Test/HspecSpec.hs b/test/Test/HspecSpec.hs --- a/test/Test/HspecSpec.hs +++ b/test/Test/HspecSpec.hs @@ -1,11 +1,13 @@ module Test.HspecSpec (main, spec) where import Helper +import Mock import Data.List (isPrefixOf) import Test.Hspec.Core (SpecTree(..), Result(..), runSpecM) import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H (hspecResult) + main :: IO () main = hspec spec @@ -82,6 +84,15 @@ H.describe "bar" $ do H.it "baz" True isParallelizable `shouldBe` True + + describe "before" $ do + it "runs an action before each spec item" $ do + mock <- newMock + silence $ H.hspec $ H.before (mockAction mock) $ do + H.it "foo" $ do + mockCounter mock `shouldReturn` 1 + H.it "bar" $ do + mockCounter mock `shouldReturn` 2 where runSpec :: H.Spec -> IO [String] runSpec = captureLines . H.hspecResult