diff --git a/hspec.cabal b/hspec.cabal --- a/hspec.cabal +++ b/hspec.cabal @@ -1,5 +1,5 @@ name: hspec -version: 1.9.1 +version: 1.9.2 license: MIT license-file: LICENSE copyright: (c) 2011-2014 Simon Hengel, @@ -109,7 +109,7 @@ , quickcheck-io , hspec-expectations - , hspec-meta >= 1.9.0 + , hspec-meta >= 1.9.1 , process , ghc-paths diff --git a/src/Test/Hspec/Core/QuickCheckUtil.hs b/src/Test/Hspec/Core/QuickCheckUtil.hs --- a/src/Test/Hspec/Core/QuickCheckUtil.hs +++ b/src/Test/Hspec/Core/QuickCheckUtil.hs @@ -18,6 +18,8 @@ import System.Random +import Test.Hspec.Util + aroundProperty :: (IO () -> IO ()) -> Property -> Property #if MIN_VERSION_QuickCheck(2,7,0) aroundProperty action (MkProperty p) = MkProperty $ MkProp . aroundRose action . unProp <$> p @@ -41,6 +43,13 @@ QC.Failure {QC.reason = "Exception: 'user interrupt'"} -> True #endif _ -> False + +formatNumbers :: Result -> String +formatNumbers r = "(after " ++ pluralize (numTests r) "test" ++ shrinks ++ ")" + where + shrinks + | 0 < numShrinks r = " and " ++ pluralize (numShrinks r) "shrink" + | otherwise = "" newSeed :: IO Int newSeed = fst . randomR (0, fromIntegral (maxBound :: Int32)) <$> 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,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-} +{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-} module Test.Hspec.Core.Type ( Spec , SpecM (..) @@ -134,15 +134,24 @@ return $ case r of QC.Success {} -> Success - QC.Failure {QC.output = m} -> fromMaybe (Fail $ sanitizeFailureMessage m) (parsePending m) + QC.Failure {QC.output = m} -> fromMaybe (Fail $ sanitizeFailureMessage r) (parsePending m) QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ pluralize n "test" ) QC.NoExpectedFailure {} -> Fail ("No expected failure") where progressCallback = QCP.PostTest QCP.NotCounterexample $ \st _ -> paramsReportProgress c (QC.numSuccessTests st, QC.maxSuccessTests st) - sanitizeFailureMessage :: String -> String - sanitizeFailureMessage = strip . addFalsifiable . stripFailed + sanitizeFailureMessage :: QC.Result -> String + sanitizeFailureMessage r = let m = QC.output r in strip $ +#if MIN_VERSION_QuickCheck(2,7,0) + case QC.theException r of + Just e -> let numbers = formatNumbers r in + "uncaught exception: " ++ formatException e ++ " " ++ numbers ++ "\n" ++ case lines m of + x:xs | x == (exceptionPrefix ++ show e ++ "' " ++ numbers ++ ": ") -> unlines xs + _ -> m + Nothing -> +#endif + (addFalsifiable . stripFailed) m addFalsifiable :: String -> String addFalsifiable m @@ -159,11 +168,12 @@ parsePending :: String -> Maybe Result parsePending m - | prefix `isPrefixOf` m = (readMaybe . takeWhile (/= '\'') . drop n) m + | exceptionPrefix `isPrefixOf` m = (readMaybe . takeWhile (/= '\'') . drop n) m | otherwise = Nothing where - n = length prefix - prefix = "*** Failed! Exception: '" + n = length exceptionPrefix + + exceptionPrefix = "*** Failed! Exception: '" -- | Specifies a pending example. -- 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 @@ -61,11 +61,9 @@ import Data.Maybe import Test.Hspec.Util -import Test.Hspec.Compat import Text.Printf import Control.Monad (unless, forM_) import Control.Applicative -import qualified Control.Exception as E import System.IO (hPutStr, hFlush) -- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make @@ -200,17 +198,6 @@ writeLine err where err = either (("uncaught exception: " ++) . formatException) id reason - --- | Convert an exception to a string. --- --- The type of the exception is included. Here is an example: --- --- >>> import Control.Applicative --- >>> import Control.Exception --- >>> either formatException show <$> (try . evaluate) (1 `div` 0) --- "ArithException (divide by zero)" -formatException :: E.SomeException -> String -formatException (E.SomeException e) = showType e ++ " (" ++ show e ++ ")" defaultFooter :: FormatM () defaultFooter = do 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,5 +1,6 @@ module Test.Hspec.Util ( pluralize +, formatException , lineBreaksAt , safeTry , Path @@ -13,6 +14,8 @@ import Control.Applicative import qualified Control.Exception as E +import Test.Hspec.Compat (showType) + -- | Create a more readable display of a quantity of something. -- -- Examples: @@ -28,6 +31,17 @@ pluralize :: Int -> String -> String pluralize 1 s = "1 " ++ s pluralize n s = show n ++ " " ++ s ++ "s" + +-- | Convert an exception to a string. +-- +-- The type of the exception is included. Here is an example: +-- +-- >>> import Control.Applicative +-- >>> import Control.Exception +-- >>> either formatException show <$> (try . evaluate) (1 `div` 0) +-- "ArithException (divide by zero)" +formatException :: E.SomeException -> String +formatException (E.SomeException e) = showType e ++ " (" ++ show e ++ ")" safeTry :: IO a -> IO (Either E.SomeException a) safeTry action = (Right <$> (action >>= E.evaluate)) `E.catches` [ diff --git a/test/Helper.hs b/test/Helper.hs --- a/test/Helper.hs +++ b/test/Helper.hs @@ -33,11 +33,11 @@ import Test.Hspec.Meta import Test.QuickCheck hiding (Result(..)) -import Test.QuickCheck.Random import qualified Test.Hspec as H import qualified Test.Hspec.Core as H (Params(..), Item(..), mapSpecItem) import qualified Test.Hspec.Runner as H +import Test.Hspec.Core.QuickCheckUtil (mkGen) ignoreExitCode :: IO () -> IO () ignoreExitCode action = action `E.catch` \e -> let _ = e :: ExitCode in return () @@ -64,7 +64,7 @@ | otherwise = x defaultParams :: H.Params -defaultParams = H.Params stdArgs {replay = Just (mkQCGen 23, 0)} (H.configSmallCheckDepth H.defaultConfig) (const $ return ()) +defaultParams = H.Params stdArgs {replay = Just (mkGen 23, 0)} (H.configSmallCheckDepth H.defaultConfig) (const $ return ()) sleep :: POSIXTime -> IO () sleep = threadDelay . floor . (* 1000000) diff --git a/test/Test/Hspec/Core/TypeSpec.hs b/test/Test/Hspec/Core/TypeSpec.hs --- a/test/Test/Hspec/Core/TypeSpec.hs +++ b/test/Test/Hspec/Core/TypeSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Test.Hspec.Core.TypeSpec (main, spec) where import Helper @@ -72,7 +73,11 @@ it "shows what falsified it" $ do H.Fail r <- evaluateExample $ property $ \x y -> x + y == (x * y :: Int) r `shouldBe` intercalate "\n" [ +#if MIN_VERSION_QuickCheck(2,7,0) "Falsifiable (after 2 tests and 2 shrinks): " +#else + "Falsifiable (after 1 test and 3 shrinks): " +#endif , "0" , "1" ] @@ -88,24 +93,35 @@ H.Success <- evaluateExampleWith action (property $ modifyIORef ref succ) readIORef ref `shouldReturn` 200 + it "propagates UserInterrupt" $ do + let p = property (throwIO UserInterrupt :: Expectation) + evaluateExample p `shouldThrow` (== UserInterrupt) + + it "pretty-prints exceptions" $ do + -- pendingWith "this probably needs a patch to QuickCheck" + evaluateExample (property $ (error "foobar" :: Int -> Bool)) `shouldReturn` (H.Fail . intercalate "\n") [ +#if MIN_VERSION_QuickCheck(2,7,0) + "uncaught exception: ErrorCall (foobar) (after 1 test)" +#else + "Exception: 'foobar' (after 1 test and 2 shrinks): " +#endif + , "0" + ] + context "when used with shouldBe" $ do it "shows what falsified it" $ do H.Fail r <- evaluateExample $ property $ \x y -> x + y `shouldBe` (x * y :: Int) r `shouldBe` intercalate "\n" [ +#if MIN_VERSION_QuickCheck(2,7,0) "Falsifiable (after 2 tests and 2 shrinks): " +#else + "Falsifiable (after 1 test and 3 shrinks): " +#endif , "expected: 0" , " but got: 1" , "0" , "1" ] - - it "propagates UserInterrupt" $ do - let p = property (throwIO UserInterrupt :: Expectation) - evaluateExample p `shouldThrow` (== UserInterrupt) - - it "propagates exceptions" $ do - pendingWith "this probably needs a patch to QuickCheck" - -- evaluateExample (property $ (error "foobar" :: Int -> Bool)) `shouldThrow` errorCall "foobar" context "when used with `pending`" $ do it "returns Pending" $ do 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 @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Test.Hspec.RunnerSpec (main, spec) where import Helper @@ -24,6 +25,22 @@ quickCheckOptions :: [([Char], Args -> Int)] quickCheckOptions = [("--qc-max-success", QC.maxSuccess), ("--qc-max-size", QC.maxSize), ("--qc-max-discard", QC.maxDiscardRatio)] +prop_foo :: Integer -> Bool +prop_foo = (/= 26) + +runPropFoo :: [String] -> IO String +runPropFoo args = fmap (unlines . normalizeSummary . lines) . capture_ . ignoreExitCode . withArgs args . H.hspec $ H.it "foo" $ property prop_foo + +prop_foo_result_with_seed_42 :: String +prop_foo_result_with_seed_42 = unlines [ +#if MIN_VERSION_QuickCheck(2,7,0) + "Falsifiable (after 31 tests): " +#else + "Falsifiable (after 30 tests): " +#endif + , "26" + ] + spec :: Spec spec = do describe "hspec" $ do @@ -86,18 +103,8 @@ r1 `shouldSatisfy` elem "3 examples, 3 failures" it "reuses the same seed" $ do - let runSpec_ = (captureLines . ignoreExitCode . H.hspec) $ do - H.it "foo" $ property $ (/= (26 :: Integer)) - r0 <- withArgs ["--seed", "42"] runSpec_ - r0 `shouldContain` [ - "Falsifiable (after 31 tests): " - , "26" - ] - r1 <- withArgs ["-r"] runSpec_ - r1 `shouldContain` [ - "Falsifiable (after 31 tests): " - , "26" - ] + r <- runPropFoo ["--seed", "42"] + runPropFoo ["-r"] `shouldReturn` r forM_ quickCheckOptions $ \(flag, accessor) -> do it ("reuses same " ++ flag) $ do @@ -292,27 +299,14 @@ context "with --seed" $ do it "uses specified seed" $ do - r <- captureLines . ignoreExitCode . withArgs ["--seed", "42"] . H.hspec $ do - H.it "foo" $ - property (/= (26 :: Integer)) - r `shouldContain` [ - "Falsifiable (after 31 tests): " - , "26" - ] + r <- runPropFoo ["--seed", "42"] + r `shouldContain` prop_foo_result_with_seed_42 context "when run with --rerun" $ 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 :: Integer) - r0 <- runSpec ["--seed", "23"] - r0 `shouldContain` "(after 27 tests)" - - r1 <- runSpec ["--seed", "42"] - r1 `shouldContain` "(after 31 tests)" - - r2 <- runSpec ["--rerun", "--seed", "23"] - r2 `shouldContain` "(after 27 tests)" + r <- runPropFoo ["--seed", "23"] + _ <- runPropFoo ["--seed", "42"] + runPropFoo ["--rerun", "--seed", "23"] `shouldReturn` r context "when given an invalid argument" $ do let run = withArgs ["--seed", "foo"] . H.hspec $ do