hspec-core 2.11.5 → 2.11.6
raw patch · 6 files changed
+95/−49 lines, 6 filesdep ~hspec-meta
Dependency ranges changed: hspec-meta
Files
- hspec-core.cabal +3/−3
- src/Test/Hspec/Core/Runner/Eval.hs +64/−42
- test/Test/Hspec/Core/Formatters/DiffSpec.hs +3/−3
- test/Test/Hspec/Core/RunnerSpec.hs +20/−0
- vendor/Data/Algorithm/Diff.hs +4/−0
- version.yaml +1/−1
hspec-core.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.5.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: hspec-core-version: 2.11.5+version: 2.11.6 license: MIT license-file: LICENSE copyright: (c) 2011-2023 Simon Hengel,@@ -130,7 +130,7 @@ , filepath , haskell-lexer , hspec-expectations ==0.8.4.*- , hspec-meta ==2.11.5+ , hspec-meta ==2.11.6 , process , quickcheck-io >=0.2.0 , random
src/Test/Hspec/Core/Runner/Eval.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE LambdaCase #-} module Test.Hspec.Core.Runner.Eval ( EvalConfig(..) , ColorMode(..)@@ -53,7 +54,7 @@ data Env = Env { envConfig :: EvalConfig-, envFailed :: IORef Bool+, envAbort :: IORef Bool , envResults :: IORef [(Path, Format.Item)] } @@ -64,14 +65,14 @@ type EvalM = ReaderT Env IO -setFailed :: EvalM ()-setFailed = do- ref <- asks envFailed+abort :: EvalM ()+abort = do+ ref <- asks envAbort liftIO $ writeIORef ref True -hasFailed :: EvalM Bool-hasFailed = do- ref <- asks envFailed+shouldAbort :: EvalM Bool+shouldAbort = do+ ref <- asks envAbort liftIO $ readIORef ref addResult :: Path -> Format.Item -> EvalM ()@@ -89,15 +90,15 @@ reportItemDone :: Path -> Format.Item -> EvalM () reportItemDone path item = do- let- isFailure = case Format.itemResult item of- Format.Success{} -> False- Format.Pending{} -> False- Format.Failure{} -> True- when isFailure setFailed addResult path item formatEvent $ Format.ItemDone path item +isFailure :: Result -> Bool+isFailure r = case resultStatus r of+ Success{} -> False+ Pending{} -> False+ Failure{} -> True+ reportResult :: Path -> Maybe Location -> (Seconds, Result) -> EvalM () reportResult path loc (duration, result) = do mode <- asks (evalConfigColorMode . envConfig)@@ -141,12 +142,15 @@ runningSpecs_ <- enqueueItems queue specs let- applyReportProgress :: RunningItem_ IO -> RunningItem+ applyReportProgress :: RunningItem_ IO -> RunningItem IO applyReportProgress item = fmap (. reportProgress timer) item - runningSpecs :: [RunningTree ()]- runningSpecs = applyCleanup $ map (fmap applyReportProgress) runningSpecs_+ runningSpecs :: [RunningTree () EvalM]+ runningSpecs = applyCleanup abortEarly $ map (fmap applyReportProgress) runningSpecs_ + abortEarly :: Result -> Bool+ abortEarly result = evalConfigFailFast config && isFailure result+ getResults :: IO [(Path, Format.Item)] getResults = reverse <$> readIORef (envResults env) @@ -178,41 +182,61 @@ , itemAction :: a } deriving Functor -type RunningItem = Item (Path -> IO (Seconds, Result))-type RunningTree c = Tree c RunningItem+type RunningItem m = Item (Path -> m (Seconds, Result))+type RunningTree c m = Tree c (RunningItem m) type RunningItem_ m = Item (Job m Progress (Seconds, Result)) type RunningTree_ m = Tree (IO ()) (RunningItem_ m) -applyCleanup :: [RunningTree (IO ())] -> [RunningTree ()]-applyCleanup = map go+applyFailFast :: (Result -> Bool) -> RunningTree () IO -> RunningTree () EvalM+applyFailFast = fmap . fmap . fmap . applyToItem where+ applyToItem abortEarly action = do+ result@(_, r) <- lift action+ when (abortEarly r) abort+ return result++applyCleanup :: (Result -> Bool) -> [RunningTree (IO ()) IO] -> [RunningTree () EvalM]+applyCleanup abortEarly = map (applyFailFast abortEarly . go)+ where+ go :: RunningTree (IO ()) IO -> RunningTree () IO go t = case t of Node label xs -> Node label (go <$> xs)- NodeWithCleanup loc cleanup xs -> NodeWithCleanup loc () (addCleanupToLastLeaf loc cleanup $ go <$> xs)+ NodeWithCleanup loc cleanup xs -> NodeWithCleanup loc () (applyCleanupAction abortEarly loc cleanup $ go <$> xs) Leaf a -> Leaf a -addCleanupToLastLeaf :: Maybe (String, Location) -> IO () -> NonEmpty (RunningTree ()) -> NonEmpty (RunningTree ())-addCleanupToLastLeaf loc cleanup = go+applyCleanupAction :: (Result -> Bool) -> Maybe (String, Location) -> IO () -> NonEmpty (RunningTree () IO) -> NonEmpty (RunningTree () IO)+applyCleanupAction abortEarly loc cleanup = forLastLeaf (addCleanupOn (not . abortEarly)) . forEachLeaf (addCleanupOn abortEarly) where+ addCleanupOn p = addCleanupToItem p loc cleanup++forEachLeaf :: (a -> b) -> NonEmpty (Tree () a) -> NonEmpty (Tree () b)+forEachLeaf f = fmap (fmap f)++forLastLeaf :: (a -> a) -> NonEmpty (Tree () a) -> NonEmpty (Tree () a)+forLastLeaf p = go+ where go = NonEmpty.reverse . mapHead goNode . NonEmpty.reverse goNode node = case node of Node description xs -> Node description (go xs) NodeWithCleanup loc_ () xs -> NodeWithCleanup loc_ () (go xs)- Leaf item -> Leaf (addCleanupToItem loc cleanup item)+ Leaf item -> Leaf (p item) mapHead :: (a -> a) -> NonEmpty a -> NonEmpty a mapHead f xs = case xs of y :| ys -> f y :| ys -addCleanupToItem :: Maybe (String, Location) -> IO () -> RunningItem -> RunningItem-addCleanupToItem loc cleanup item = item {+addCleanupToItem :: (Result -> Bool) -> Maybe (String, Location) -> IO () -> RunningItem IO -> RunningItem IO+addCleanupToItem shouldRunCleanup loc cleanup item = item { itemAction = \ path -> do- (t1, r1) <- itemAction item path- (t2, r2) <- measure $ safeEvaluateResultStatus (cleanup >> return Success)- let t = t1 + t2- return (t, mergeResults loc r1 r2)+ result@(t1, r1) <- itemAction item path+ if shouldRunCleanup r1 then do+ (t2, r2) <- measure $ safeEvaluateResultStatus (cleanup >> return Success)+ let t = t1 + t2+ return (t, mergeResults loc r1 r2)+ else do+ return result } mergeResults :: Maybe (String, Location) -> Result -> ResultStatus -> Result@@ -245,12 +269,11 @@ exceptionToResult :: SomeException -> IO (Seconds, Result) exceptionToResult err = (,) 0 . Result "" <$> exceptionToResultStatus err -eval :: [RunningTree ()] -> EvalM ()+eval :: [RunningTree () EvalM] -> EvalM () eval specs = do- failFast <- asks (evalConfigFailFast . envConfig)- sequenceActions failFast (concatMap foldSpec specs)+ sequenceActions (concatMap foldSpec specs) where- foldSpec :: RunningTree () -> [EvalM ()]+ foldSpec :: RunningTree () EvalM -> [EvalM ()] foldSpec = foldTree FoldTree { onGroupStarted = groupStarted , onGroupDone = groupDone@@ -261,9 +284,9 @@ runCleanup :: Maybe (String, Location) -> [String] -> () -> EvalM () runCleanup _loc _groups = return - evalItem :: [String] -> RunningItem -> EvalM ()+ evalItem :: [String] -> RunningItem EvalM -> EvalM () evalItem groups (Item requirement loc action) = do- reportItem path loc $ lift (action path)+ reportItem path loc $ action path where path :: Path path = (groups, requirement)@@ -290,14 +313,13 @@ cleanup = onCleanup loc (reverse rGroups) action go rGroups (Leaf a) = [onLeafe (reverse rGroups) a] -sequenceActions :: Bool -> [EvalM ()] -> EvalM ()-sequenceActions failFast = go+sequenceActions :: [EvalM ()] -> EvalM ()+sequenceActions = go where go :: [EvalM ()] -> EvalM () go [] = pass go (action : actions) = do action- stopNow <- case failFast of- False -> return False- True -> hasFailed- unless stopNow (go actions)+ shouldAbort >>= \ case+ False -> go actions+ True -> pass
test/Test/Hspec/Core/Formatters/DiffSpec.hs view
@@ -8,7 +8,7 @@ import Test.Hspec.Core.Formatters.Diff as Diff dropQuotes :: String -> String-dropQuotes = init . tail+dropQuotes = init . drop 1 spec :: Spec spec = do@@ -106,12 +106,12 @@ let char = dropQuotes (show [c]) isEscaped = length char > 1- escape = tail char+ escape = drop 1 char sep = case ys of x : _ | all isDigit escape && isDigit x || escape == "SO" && x == 'H' -> ["\\&"] _ -> [] actual = partition (show (xs ++ c : ys))- expected = partition (init $ show xs) ++ [char] ++ sep ++ partition (tail $ show ys)+ expected = partition (init $ show xs) ++ [char] ++ sep ++ partition (drop 1 $ show ys) in isEscaped ==> actual `shouldBe` expected describe "breakList" $ do
test/Test/Hspec/Core/RunnerSpec.hs view
@@ -448,6 +448,26 @@ , "1 example, 1 failure" ] + context "with a cleanup action" $ do+ it "runs cleanup action" $ do+ ref <- newIORef 0+ ignoreExitCode $ hspec ["--fail-fast"] $ do+ H.afterAll_ (modifyIORef ref succ) $ do+ H.it "foo" True+ H.it "bar" False+ H.it "baz" True+ readIORef ref `shouldReturn` (1 :: Int)++ context "when last leaf fails" $ do+ it "runs cleanup action exactly once" $ do+ ref <- newIORef 0+ ignoreExitCode $ hspec ["--fail-fast"] $ do+ H.afterAll_ (modifyIORef ref succ) $ do+ H.it "foo" True+ H.it "bar" True+ H.it "baz" False+ readIORef ref `shouldReturn` (1 :: Int)+ context "with --match" $ do it "only runs examples that match a given pattern" $ do e1 <- newMock
vendor/Data/Algorithm/Diff.hs view
@@ -1,5 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -fno-warn-x-partial #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Data.Algorithm.Diff
version.yaml view
@@ -1,4 +1,4 @@-version: &version 2.11.5+version: &version 2.11.6 synopsis: A Testing Framework for Haskell author: Simon Hengel <sol@typeful.net> maintainer: Simon Hengel <sol@typeful.net>