packages feed

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 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