hspec 1.9.5 → 1.10.0
raw patch · 17 files changed
+107/−227 lines, 17 filesdep +asyncPVP ok
version bump matches the API change (PVP)
Dependencies added: async
API changes (from Hackage documentation)
- Test.Hspec.Core: hHspec :: Handle -> [SpecTree] -> IO Summary
- Test.Hspec.Core: hspec :: [SpecTree] -> IO ()
- Test.Hspec.Core: hspecB :: [SpecTree] -> IO Bool
- Test.Hspec.Core: hspecX :: [SpecTree] -> IO ()
- Test.Hspec.Core: itemRequirement :: Item -> String
- Test.Hspec.Core: paramsReportProgress :: Params -> Progress -> IO ()
- Test.Hspec.Core: type Specs = [SpecTree]
- Test.Hspec.HUnit: instance Example Test
- Test.Hspec.Monadic: Summary :: Int -> Int -> Summary
- Test.Hspec.Monadic: class Example a
- Test.Hspec.Monadic: context :: String -> Spec -> Spec
- Test.Hspec.Monadic: data Summary
- Test.Hspec.Monadic: describe :: String -> Spec -> Spec
- Test.Hspec.Monadic: descriptions :: [Spec] -> Spec
- Test.Hspec.Monadic: fromSpecList :: [SpecTree] -> Spec
- Test.Hspec.Monadic: hHspec :: Handle -> Spec -> IO Summary
- Test.Hspec.Monadic: hspec :: Spec -> IO ()
- Test.Hspec.Monadic: hspecB :: Spec -> IO Bool
- Test.Hspec.Monadic: hspecX :: Spec -> IO ()
- Test.Hspec.Monadic: it :: Example a => String -> a -> Spec
- Test.Hspec.Monadic: pending :: Expectation
- Test.Hspec.Monadic: runSpecM :: Spec -> [SpecTree]
- Test.Hspec.Monadic: summaryExamples :: Summary -> Int
- Test.Hspec.Monadic: summaryFailures :: Summary -> Int
- Test.Hspec.Monadic: type Spec = SpecM ()
- Test.Hspec.Monadic: type Specs = Spec
- Test.Hspec.QuickCheck: property :: Testable prop => prop -> Property
+ Test.Hspec.Core: type ProgressCallback = Progress -> IO ()
- Test.Hspec.Core: Item :: Bool -> String -> (Params -> (IO () -> IO ()) -> IO Result) -> Item
+ Test.Hspec.Core: Item :: Bool -> (Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result) -> Item
- Test.Hspec.Core: Params :: Args -> Int -> (Progress -> IO ()) -> Params
+ Test.Hspec.Core: Params :: Args -> Int -> Params
- Test.Hspec.Core: SpecItem :: Item -> SpecTree
+ Test.Hspec.Core: SpecItem :: String -> Item -> SpecTree
- Test.Hspec.Core: evaluateExample :: Example a => a -> Params -> (IO () -> IO ()) -> IO Result
+ Test.Hspec.Core: evaluateExample :: Example a => a -> Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result
- Test.Hspec.Core: itemExample :: Item -> Params -> (IO () -> IO ()) -> IO Result
+ Test.Hspec.Core: itemExample :: Item -> Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result
Files
- hspec.cabal +3/−2
- src/Test/Hspec/Config.hs +15/−1
- src/Test/Hspec/Core.hs +1/−34
- src/Test/Hspec/Core/QuickCheckUtil.hs +0/−10
- src/Test/Hspec/Core/Type.hs +15/−19
- src/Test/Hspec/HUnit.hs +1/−17
- src/Test/Hspec/Monadic.hs +0/−53
- src/Test/Hspec/QuickCheck.hs +1/−7
- src/Test/Hspec/Runner.hs +2/−2
- src/Test/Hspec/Runner/Eval.hs +10/−9
- src/Test/Hspec/Util.hs +3/−10
- test/Helper.hs +8/−4
- test/Test/Hspec/Core/TypeSpec.hs +2/−7
- test/Test/Hspec/HUnitSpec.hs +2/−32
- test/Test/Hspec/RunnerSpec.hs +25/−9
- test/Test/Hspec/UtilSpec.hs +10/−2
- test/Test/HspecSpec.hs +9/−9
hspec.cabal view
@@ -1,5 +1,5 @@ name: hspec-version: 1.9.5+version: 1.10.0 license: MIT license-file: LICENSE copyright: (c) 2011-2014 Simon Hengel,@@ -53,10 +53,10 @@ , QuickCheck >= 2.5.1 , quickcheck-io , hspec-expectations == 0.5.0.*+ , async >= 2 exposed-modules: Test.Hspec Test.Hspec.Core- Test.Hspec.Monadic Test.Hspec.Runner Test.Hspec.Formatters Test.Hspec.HUnit@@ -111,6 +111,7 @@ , QuickCheck , quickcheck-io , hspec-expectations+ , async , hspec-meta >= 1.9.1 , process
src/Test/Hspec/Config.hs view
@@ -40,7 +40,21 @@ } defaultConfig :: Config-defaultConfig = Config False False False Nothing Nothing Nothing Nothing Nothing 5 ColorAuto specdoc False (Left stdout)+defaultConfig = Config {+ configDryRun = False+, configPrintCpuTime = False+, configFastFail = False+, configFilterPredicate = Nothing+, configQuickCheckSeed = Nothing+, configQuickCheckMaxSuccess = Nothing+, configQuickCheckMaxDiscardRatio = Nothing+, configQuickCheckMaxSize = Nothing+, configSmallCheckDepth = 5+, configColorMode = ColorAuto+, configFormatter = specdoc+, configHtmlOutput = False+, configHandle = Left stdout+} -- | Add a filter predicate to config. If there is already a filter predicate, -- then combine them with `||`.
src/Test/Hspec/Core.hs view
@@ -9,6 +9,7 @@ Example (..) , Params (..) , Progress+, ProgressCallback , Result (..) -- * A writer monad for constructing specs@@ -23,43 +24,9 @@ , modifyParams , describe , it---- * Deprecated types and functions-, Specs-, hspecB-, hspecX-, hHspec-, hspec ) where -import Control.Applicative-import System.IO (Handle)- import Test.Hspec.Core.Type-import qualified Test.Hspec.Runner as Runner-import Test.Hspec.Runner (Summary(..), Config(..), defaultConfig) -hspecWith :: Config -> [SpecTree] -> IO Summary-hspecWith c = Runner.hspecWith c . fromSpecList- modifyParams :: (Params -> Params) -> Spec -> Spec modifyParams f = mapSpecItem $ \item -> item {itemExample = \p -> (itemExample item) (f p)}--{-# DEPRECATED hspecX "use `Test.Hspec.Runner.hspec` instead" #-} -- since 1.2.0-hspecX :: [SpecTree] -> IO ()-hspecX = hspec--{-# DEPRECATED hspec "use `Test.Hspec.Runner.hspec` instead" #-} -- since 1.4.0-hspec :: [SpecTree] -> IO ()-hspec = Runner.hspec . fromSpecList--{-# DEPRECATED hspecB "use `Test.Hspec.Runner.hspecWith` instead" #-} -- since 1.4.0-hspecB :: [SpecTree] -> IO Bool-hspecB spec = (== 0) . summaryFailures <$> hspecWith defaultConfig spec--{-# DEPRECATED hHspec "use `Test.Hspec.Runner.hspecWith` instead" #-} -- since 1.4.0-hHspec :: Handle -> [SpecTree] -> IO Summary-hHspec h = hspecWith defaultConfig {configHandle = Left h}--{-# DEPRECATED Specs "use `[SpecTree]` instead" #-} -- since 1.4.0-type Specs = [SpecTree]
src/Test/Hspec/Core/QuickCheckUtil.hs view
@@ -12,7 +12,6 @@ #if MIN_VERSION_QuickCheck(2,7,0)-import Control.Exception import Test.QuickCheck.Random #endif @@ -32,15 +31,6 @@ ref <- newIORef (return QCP.succeeded) action (reduceRose r >>= writeIORef ref) readIORef ref--isUserInterrupt :: QC.Result -> Bool-isUserInterrupt r = case r of-#if MIN_VERSION_QuickCheck(2,7,0)- QC.Failure {theException = me} -> (me >>= fromException) == Just UserInterrupt-#else- QC.Failure {QC.reason = "Exception: 'user interrupt'"} -> True-#endif- _ -> False formatNumbers :: Result -> String formatNumbers r = "(after " ++ pluralize (numTests r) "test" ++ shrinks ++ ")"
src/Test/Hspec/Core/Type.hs view
@@ -11,6 +11,7 @@ , Result (..) , Params (..) , Progress+, ProgressCallback , describe , it@@ -22,7 +23,6 @@ import qualified Control.Exception as E import Control.Applicative-import Control.Monad (when) import Control.Monad.Trans.Writer (Writer, execWriter, tell) import Data.Typeable (Typeable) import Data.List (isPrefixOf)@@ -67,22 +67,21 @@ instance E.Exception Result type Progress = (Int, Int)+type ProgressCallback = Progress -> IO () data Params = Params { paramsQuickCheckArgs :: QC.Args , paramsSmallCheckDepth :: Int-, paramsReportProgress :: Progress -> IO ()-}+} deriving (Show) -- | Internal representation of a spec. data SpecTree = SpecGroup String [SpecTree]- | SpecItem Item+ | SpecItem String Item data Item = Item { itemIsParallelizable :: Bool-, itemRequirement :: String-, itemExample :: Params -> (IO () -> IO ()) -> IO Result+, itemExample :: Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result } mapSpecItem :: (Item -> Item) -> Spec -> Spec@@ -90,7 +89,7 @@ where go :: SpecTree -> SpecTree go spec = case spec of- SpecItem item -> SpecItem (f item)+ SpecItem r item -> SpecItem r (f item) SpecGroup d es -> SpecGroup d (map go es) -- | The @describe@ function combines a list of specs into a larger spec.@@ -103,7 +102,7 @@ -- | Create a spec item. it :: Example a => String -> a -> SpecTree-it s e = SpecItem $ Item False msg (evaluateExample e)+it s e = SpecItem msg $ Item False (evaluateExample e) where msg | null s = "(unspecified behavior)"@@ -111,26 +110,23 @@ -- | A type class for examples. class Example a where- evaluateExample :: a -> Params -> (IO () -> IO ()) -> IO Result+ evaluateExample :: a -> Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result instance Example Bool where- evaluateExample b _ _ = if b then return Success else return (Fail "")+ evaluateExample b _ _ _ = if b then return Success else return (Fail "") instance Example Expectation where- evaluateExample e _ action = (action e >> return Success) `E.catches` [+ evaluateExample e _ action _ = (action e >> return Success) `E.catches` [ E.Handler (\(HUnitFailure err) -> return (Fail err)) , E.Handler (return :: Result -> IO Result) ] instance Example Result where- evaluateExample r _ _ = return r+ evaluateExample r _ _ _ = return r instance Example QC.Property where- evaluateExample p c action = do- r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback progressCallback $ aroundProperty action p)- when (isUserInterrupt r) $ do- E.throwIO E.UserInterrupt-+ evaluateExample p c action progressCallback = do+ r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty action p) return $ case r of QC.Success {} -> Success@@ -138,8 +134,8 @@ 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)+ qcProgressCallback = QCP.PostTest QCP.NotCounterexample $+ \st _ -> progressCallback (QC.numSuccessTests st, QC.maxSuccessTests st) sanitizeFailureMessage :: QC.Result -> String sanitizeFailureMessage r = let m = QC.output r in strip $
src/Test/Hspec/HUnit.hs view
@@ -1,26 +1,10 @@-{-# OPTIONS -fno-warn-orphans #-} module Test.Hspec.HUnit ( -- * Interoperability with HUnit fromHUnitTest ) where -import Data.List (intercalate)-import qualified Test.HUnit as HU-import Test.HUnit (Test (..))- import Test.Hspec.Core.Type---- | This instance is deprecated, use `Test.Hspec.HUnit.fromHUnitTest` instead!-instance Example Test where- evaluateExample test _ _ = do- (counts, fails) <- HU.runTestText HU.putTextToShowS test- let r = if HU.errors counts + HU.failures counts == 0- then Success- else Fail (details $ fails "")- return r- where- details :: String -> String- details = intercalate "\n" . tail . init . lines+import Test.HUnit (Test (..)) -- | -- Convert a HUnit test suite to a spec. This can be used to run existing
− src/Test/Hspec/Monadic.hs
@@ -1,53 +0,0 @@-{-# OPTIONS_HADDOCK not-home #-}-module Test.Hspec.Monadic {-# DEPRECATED "use \"Test.Hspec\", \"Test.Hspec.Runner\" or \"Test.Hspec.Core\" instead" #-} (--- * Types- Spec-, Example---- * Defining a spec-, describe-, context-, it-, pending---- * Running a spec-, hspec-, Summary (..)---- * Interface to the non-monadic API-, runSpecM-, fromSpecList---- * Deprecated types and functions-, Specs-, descriptions-, hspecB-, hspecX-, hHspec-) where--import System.IO-import Control.Applicative--import Test.Hspec.Core (runSpecM, fromSpecList)-import Test.Hspec.Runner-import Test.Hspec--{-# DEPRECATED Specs "use `Spec` instead" #-} -- since 1.2.0-type Specs = Spec--{-# DEPRECATED descriptions "use `sequence_` instead" #-} -- since 1.0.0-descriptions :: [Spec] -> Spec-descriptions = sequence_--{-# DEPRECATED hspecX "use `hspec` instead" #-} -- since 1.2.0-hspecX :: Spec -> IO ()-hspecX = hspec--{-# DEPRECATED hspecB "use `hspecWith` instead" #-} -- since 1.4.0-hspecB :: Spec -> IO Bool-hspecB spec = (== 0) . summaryFailures <$> hspecWith defaultConfig spec--{-# DEPRECATED hHspec "use hspecWith instead" #-} -- since 1.4.0-hHspec :: Handle -> Spec -> IO Summary-hHspec h = hspecWith defaultConfig {configHandle = Left h}
src/Test/Hspec/QuickCheck.hs view
@@ -5,13 +5,7 @@ modifyMaxSuccess , modifyMaxDiscardRatio , modifyMaxSize--- * Re-exports from QuickCheck--- |--- Previous versions of Hspec provided a distinct `property` combinator, but--- it's now possible to use QuickCheck's `property` instead. For backward--- compatibility we now re-export QuickCheck's `property`, but it is advisable--- to import it from "Test.QuickCheck" instead.-, property+ -- * Shortcuts , prop ) where
src/Test/Hspec/Runner.hs view
@@ -54,8 +54,8 @@ goSpec :: [String] -> SpecTree -> Maybe SpecTree goSpec groups spec = case spec of- SpecItem item -> guard (p (groups, itemRequirement item)) >> return spec- SpecGroup group specs -> case goSpecs (groups ++ [group]) specs of+ SpecItem requirement _ -> guard (p (groups, requirement)) >> return spec+ SpecGroup group specs -> case goSpecs (groups ++ [group]) specs of [] -> Nothing xs -> Just (SpecGroup group xs)
src/Test/Hspec/Runner/Eval.hs view
@@ -25,7 +25,7 @@ toTree :: SpecTree -> Tree Item toTree spec = case spec of SpecGroup label specs -> Node label (map toTree specs)- SpecItem item -> Leaf (itemRequirement item) item+ SpecItem r item -> Leaf r item type EvalTree = Tree (ProgressCallback -> FormatResult -> IO (FormatM ())) @@ -42,16 +42,18 @@ | useColor = every 0.05 $ exampleProgress formatter h | otherwise = return $ \_ _ -> return () - specs = map (fmap (parallelize . fmap (applyNoOpAround . applyQuickCheckArgs) . unwrapItem) . toTree) specs_+ specs = map (fmap (parallelize . fmap (applyNoOpAround . applyParams) . unwrapItem) . toTree) specs_ - unwrapItem :: Item -> (Bool, Params -> (IO () -> IO ()) -> IO Result)- unwrapItem (Item isParallelizable _ e) = (isParallelizable, e)+ unwrapItem :: Item -> (Bool, Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result)+ unwrapItem (Item isParallelizable e) = (isParallelizable, e) - applyQuickCheckArgs :: (Params -> a) -> ProgressCallback -> a- applyQuickCheckArgs e progressCallback = e $ Params (configQuickCheckArgs c) (configSmallCheckDepth c) progressCallback+ applyParams :: (Params -> a) -> a+ applyParams = ($ params)+ where+ params = Params (configQuickCheckArgs c) (configSmallCheckDepth c) - applyNoOpAround :: (a -> (IO () -> IO ()) -> b) -> a -> b- applyNoOpAround = fmap ($ id)+ applyNoOpAround :: ((IO () -> IO ()) -> b) -> b+ applyNoOpAround = ($ id) -- | Execute given action at most every specified number of seconds. every :: POSIXTime -> (a -> b -> IO ()) -> IO (a -> b -> IO ())@@ -61,7 +63,6 @@ r <- timer when r (action a b) -type ProgressCallback = Progress -> IO () type FormatResult = Either E.SomeException Result -> FormatM () parallelize :: (Bool, ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())
src/Test/Hspec/Util.hs view
@@ -11,11 +11,12 @@ import Data.List import Data.Char (isSpace)-import Control.Applicative import qualified Control.Exception as E+import Control.Concurrent.Async import Test.Hspec.Compat (showType) + -- | Create a more readable display of a quantity of something. -- -- Examples:@@ -44,15 +45,7 @@ formatException (E.SomeException e) = showType e ++ " (" ++ show e ++ ")" safeTry :: IO a -> IO (Either E.SomeException a)-safeTry 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- -- normal operation.- E.Handler $ \e -> E.throwIO (e :: E.AsyncException)-- , E.Handler $ \e -> (return . Left) (e :: E.SomeException)- ]+safeTry action = withAsync (action >>= E.evaluate) waitCatch -- | -- A tuple that represents the location of an example within a spec.
test/Helper.hs view
@@ -6,6 +6,7 @@ , sleep , timeout , defaultParams+, noOpProgressCallback , captureLines , normalizeSummary @@ -35,7 +36,7 @@ import Test.QuickCheck hiding (Result(..)) import qualified Test.Hspec as H-import qualified Test.Hspec.Core as H (Params(..), Item(..), mapSpecItem)+import qualified Test.Hspec.Core as H (Params(..), Item(..), ProgressCallback, mapSpecItem) import qualified Test.Hspec.Runner as H import Test.Hspec.Core.QuickCheckUtil (mkGen) @@ -43,7 +44,7 @@ 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)+ignoreUserInterrupt action = E.catchJust (guard . (== E.UserInterrupt)) action return captureLines :: IO a -> IO [String] captureLines = fmap lines . capture_@@ -64,8 +65,11 @@ | otherwise = x defaultParams :: H.Params-defaultParams = H.Params stdArgs {replay = Just (mkGen 23, 0)} (H.configSmallCheckDepth H.defaultConfig) (const $ return ())+defaultParams = H.Params stdArgs {replay = Just (mkGen 23, 0)} (H.configSmallCheckDepth H.defaultConfig) +noOpProgressCallback :: H.ProgressCallback+noOpProgressCallback _ = return ()+ sleep :: POSIXTime -> IO () sleep = threadDelay . floor . (* 1000000) @@ -75,7 +79,7 @@ shouldUseArgs :: [String] -> (Args -> Bool) -> Expectation shouldUseArgs args p = do spy <- newIORef (H.paramsQuickCheckArgs defaultParams)- let interceptArgs item = item {H.itemExample = \params action -> writeIORef spy (H.paramsQuickCheckArgs params) >> H.itemExample item params action}+ let interceptArgs item = item {H.itemExample = \params action progressCallback -> writeIORef spy (H.paramsQuickCheckArgs params) >> H.itemExample item params action progressCallback} spec = H.mapSpecItem interceptArgs $ H.it "foo" False (silence . ignoreExitCode . withArgs args . H.hspec) spec
test/Test/Hspec/Core/TypeSpec.hs view
@@ -5,7 +5,6 @@ import Mock import Data.List import Data.IORef-import Control.Exception (AsyncException(..), throwIO) import qualified Test.Hspec.Core.Type as H hiding (describe, it) import qualified Test.Hspec as H@@ -15,10 +14,10 @@ main = hspec spec evaluateExample :: H.Example e => e -> IO H.Result-evaluateExample e = H.evaluateExample e defaultParams id+evaluateExample e = H.evaluateExample e defaultParams id noOpProgressCallback evaluateExampleWith :: H.Example e => (IO () -> IO ()) -> e -> IO H.Result-evaluateExampleWith action e = H.evaluateExample e defaultParams action+evaluateExampleWith action e = H.evaluateExample e defaultParams action noOpProgressCallback spec :: Spec spec = do@@ -92,10 +91,6 @@ modifyIORef ref succ 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"
test/Test/Hspec/HUnitSpec.hs view
@@ -2,9 +2,7 @@ import Helper -import qualified Test.Hspec as H-import qualified Test.Hspec.Runner as H-import Test.Hspec.Core.Type (SpecTree(..), Item(..), runSpecM)+import Test.Hspec.Core.Type (SpecTree(..), runSpecM) import Test.Hspec.HUnit import Test.HUnit @@ -24,7 +22,7 @@ go :: SpecTree -> Tree go x = case x of SpecGroup s xs -> Group s (map go xs)- SpecItem item -> Example (itemRequirement item)+ SpecItem requirement _ -> Example requirement spec :: Spec spec = do@@ -49,31 +47,3 @@ it "works for a nested TestList" $ do (TestLabel "foo" . TestLabel "bar" . TestList) [TestLabel "one" e, TestLabel "two" e, TestLabel "three" e] `shouldYield` [Group "foo" [Group "bar" [Example "one", Example "two", Example "three"]]]-- describe "HUnit TestCase as an example (deprecated!)" $ do- it "is specified with the HUnit `TestCase` data constructor" $ TestCase $ do- silence . H.hspecResult $ do- H.it "some behavior" (TestCase $ "foo" @?= "bar")- H.it "some behavior" (TestCase $ "foo" @?= "foo")- `shouldReturn` H.Summary 2 1-- it "is the assumed example for IO() actions" $ do- silence . H.hspecResult $ do- H.it "some behavior" ("foo" @?= "bar")- H.it "some behavior" ("foo" @?= "foo")- `shouldReturn` H.Summary 2 1-- it "will show the failed assertion text if available (e.g. assertBool)" $ do- let assertionText = "some assertion text"- r <- captureLines . H.hspecResult $ do- H.describe "foo" $ do- H.it "bar" (assertFailure assertionText)- r `shouldSatisfy` any (== assertionText)-- it "will show the failed assertion expected and actual values if available (e.g. assertEqual)" $ do- r <- captureLines . H.hspecResult $ do- H.describe "foo" $ do- H.it "bar" (assertEqual "trivial" (1::Int) 2)- assertBool "should find assertion text" $ any (=="trivial") r- assertBool "should find 'expected: 1'" $ any (=="expected: 1") r- assertBool "should find ' but got: 2'" $ any (==" but got: 2") r
test/Test/Hspec/RunnerSpec.hs view
@@ -6,6 +6,7 @@ import Control.Monad import System.Environment (withArgs, withProgName, getArgs) import System.Exit+import Control.Concurrent import qualified Control.Exception as E import Mock import System.SetEnv@@ -143,11 +144,19 @@ context "when interrupted with ctrl-c" $ do it "prints summary immediately" $ do- r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec $ do- H.it "foo" False- H.it "bar" $ do- E.throwIO E.UserInterrupt :: IO ()- H.it "baz" True+ mvar <- newEmptyMVar+ sync <- newEmptyMVar+ threadId <- forkIO $ do+ r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec $ do+ H.it "foo" False+ H.it "bar" $ do+ putMVar sync ()+ threadDelay 1000000+ H.it "baz" True+ putMVar mvar r+ takeMVar sync+ throwTo threadId E.UserInterrupt+ r <- takeMVar mvar normalizeSummary r `shouldBe` [ "" , "- foo FAILED [1]"@@ -159,10 +168,17 @@ ] it "throws UserInterrupt" $ do- silence . H.hspec $ do- H.it "foo" $ do- E.throwIO E.UserInterrupt :: IO ()- `shouldThrow` (== E.UserInterrupt)+ mvar <- newEmptyMVar+ sync <- newEmptyMVar+ threadId <- forkIO $ do+ silence . H.hspec $ do+ H.it "foo" $ do+ putMVar sync ()+ threadDelay 1000000+ `E.catch` putMVar mvar+ takeMVar sync+ throwTo threadId E.UserInterrupt+ takeMVar mvar `shouldReturn` E.UserInterrupt context "with --help" $ do let printHelp = withProgName "spec" . withArgs ["--help"] . H.hspec $ pure ()
test/Test/Hspec/UtilSpec.hs view
@@ -1,6 +1,7 @@ module Test.Hspec.UtilSpec (main, spec) where import Helper+import Control.Concurrent import qualified Control.Exception as E import Test.Hspec.Util@@ -47,8 +48,15 @@ Left e <- safeTry (return undefined) show e `shouldBe` "Prelude.undefined" - it "re-throws AsyncException" $ do- safeTry (E.throwIO E.UserInterrupt :: IO Int) `shouldThrow` (== E.UserInterrupt)+ it "does not catch asynchronous exceptions" $ do+ mvar <- newEmptyMVar+ sync <- newEmptyMVar+ threadId <- forkIO $ do+ safeTry (putMVar sync () >> threadDelay 1000000) >> return ()+ `E.catch` putMVar mvar+ takeMVar sync+ throwTo threadId E.UserInterrupt+ readMVar mvar `shouldReturn` E.UserInterrupt describe "filterPredicate" $ do it "tries to match a pattern against a path" $ do
test/Test/HspecSpec.hs view
@@ -42,7 +42,7 @@ length r `shouldBe` 3 it "can be nested" $ do- let [SpecGroup foo [SpecGroup bar [SpecItem Item {itemRequirement = baz}]]] = runSpecM $ do+ let [SpecGroup foo [SpecGroup bar [SpecItem baz _]]] = runSpecM $ do H.describe "foo" $ do H.describe "bar" $ do H.it "baz" True@@ -55,17 +55,17 @@ describe "it" $ do it "takes a description of a desired behavior" $ do- let [SpecItem item] = runSpecM (H.it "whatever" True)- itemRequirement item `shouldBe` "whatever"+ let [SpecItem requirement _] = runSpecM (H.it "whatever" True)+ requirement `shouldBe` "whatever" it "takes an example of that behavior" $ do- let [SpecItem item] = runSpecM (H.it "whatever" True)- itemExample item defaultParams id `shouldReturn` Success+ let [SpecItem _ item] = runSpecM (H.it "whatever" True)+ itemExample item defaultParams id noOpProgressCallback `shouldReturn` Success context "when no description is given" $ do it "uses a default description" $ do- let [SpecItem item] = runSpecM (H.it "" True)- itemRequirement item `shouldBe` "(unspecified behavior)"+ let [SpecItem requirement _] = runSpecM (H.it "" True)+ requirement `shouldBe` "(unspecified behavior)" describe "example" $ do it "fixes the type of an expectation" $ do@@ -76,11 +76,11 @@ describe "parallel" $ do it "marks examples for parallel execution" $ do- let [SpecItem item] = runSpecM . H.parallel $ H.it "whatever" True+ let [SpecItem _ item] = runSpecM . H.parallel $ H.it "whatever" True itemIsParallelizable item `shouldBe` True it "is applied recursively" $ do- let [SpecGroup _ [SpecGroup _ [SpecItem item]]] = runSpecM . H.parallel $ do+ let [SpecGroup _ [SpecGroup _ [SpecItem _ item]]] = runSpecM . H.parallel $ do H.describe "foo" $ do H.describe "bar" $ do H.it "baz" True