hspec-core 2.7.6 → 2.7.7
raw patch · 13 files changed
+290/−106 lines, 13 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Test.Hspec.Core.Hooks: aroundAll_ :: (IO () -> IO ()) -> SpecWith a -> SpecWith a
+ Test.Hspec.Core.Spec: filterForestWithLabels :: ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
+ Test.Hspec.Core.Spec: filterTreeWithLabels :: ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
+ Test.Hspec.Core.Spec: pruneForest :: [Tree c a] -> [Tree c a]
+ Test.Hspec.Core.Spec: pruneTree :: Tree c a -> Maybe (Tree c a)
+ Test.Hspec.Core.Spec: safeEvaluate :: IO Result -> IO Result
Files
- hspec-core.cabal +1/−1
- src/Test/Hspec/Core/Compat.hs +8/−0
- src/Test/Hspec/Core/Example.hs +13/−7
- src/Test/Hspec/Core/Format.hs +2/−1
- src/Test/Hspec/Core/Hooks.hs +36/−1
- src/Test/Hspec/Core/Runner.hs +32/−29
- src/Test/Hspec/Core/Runner/Eval.hs +24/−25
- src/Test/Hspec/Core/Spec/Monad.hs +5/−3
- src/Test/Hspec/Core/Tree.hs +34/−8
- test/Helper.hs +9/−3
- test/Test/Hspec/Core/HooksSpec.hs +111/−11
- test/Test/Hspec/Core/SpecSpec.hs +14/−16
- version.yaml +1/−1
hspec-core.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hspec-core-version: 2.7.6+version: 2.7.7 license: MIT license-file: LICENSE copyright: (c) 2011-2021 Simon Hengel,
src/Test/Hspec/Core/Compat.hs view
@@ -20,6 +20,8 @@ , atomicWriteIORef #endif , interruptible++, guarded ) where import Control.Applicative@@ -58,6 +60,9 @@ , sequence , sequence_ , sum+#if !MIN_VERSION_base(4,6,0)+ , catch+#endif ) import Data.Typeable (Typeable, typeOf, typeRepTyCon)@@ -139,3 +144,6 @@ MaskedInterruptible -> unsafeUnmask act MaskedUninterruptible -> act #endif++guarded :: Alternative m => (a -> Bool) -> a -> m a+guarded p a = if p a then pure a else empty
src/Test/Hspec/Core/Example.hs view
@@ -4,6 +4,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-}++-- NOTE: re-exported from Test.Hspec.Core.Spec module Test.Hspec.Core.Example ( Example (..) , Params (..)@@ -15,6 +17,7 @@ , ResultStatus (..) , Location (..) , FailureReason (..)+, safeEvaluate , safeEvaluateExample ) where @@ -88,13 +91,7 @@ instance Exception ResultStatus safeEvaluateExample :: Example e => e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result-safeEvaluateExample example params around progress = do- r <- safeTry $ forceResult <$> evaluateExample example params around progress- return $ case r of- Left e | Just result <- fromException e -> Result "" result- Left e | Just hunit <- fromException e -> Result "" $ hunitFailureToResult Nothing hunit- Left e -> Result "" $ Failure Nothing $ Error Nothing e- Right result -> result+safeEvaluateExample example params around progress = safeEvaluate $ forceResult <$> evaluateExample example params around progress where forceResult :: Result -> Result forceResult r@(Result info status) = info `deepseq` (forceResultStatus status) `seq` r@@ -104,6 +101,15 @@ Success -> r Pending _ m -> m `deepseq` r Failure _ m -> m `deepseq` r++safeEvaluate :: IO Result -> IO Result+safeEvaluate action = do+ r <- safeTry $ action+ return $ case r of+ Left e | Just result <- fromException e -> Result "" result+ Left e | Just hunit <- fromException e -> Result "" $ hunitFailureToResult Nothing hunit+ Left e -> Result "" $ Failure Nothing $ Error Nothing e+ Right result -> result instance Example Result where type Arg Result = ()
src/Test/Hspec/Core/Format.hs view
@@ -20,12 +20,13 @@ , itemDuration :: Seconds , itemInfo :: String , itemResult :: Result-}+} deriving Show data Result = Success | Pending (Maybe String) | Failure FailureReason+ deriving Show data Format m = Format { formatRun :: forall a. m a -> IO a
src/Test/Hspec/Core/Hooks.hs view
@@ -13,10 +13,15 @@ , around , around_ , aroundWith+, aroundAll_ ) where -import Control.Exception (SomeException, finally, throwIO, try)+import Prelude ()+import Test.Hspec.Core.Compat++import Control.Exception (SomeException, finally, throwIO, try, catch) import Control.Concurrent.MVar+import Control.Concurrent.Async import Test.Hspec.Core.Example import Test.Hspec.Core.Tree@@ -98,3 +103,33 @@ modifyAroundAction :: (ActionWith a -> ActionWith b) -> Item a -> Item b modifyAroundAction action item@Item{itemExample = e} = item{ itemExample = \params aroundAction -> e params (aroundAction . action) }++-- | Wrap an action around the given spec.+aroundAll_ :: (IO () -> IO ()) -> SpecWith a -> SpecWith a+aroundAll_ action spec = do+ startCleanup <- runIO newEmptyMVar+ workerRef <- runIO newEmptyMVar+ let+ acquire :: IO ()+ acquire = do+ acquireDone <- newEmptyMVar+ worker <- async $ do+ action $ do+ signal acquireDone+ waitFor startCleanup+ putMVar workerRef worker+ unwrapExceptionsFromLinkedThread $ do+ link worker+ waitFor acquireDone+ cleanup :: IO ()+ cleanup = signal startCleanup >> takeMVar workerRef >>= wait+ beforeAll_ acquire $ afterAll_ cleanup spec+ where+ signal :: MVar () -> IO ()+ signal = flip putMVar ()++ waitFor :: MVar () -> IO ()+ waitFor = takeMVar++ unwrapExceptionsFromLinkedThread :: IO a -> IO a+ unwrapExceptionsFromLinkedThread = (`catch` \ (ExceptionInLinkedThread _ e) -> throwIO e)
src/Test/Hspec/Core/Runner.hs view
@@ -28,6 +28,7 @@ #ifdef TEST , rerunAll+, specToEvalForest #endif ) where @@ -57,26 +58,19 @@ import Test.Hspec.Core.Runner.Eval -filterSpecs :: Config -> [EvalTree] -> [EvalTree]-filterSpecs c = go []+applyFilterPredicates :: Config -> [EvalTree] -> [EvalTree]+applyFilterPredicates c = filterForestWithLabels p where- p :: Path -> Bool- p path = (fromMaybe (const True) (configFilterPredicate c) path) &&- not (fromMaybe (const False) (configSkipPredicate c) path)-- go :: [String] -> [EvalTree] -> [EvalTree]- go groups = mapMaybe (goSpec groups)+ include :: Path -> Bool+ include = fromMaybe (const True) (configFilterPredicate c) - goSpecs :: [String] -> [EvalTree] -> ([EvalTree] -> b) -> Maybe b- goSpecs groups specs ctor = case go groups specs of- [] -> Nothing- xs -> Just (ctor xs)+ skip :: Path -> Bool+ skip = fromMaybe (const False) (configSkipPredicate c) - goSpec :: [String] -> EvalTree -> Maybe (EvalTree)- goSpec groups spec = case spec of- Leaf item -> guard (p (groups, evalItemDescription item)) >> return spec- Node group specs -> goSpecs (groups ++ [group]) specs (Node group)- NodeWithCleanup action specs -> goSpecs groups specs (NodeWithCleanup action)+ p :: [String] -> EvalItem -> Bool+ p groups item = include path && not (skip path)+ where+ path = (groups, evalItemDescription item) applyDryRun :: Config -> [EvalTree] -> [EvalTree] applyDryRun c@@ -203,6 +197,7 @@ runSpec_ :: Config -> Spec -> IO Summary runSpec_ config spec = do+ filteredSpec <- specToEvalForest config spec withHandle config $ \h -> do let formatter = fromMaybe specdoc (configFormatter config) seed = (fromJust . configQuickCheckSeed) config@@ -214,16 +209,7 @@ useColor <- doesUseColor h config - let- focusedSpec = focusSpec config (failFocusedItems config spec)- params = Params (configQuickCheckArgs config) (configSmallCheckDepth config)- randomize- | configRandomize config = randomizeForest seed- | otherwise = id-- filteredSpec <- randomize . filterSpecs config . applyDryRun config . toEvalForest params <$> runSpecM focusedSpec-- (total, failures) <- withHiddenCursor useColor h $ do+ results <- withHiddenCursor useColor h $ do let formatConfig = FormatConfig { formatConfigHandle = h@@ -240,8 +226,25 @@ } runFormatter evalConfig filteredSpec - dumpFailureReport config seed qcArgs failures- return (Summary total (length failures))+ let failures = filter resultItemIsFailure results++ dumpFailureReport config seed qcArgs (map fst failures)++ return Summary {+ summaryExamples = length results+ , summaryFailures = length failures+ }++specToEvalForest :: Config -> Spec -> IO [EvalTree]+specToEvalForest config spec = do+ let+ seed = (fromJust . configQuickCheckSeed) config+ focusedSpec = focusSpec config (failFocusedItems config spec)+ params = Params (configQuickCheckArgs config) (configSmallCheckDepth config)+ randomize+ | configRandomize config = randomizeForest seed+ | otherwise = id+ randomize . pruneForest . applyFilterPredicates config . applyDryRun config . toEvalForest params <$> runSpecM focusedSpec toEvalForest :: Params -> [SpecTree ()] -> [EvalTree] toEvalForest params = bimapForest withUnit toEvalItem . filterForest itemIsFocused
src/Test/Hspec/Core/Runner/Eval.hs view
@@ -14,6 +14,7 @@ , EvalTree , EvalItem(..) , runFormatter+, resultItemIsFailure #ifdef TEST , runSequentially #endif@@ -40,6 +41,7 @@ import qualified Test.Hspec.Core.Format as Format import Test.Hspec.Core.Clock import Test.Hspec.Core.Example.Location+import Test.Hspec.Core.Example (safeEvaluate) -- for compatibility with GHC < 7.10.1 type Monad m = (Functor m, Applicative m, M.Monad m)@@ -53,31 +55,20 @@ data State m = State { stateConfig :: EvalConfig m-, stateSuccessCount :: Int-, statePendingCount :: Int-, stateFailures :: [Path]+, stateResults :: [(Path, Format.Item)] } type EvalM m = StateT (State m) m -increaseSuccessCount :: Monad m => EvalM m ()-increaseSuccessCount = modify $ \state -> state {stateSuccessCount = stateSuccessCount state + 1}--increasePendingCount :: Monad m => EvalM m ()-increasePendingCount = modify $ \state -> state {statePendingCount = statePendingCount state + 1}--addFailure :: Monad m => Path -> EvalM m ()-addFailure path = modify $ \state -> state {stateFailures = path : stateFailures state}+addResult :: Monad m => Path -> Format.Item -> EvalM m ()+addResult path item = modify $ \ state -> state {stateResults = (path, item) : stateResults state} getFormat :: Monad m => (Format m -> a) -> EvalM m a getFormat format = gets (format . evalConfigFormat . stateConfig) reportItem :: Monad m => Path -> Format.Item -> EvalM m () reportItem path item = do- case Format.itemResult item of- Format.Success {} -> increaseSuccessCount- Format.Pending {} -> increasePendingCount- Format.Failure {} -> addFailure path+ addResult path item format <- getFormat formatItem lift (format path item) @@ -113,10 +104,10 @@ type EvalTree = Tree (IO ()) EvalItem runEvalM :: Monad m => EvalConfig m -> EvalM m () -> m (State m)-runEvalM config action = execStateT action (State config 0 0 [])+runEvalM config action = execStateT action (State config []) -- | Evaluate all examples of a given spec and produce a report.-runFormatter :: forall m. MonadIO m => EvalConfig m -> [EvalTree] -> IO (Int, [Path])+runFormatter :: forall m. MonadIO m => EvalConfig m -> [EvalTree] -> IO ([(Path, Format.Item)]) runFormatter config specs = do let start = parallelizeTree (evalConfigConcurrentJobs config) specs@@ -126,10 +117,7 @@ state <- formatRun format $ do runEvalM config $ run $ map (fmap (fmap (. reportProgress timer) . snd)) runningSpecs- let- failures = stateFailures state- total = stateSuccessCount state + statePendingCount state + length failures- return (total, reverse failures)+ return (reverse $ stateResults state) where format = evalConfigFormat config @@ -223,8 +211,10 @@ runCleanup :: [String] -> IO () -> EvalM m () runCleanup groups action = do- (dt, r) <- liftIO $ measure $ safeTry action- either (\ e -> reportItem path . failureItem (extractLocation e) dt "" . Error Nothing $ e) return r+ r <- liftIO $ measure $ safeEvaluate (action >> return (Result "" Success))+ case r of+ (_, Result "" Success) -> return ()+ _ -> reportResult path Nothing r where path = (groups, "afterAll-hook") @@ -260,9 +250,18 @@ sequenceActions :: Monad m => Bool -> [EvalM m ()] -> EvalM m () sequenceActions fastFail = go where+ go :: Monad m => [EvalM m ()] -> EvalM m () go [] = return () go (action : actions) = do- () <- action- hasFailures <- (not . null) <$> gets stateFailures+ action+ hasFailures <- any resultItemIsFailure <$> gets stateResults let stopNow = fastFail && hasFailures unless stopNow (go actions)++resultItemIsFailure :: (Path, Format.Item) -> Bool+resultItemIsFailure = isFailure . Format.itemResult . snd+ where+ isFailure r = case r of+ Format.Success{} -> False+ Format.Pending{} -> False+ Format.Failure{} -> True
src/Test/Hspec/Core/Spec/Monad.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- NOTE: re-exported from Test.Hspec.Core.Spec module Test.Hspec.Core.Spec.Monad ( Spec , SpecWith@@ -49,11 +51,11 @@ runIO :: IO r -> SpecM a r runIO = SpecM . liftIO -mapSpecTree :: (SpecTree a -> SpecTree b) -> SpecM a r -> SpecM b r-mapSpecTree f (SpecM specs) = SpecM (mapWriterT (fmap (second (map f))) specs)+mapSpecForest :: ([SpecTree a] -> [SpecTree b]) -> SpecM a r -> SpecM b r+mapSpecForest f (SpecM specs) = SpecM (mapWriterT (fmap (second f)) specs) mapSpecItem :: (ActionWith a -> ActionWith b) -> (Item a -> Item b) -> SpecWith a -> SpecWith b-mapSpecItem g f = mapSpecTree (bimapTree g f)+mapSpecItem g f = mapSpecForest (bimapForest g f) mapSpecItem_ :: (Item a -> Item a) -> SpecWith a -> SpecWith a mapSpecItem_ = mapSpecItem id
src/Test/Hspec/Core/Tree.hs view
@@ -4,8 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} --- |--- Stability: unstable+-- NOTE: re-exported from Test.Hspec.Core.Spec module Test.Hspec.Core.Tree ( SpecTree , Tree (..)@@ -16,6 +15,10 @@ , bimapForest , filterTree , filterForest+, filterTreeWithLabels+, filterForestWithLabels+, pruneTree+, pruneForest , location ) where @@ -49,14 +52,37 @@ NodeWithCleanup cleanup xs -> NodeWithCleanup (g cleanup) (map go xs) Leaf item -> Leaf (f item) +filterTree :: (a -> Bool) -> Tree c a -> Maybe (Tree c a)+filterTree = filterTreeWithLabels . const+ filterForest :: (a -> Bool) -> [Tree c a] -> [Tree c a]-filterForest = mapMaybe . filterTree+filterForest = filterForestWithLabels . const -filterTree :: (a -> Bool) -> Tree c a -> Maybe (Tree c a)-filterTree p t = case t of- Node s xs -> Just $ Node s (filterForest p xs)- NodeWithCleanup c xs -> Just $ NodeWithCleanup c (filterForest p xs)- leaf@(Leaf a) -> guard (p a) >> return leaf+filterTreeWithLabels :: ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)+filterTreeWithLabels = filterTree_ []++filterForestWithLabels :: ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]+filterForestWithLabels = filterForest_ []++filterForest_ :: [String] -> ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]+filterForest_ groups = mapMaybe . filterTree_ groups++filterTree_ :: [String] -> ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)+filterTree_ groups p tree = case tree of+ Node group xs -> Just $ Node group $ filterForest_ (groups ++ [group]) p xs+ NodeWithCleanup action xs -> Just $ NodeWithCleanup action $ filterForest_ groups p xs+ Leaf item -> Leaf <$> guarded (p groups) item++pruneForest :: [Tree c a] -> [Tree c a]+pruneForest = mapMaybe pruneTree++pruneTree :: Tree c a -> Maybe (Tree c a)+pruneTree node = case node of+ Node group xs -> Node group <$> prune xs+ NodeWithCleanup action xs -> NodeWithCleanup action <$> prune xs+ Leaf{} -> Just node+ where+ prune = guarded (not . null) . pruneForest -- | -- @Item@ is used to represent spec items internally. A spec item consists of:
test/Helper.hs view
@@ -41,14 +41,17 @@ import System.Directory import System.IO.Temp -import Test.Hspec.Meta hiding (hspec, hspecResult)+import Test.Hspec.Meta hiding (hspec, hspecResult, pending, pendingWith) import Test.QuickCheck hiding (Result(..))+import qualified Test.HUnit.Lang as HUnit import qualified Test.Hspec.Core.Spec as H import qualified Test.Hspec.Core.Runner as H import Test.Hspec.Core.QuickCheckUtil (mkGen) import Test.Hspec.Core.Clock-import Test.Hspec.Core.Example(Result(..), ResultStatus(..), FailureReason(..))+import Test.Hspec.Core.Example (Result(..), ResultStatus(..), FailureReason(..))+import Test.Hspec.Core.Util+import qualified Test.Hspec.Core.Format as Format #if !MIN_VERSION_base(4,7,0) deriving instance Eq ErrorCall@@ -58,11 +61,14 @@ exceptionEq a b | Just ea <- E.fromException a, Just eb <- E.fromException b = ea == (eb :: E.ErrorCall) | Just ea <- E.fromException a, Just eb <- E.fromException b = ea == (eb :: E.ArithException)- | otherwise = undefined+ | otherwise = throw (HUnit.HUnitFailure Nothing $ HUnit.ExpectedButGot Nothing (formatException b) (formatException a)) deriving instance Eq FailureReason deriving instance Eq ResultStatus deriving instance Eq Result++deriving instance Eq Format.Result+deriving instance Eq Format.Item instance Eq SomeException where (==) = exceptionEq
test/Test/Hspec/Core/HooksSpec.hs view
@@ -1,18 +1,41 @@ {-# LANGUAGE ScopedTypeVariables #-} module Test.Hspec.Core.HooksSpec (spec) where -import Control.Exception-import Helper import Prelude ()+import Helper+import Mock +import Control.Exception+ import qualified Test.Hspec.Core.Runner as H import qualified Test.Hspec.Core.Spec as H+import Test.Hspec.Core.Format+import Test.Hspec.Core.Runner.Eval import qualified Test.Hspec.Core.Hooks as H runSilent :: H.Spec -> IO () runSilent = silence . H.hspec +evalSpec :: H.Spec -> IO [([String], Item)]+evalSpec = fmap normalize . (H.specToEvalForest H.defaultConfig >=> runFormatter config)+ where+ config = EvalConfig {+ evalConfigFormat = format+ , evalConfigConcurrentJobs = 1+ , evalConfigFastFail = False+ }+ format = Format {+ formatRun = id+ , formatGroupStarted = \ _ -> return ()+ , formatGroupDone = \ _ -> return ()+ , formatProgress = \ _ _ -> return ()+ , formatItem = \ _ _ -> return ()+ }+ normalize = map $ \ (path, item) -> (pathToList path, normalizeItem item)+ normalizeItem item = item {itemLocation = Nothing, itemDuration = 0}+ pathToList (xs, x) = xs ++ [x]+ mkAppend :: IO (String -> IO (), IO [String]) mkAppend = do ref <- newIORef ([] :: [String])@@ -294,16 +317,18 @@ context "when used with an empty list of examples" $ do it "does not run specified action" $ do- (rec, retrieve) <- mkAppend- runSilent $ H.before (rec "before" >> return "from before") $ H.afterAll rec $ do+ evalSpec $ H.before undefined $ H.afterAll undefined $ do return ()- retrieve `shouldReturn` []+ `shouldReturn` [] context "when action throws an exception" $ do it "reports a failure" $ do- r <- runSpec $ H.before (return "from before") $ H.afterAll (\_ -> throwException) $ do+ evalSpec $ H.before (return "from before") $ H.afterAll (\_ -> throwException) $ do H.it "foo" $ \a -> a `shouldBe` "from before"- r `shouldSatisfy` any (== "afterAll-hook FAILED [1]")+ `shouldReturn` [+ item ["foo"] Success+ , item ["afterAll-hook"] divideByZero+ ] describe "afterAll_" $ do it "runs an action after the last spec item" $ do@@ -341,13 +366,35 @@ return () retrieve `shouldReturn` [] + context "when action is pending" $ do+ it "reports pending" $ do+ evalSpec $ do+ H.afterAll_ H.pending $ do+ H.it "foo" True+ `shouldReturn` [+ item ["foo"] Success+ , item ["afterAll-hook"] (Pending Nothing)+ ]+ context "when action throws an exception" $ do it "reports a failure" $ do- r <- runSpec $ do+ evalSpec $ do H.afterAll_ throwException $ do H.it "foo" True- r `shouldSatisfy` any (== "afterAll-hook FAILED [1]")+ `shouldReturn` [+ item ["foo"] Success+ , item ["afterAll-hook"] divideByZero+ ] + context "when action is successful" $ do+ it "does not report anythig" $ do+ evalSpec $ do+ H.afterAll_ (return ()) $ do+ H.it "foo" True+ `shouldReturn` [+ item ["foo"] Success+ ]+ describe "around" $ do it "wraps every spec item with an action" $ do (rec, retrieve) <- mkAppend@@ -406,6 +453,59 @@ runSilent $ H.before (return 23) $ H.aroundWith action $ do H.it "foo" rec retrieve `shouldReturn` ["23"]++ describe "aroundAll_" $ do+ it "wraps an action around a spec" $ do+ (rec, retrieve) <- mkAppend+ let action inner = rec "before" *> inner <* rec "after"+ _ <- evalSpec $ H.aroundAll_ action $ do+ H.it "foo" $ rec "foo"+ H.it "bar" $ rec "bar"+ retrieve `shouldReturn` [+ "before"+ , "foo"+ , "bar"+ , "after"+ ]++ it "does not memoize subject" $ do+ mock <- newMock+ let action :: IO Int+ action = mockAction mock >> mockCounter mock++ (rec, retrieve) <- mkAppend+ _ <- evalSpec $ H.before action $ H.aroundAll_ id $ do+ H.it "foo" $ rec . show+ H.it "bar" $ rec . show+ H.it "baz" $ rec . show+ retrieve `shouldReturn` [+ "1"+ , "2"+ , "3"+ ]+ mockCounter mock `shouldReturn` 4++ it "reports exceptions in acquire-part" $ do+ evalSpec $ do+ H.aroundAll_ (throwException <*) $ do+ H.it "foo" True+ `shouldReturn` [+ item ["foo"] divideByZero+ , item ["afterAll-hook"] (Pending (Just "exception in beforeAll-hook (see previous failure)"))+ ]++ it "reports exceptions in cleanup-part" $ do+ evalSpec $ do+ H.aroundAll_ (<* throwException) $ do+ H.it "foo" True+ `shouldReturn` [+ item ["foo"] Success+ , item ["afterAll-hook"] divideByZero+ ]+ where- runSpec :: H.Spec -> IO [String]- runSpec = captureLines . H.hspecResult+ divideByZero :: Result+ divideByZero = Failure (Error Nothing $ toException DivideByZero)++ item :: [String] -> Result -> ([String], Item)+ item path result = (path, Item Nothing 0 "" result)
test/Test/Hspec/Core/SpecSpec.hs view
@@ -10,8 +10,8 @@ import qualified Test.Hspec.Core.Spec as H -ignoreCleanup :: Tree c a -> Tree () a-ignoreCleanup = H.bimapTree (const ()) id+extract :: (Item () -> a) -> H.Spec -> IO [Tree () a]+extract f = fmap (H.bimapForest (const ()) f) . runSpecM runSpec :: H.Spec -> IO [String] runSpec = captureLines . H.hspecResult@@ -91,37 +91,35 @@ describe "focus" $ do it "focuses spec items" $ do- items <- runSpecM $ H.focus $ do+ items <- extract itemIsFocused $ H.focus $ do H.it "is focused and will run" True H.it "is also focused and will also run" True- map (ignoreCleanup . fmap itemIsFocused) items- `shouldBe` [Leaf True, Leaf True]+ items `shouldBe` [Leaf True, Leaf True] context "when applied to a spec with focused spec items" $ do it "has no effect" $ do- items <- runSpecM $ H.focus $ do+ items <- extract itemIsFocused $ H.focus $ do H.focus $ H.it "is focused and will run" True H.it "is not focused and will not run" True- map (ignoreCleanup . fmap itemIsFocused) items- `shouldBe` [Leaf True, Leaf False]+ items `shouldBe` [Leaf True, Leaf False] describe "parallel" $ do it "marks examples for parallel execution" $ do- [Leaf item] <- runSpecM . H.parallel $ H.it "whatever" H.pending- itemIsParallelizable item `shouldBe` Just True+ items <- extract itemIsParallelizable . H.parallel $ H.it "whatever" H.pending+ items `shouldBe` [Leaf $ Just True] it "is applied recursively" $ do- [Node _ [Node _ [Leaf item]]] <- runSpecM . H.parallel $ do+ items <- extract itemIsParallelizable . H.parallel $ do H.describe "foo" $ do H.describe "bar" $ do H.it "baz" H.pending- itemIsParallelizable item `shouldBe` Just True+ items `shouldBe` [Node "foo" [Node "bar" [Leaf $ Just True]]] describe "sequential" $ do it "marks examples for sequential execution" $ do- [Leaf item] <- runSpecM . H.sequential $ H.it "whatever" H.pending- itemIsParallelizable item `shouldBe` Just False+ items <- extract itemIsParallelizable . H.sequential $ H.it "whatever" H.pending+ items `shouldBe` [Leaf $ Just False] it "takes precedence over a later `parallel`" $ do- [Leaf item] <- runSpecM . H.parallel . H.sequential $ H.it "whatever" H.pending- itemIsParallelizable item `shouldBe` Just False+ items <- extract itemIsParallelizable . H.parallel . H.sequential $ H.it "whatever" H.pending+ items `shouldBe` [Leaf $ Just False]
version.yaml view
@@ -1,1 +1,1 @@-&version 2.7.6+&version 2.7.7