diff --git a/example/Spec.hs b/example/Spec.hs --- a/example/Spec.hs +++ b/example/Spec.hs @@ -13,4 +13,4 @@ reverse [1 :: Int, 2, 3] `shouldBe` [3, 2, 1] it "gives the original list, if applied twice" $ property $ - \xs -> reverse (reverse xs) == (xs :: [Int]) + \xs -> (reverse . reverse) xs == (xs :: [Int]) diff --git a/hspec.cabal b/hspec.cabal --- a/hspec.cabal +++ b/hspec.cabal @@ -1,5 +1,5 @@ name: hspec -version: 1.4.1.1 +version: 1.4.2 license: BSD3 license-file: LICENSE copyright: (c) 2011-2012 Trystan Spangler, (c) 2011-2012 Simon Hengel, (c) 2011 Greg Weber @@ -10,8 +10,8 @@ stability: experimental bug-reports: https://github.com/hspec/hspec/issues homepage: http://hspec.github.com/ -synopsis: Behavior Driven Development for Haskell -description: Behavior Driven Development for Haskell +synopsis: Behavior-Driven Development for Haskell +description: Behavior-Driven Development for Haskell . Hspec is roughly based on the Ruby library RSpec. However, Hspec is just a framework for running HUnit and QuickCheck @@ -38,7 +38,7 @@ , transformers >= 0.2.2.0 && < 0.4.0 , HUnit >= 1.2.5 , QuickCheck >= 2.4.0.1 && < 2.6 - , hspec-expectations == 0.3.0.* + , hspec-expectations exposed-modules: Test.Hspec Test.Hspec.Core 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 @@ -66,14 +66,20 @@ p = maybe p1 (\p0 path -> p0 path || p1 path) mp mp = configFilterPredicate c +setQC_MaxSuccess :: String -> Result -> Result +setQC_MaxSuccess n x = (mapParams $ \p -> p {paramsQuickCheckArgs = (paramsQuickCheckArgs p) {QC.maxSuccess = read n}}) <$> x + where + mapParams :: (Params -> Params) -> Config -> Config + mapParams f c = c {configParams = f (configParams c)} + 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 evaluating examples" + , 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 `always' or can be `never' or `auto'." + , Option [] ["color"] (OptArg setColor "WHEN") "colorize the output. WHEN defaults to\n`always' or can be `never' or `auto'." , Option "f" ["format"] (ReqArg setFormatter "FORMATTER") formatHelp - , Option "a" ["maximum-generated-tests"] (ReqArg setQC_MaxSuccess "NUMBER") "how many automated tests something like QuickCheck should try, by default" + , 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" ] where @@ -87,16 +93,10 @@ Nothing -> Left (InvalidArgument "format" name) Just f -> return c {configFormatter = f} - setQC_MaxSuccess :: String -> Result -> Result - setQC_MaxSuccess n x = (mapParams $ \p -> p {paramsQuickCheckArgs = (paramsQuickCheckArgs p) {QC.maxSuccess = read n}}) <$> x - - mapParams :: (Params -> Params) -> Config -> Config - mapParams f c = c {configParams = f (configParams c)} - setColor mValue x = x >>= \c -> parseColor mValue >>= \v -> return c {configColorMode = v} where parseColor s = case s of - Nothing -> return ColorAuto + Nothing -> return ColorAlway Just "auto" -> return ColorAuto Just "never" -> return ColorNever Just "always" -> return ColorAlway @@ -105,6 +105,9 @@ undocumentedOptions :: [OptDescr (Result -> Result)] undocumentedOptions = [ 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" -- 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 @@ -17,6 +17,7 @@ import qualified Control.Exception as E import Control.Applicative +import Control.Monad (when) import Control.Monad.Trans.Writer (Writer, execWriter, tell) import Test.Hspec.Util @@ -73,14 +74,22 @@ evaluateExample _ action = (action >> return Success) `E.catch` \(HUnitFailure err) -> return (Fail err) instance Example Result where - evaluateExample _ r = r `seq` return r + evaluateExample _ r = return r instance Example QC.Property where evaluateExample c p = do r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) p + when (isUserInterrupt r) $ do + E.throwIO E.UserInterrupt + return $ case r of QC.Success {} -> Success f@(QC.Failure {}) -> Fail (QC.output f) QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ quantify n "test" ) QC.NoExpectedFailure {} -> Fail ("No expected failure") + where + isUserInterrupt :: QC.Result -> Bool + isUserInterrupt r = case r of + QC.Failure {QC.reason = "Exception: 'user interrupt'"} -> True + _ -> False diff --git a/src/Test/Hspec/HUnit.hs b/src/Test/Hspec/HUnit.hs --- a/src/Test/Hspec/HUnit.hs +++ b/src/Test/Hspec/HUnit.hs @@ -32,8 +32,8 @@ where go :: Test -> SpecTree go t_ = case t_ of - TestLabel s (TestCase e) -> SpecItem s (`evaluateExample` e) - TestLabel s (TestList xs) -> SpecGroup s (map go xs) - TestLabel s x -> SpecGroup s [go x] - TestList xs -> SpecGroup "" (map go xs) - TestCase e -> SpecItem "" (`evaluateExample` e) + TestLabel s (TestCase e) -> it s e + TestLabel s (TestList xs) -> describe s (map go xs) + TestLabel s x -> describe s [go x] + TestList xs -> describe "" (map go xs) + TestCase e -> it "" e 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 @@ -32,7 +32,7 @@ quantify n s = show n ++ " " ++ s ++ "s" safeEvaluate :: IO a -> IO (Either E.SomeException a) -safeEvaluate action = (Right <$> action) `E.catches` [ +safeEvaluate 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