hspec 1.9.1 → 1.9.2
raw patch · 8 files changed
+92/−62 lines, 8 filesdep ~hspec-meta
Dependency ranges changed: hspec-meta
Files
- hspec.cabal +2/−2
- src/Test/Hspec/Core/QuickCheckUtil.hs +9/−0
- src/Test/Hspec/Core/Type.hs +17/−7
- src/Test/Hspec/Formatters.hs +0/−13
- src/Test/Hspec/Util.hs +14/−0
- test/Helper.hs +2/−2
- test/Test/Hspec/Core/TypeSpec.hs +24/−8
- test/Test/Hspec/RunnerSpec.hs +24/−30
hspec.cabal view
@@ -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
src/Test/Hspec/Core/QuickCheckUtil.hs view
@@ -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)) <$>
src/Test/Hspec/Core/Type.hs view
@@ -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. --
src/Test/Hspec/Formatters.hs view
@@ -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
src/Test/Hspec/Util.hs view
@@ -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` [
test/Helper.hs view
@@ -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)
test/Test/Hspec/Core/TypeSpec.hs view
@@ -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
test/Test/Hspec/RunnerSpec.hs view
@@ -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