hspec-core 2.10.7 → 2.10.8
raw patch · 39 files changed
+274/−208 lines, 39 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- hspec-core.cabal +1/−1
- src/Test/Hspec/Core/Compat.hs +12/−5
- src/Test/Hspec/Core/Config.hs +0/−1
- src/Test/Hspec/Core/Config/Definition.hs +0/−1
- src/Test/Hspec/Core/Example.hs +41/−35
- src/Test/Hspec/Core/Example/Location.hs +0/−1
- src/Test/Hspec/Core/FailureReport.hs +1/−1
- src/Test/Hspec/Core/Format.hs +15/−15
- src/Test/Hspec/Core/Formatters/Internal.hs +0/−1
- src/Test/Hspec/Core/Formatters/Pretty.hs +2/−0
- src/Test/Hspec/Core/Formatters/Pretty/Parser.hs +5/−0
- src/Test/Hspec/Core/Formatters/V1.hs +15/−16
- src/Test/Hspec/Core/Formatters/V2.hs +10/−11
- src/Test/Hspec/Core/Hooks.hs +1/−3
- src/Test/Hspec/Core/QuickCheckUtil.hs +29/−8
- src/Test/Hspec/Core/Runner.hs +9/−5
- src/Test/Hspec/Core/Runner/Eval.hs +15/−15
- src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs +1/−1
- src/Test/Hspec/Core/Shuffle.hs +4/−4
- src/Test/Hspec/Core/Spec.hs +3/−5
- src/Test/Hspec/Core/Timer.hs +0/−1
- src/Test/Hspec/Core/Tree.hs +2/−5
- src/Test/Hspec/Core/Util.hs +0/−1
- test/Helper.hs +7/−9
- test/Test/Hspec/Core/Example/LocationSpec.hs +2/−4
- test/Test/Hspec/Core/ExampleSpec.hs +47/−2
- test/Test/Hspec/Core/FailureReportSpec.hs +1/−2
- test/Test/Hspec/Core/FormatSpec.hs +0/−2
- test/Test/Hspec/Core/Formatters/Pretty/ParserSpec.hs +14/−9
- test/Test/Hspec/Core/Formatters/PrettySpec.hs +2/−2
- test/Test/Hspec/Core/Formatters/V1Spec.hs +3/−4
- test/Test/Hspec/Core/Formatters/V2Spec.hs +2/−3
- test/Test/Hspec/Core/HooksSpec.hs +6/−8
- test/Test/Hspec/Core/Runner/EvalSpec.hs +2/−3
- test/Test/Hspec/Core/Runner/PrintSlowSpecItemsSpec.hs +1/−1
- test/Test/Hspec/Core/RunnerSpec.hs +11/−12
- test/Test/Hspec/Core/TimerSpec.hs +1/−1
- test/Test/Hspec/Core/UtilSpec.hs +8/−9
- version.yaml +1/−1
hspec-core.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hspec-core-version: 2.10.7+version: 2.10.8 license: MIT license-file: LICENSE copyright: (c) 2011-2022 Simon Hengel,
src/Test/Hspec/Core/Compat.hs view
@@ -4,6 +4,7 @@ , module Test.Hspec.Core.Compat ) where +import Control.Exception as Imports import Control.Arrow as Imports ((>>>), (&&&), first, second) import Control.Applicative as Imports import Control.Monad as Imports hiding (@@ -16,6 +17,7 @@ , sequence_ ) import Data.Foldable as Imports+import Data.CallStack as Imports (HasCallStack) #if MIN_VERSION_base(4,11,0) import Data.Functor as Imports@@ -70,7 +72,6 @@ import Text.Read as Imports (readMaybe) import System.Environment as Imports (lookupEnv) #else-import Control.Exception import Text.Read import System.Environment import qualified Text.ParserCombinators.ReadP as P@@ -83,9 +84,7 @@ import Data.Typeable (tyConModule, tyConName) import Control.Concurrent -#if MIN_VERSION_base(4,9,0)-import Control.Exception as Imports (interruptible)-#else+#if !MIN_VERSION_base(4,9,0) import GHC.IO #endif @@ -105,7 +104,7 @@ atomicWriteIORef :: IORef a -> a -> IO () atomicWriteIORef ref a = do x <- atomicModifyIORef ref (\_ -> (a, ()))- x `seq` return ()+ x `seq` pass -- | Parse a string using the 'Read' instance. -- Succeeds if there is exactly one valid result.@@ -175,3 +174,11 @@ endsWith :: Eq a => [a] -> [a] -> Bool endsWith = flip isSuffixOf++#if MIN_VERSION_base(4,8,0)+pass :: Applicative m => m ()+pass = pure ()+#else+pass :: Monad m => m ()+pass = return ()+#endif
src/Test/Hspec/Core/Config.hs view
@@ -18,7 +18,6 @@ import Prelude () import Test.Hspec.Core.Compat -import Control.Exception import Data.Maybe import System.IO import System.IO.Error
src/Test/Hspec/Core/Config/Definition.hs view
@@ -20,7 +20,6 @@ import Prelude () import Test.Hspec.Core.Compat -import Control.Exception (bracket) import System.Directory (getTemporaryDirectory, removeFile) import System.IO (openTempFile, hClose) import System.Process (system)
src/Test/Hspec/Core/Example.hs view
@@ -21,6 +21,7 @@ , safeEvaluateExample -- END RE-EXPORTED from Test.Hspec.Core.Spec , safeEvaluateResultStatus+, toLocation ) where import Prelude ()@@ -28,9 +29,8 @@ import qualified Test.HUnit.Lang as HUnit -import Data.CallStack+import Data.CallStack (SrcLoc(..)) -import Control.Exception import Control.DeepSeq import Data.Typeable (Typeable) import qualified Test.QuickCheck as QC@@ -90,37 +90,44 @@ NoReason -> () Reason r -> r `deepseq` () ExpectedButGot p e a -> p `deepseq` e `deepseq` a `deepseq` ()- Error m e -> m `deepseq` e `seq` ()+ Error m e -> m `deepseq` show e `deepseq` () instance Exception ResultStatus -safeEvaluateExample :: Example e => e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO 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+forceResult :: Result -> Result+forceResult r@(Result info status) = info `deepseq` (forceResultStatus status) `seq` r - forceResultStatus :: ResultStatus -> ResultStatus- forceResultStatus r = case r of- Success -> r- Pending _ m -> m `deepseq` r- Failure _ m -> m `deepseq` r+forceResultStatus :: ResultStatus -> ResultStatus+forceResultStatus r = case r of+ Success -> r+ Pending _ m -> m `deepseq` r+ Failure _ m -> m `deepseq` r +safeEvaluateExample :: Example e => e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result+safeEvaluateExample example params around progress = safeEvaluate $ evaluateExample example params around progress+ safeEvaluate :: IO Result -> IO Result safeEvaluate action = do- r <- safeTry action- return $ case r of- Left e -> Result "" (toResultStatus e)- Right result -> result+ r <- safeTry $ forceResult <$> action+ case r of+ Left e -> Result "" <$> exceptionToResultStatus e+ Right result -> return result safeEvaluateResultStatus :: IO ResultStatus -> IO ResultStatus-safeEvaluateResultStatus action = either toResultStatus id <$> safeTry action+safeEvaluateResultStatus action = do+ r <- safeTry $ forceResultStatus <$> action+ case r of+ Left e -> exceptionToResultStatus e+ Right status -> return status -toResultStatus :: SomeException -> ResultStatus-toResultStatus e- | Just result <- fromException e = result- | Just hunit <- fromException e = hunitFailureToResult Nothing hunit- | otherwise = Failure Nothing $ Error Nothing e+exceptionToResultStatus :: SomeException -> IO ResultStatus+exceptionToResultStatus = safeEvaluateResultStatus . pure . toResultStatus+ where+ toResultStatus :: SomeException -> ResultStatus+ toResultStatus e+ | Just result <- fromException e = result+ | Just hunit <- fromException e = hunitFailureToResult Nothing hunit+ | otherwise = Failure Nothing $ Error Nothing e instance Example Result where type Arg Result = ()@@ -128,10 +135,8 @@ instance Example (a -> Result) where type Arg (a -> Result) = a- evaluateExample example _params action _callback = do- ref <- newIORef (Result "" Success)- action (evaluate . example >=> writeIORef ref)- readIORef ref+ evaluateExample example _params hook _callback = do+ liftHook (Result "" Success) hook (evaluate . example) instance Example Bool where type Arg Bool = ()@@ -139,10 +144,8 @@ instance Example (a -> Bool) where type Arg (a -> Bool) = a- evaluateExample p _params action _callback = do- ref <- newIORef (Result "" Success)- action (evaluate . example >=> writeIORef ref)- readIORef ref+ evaluateExample p _params hook _callback = do+ liftHook (Result "" Success) hook (evaluate . example) where example a | p a = Result "" Success@@ -166,16 +169,19 @@ where location = case mLoc of Nothing -> Nothing- Just loc -> Just $ Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)+ Just loc -> Just $ toLocation loc where addPre :: String -> String addPre xs = case pre of Just x -> x ++ "\n" ++ xs Nothing -> xs +toLocation :: SrcLoc -> Location+toLocation loc = Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)+ instance Example (a -> Expectation) where type Arg (a -> Expectation) = a- evaluateExample e _ action _ = action e >> return (Result "" Success)+ evaluateExample e _ hook _ = hook e >> return (Result "" Success) instance Example QC.Property where type Arg QC.Property = ()@@ -183,8 +189,8 @@ instance Example (a -> QC.Property) where type Arg (a -> QC.Property) = a- evaluateExample p c action progressCallback = do- r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty action p)+ evaluateExample p c hook progressCallback = do+ r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty hook p) return $ fromQuickCheckResult r where qcProgressCallback = QCP.PostTest QCP.NotCounterexample $
src/Test/Hspec/Core/Example/Location.hs view
@@ -16,7 +16,6 @@ import Prelude () import Test.Hspec.Core.Compat -import Control.Exception import Data.Char import Data.Maybe import GHC.IO.Exception
src/Test/Hspec/Core/FailureReport.hs view
@@ -35,7 +35,7 @@ -- into the environment is a non-essential feature we just disable this to be -- able to run hspec test-suites with ghcjs at all. Should be reverted once -- the issue is fixed.- return ()+ pass #else -- on Windows this can throw an exception when the input is too large, hence -- we use `safeTry` here
src/Test/Hspec/Core/Format.hs view
@@ -19,9 +19,8 @@ import Prelude () import Test.Hspec.Core.Compat -import Control.Exception import Control.Concurrent-import Control.Concurrent.Async (async)+import Control.Concurrent.Async (Async, async) import qualified Control.Concurrent.Async as Async import Control.Monad.IO.Class @@ -94,23 +93,24 @@ event <- takeEvent format event case event of- Done {} -> return ()+ Done {} -> pass _ -> do signal Ok go - t <- async $ do+ worker <- async $ do (run go >> signal Ok) `catch` (signal . NotOk) return $ \ event -> do- running <- Async.poll t- case running of- Just _ -> return ()- Nothing -> do- putEvent event- r <- wait- case r of- Ok -> return ()- NotOk err -> do- Async.wait t- throwIO err+ running <- asyncRunning worker+ when running $ do+ putEvent event+ r <- wait+ case r of+ Ok -> pass+ NotOk err -> do+ Async.wait worker+ throwIO err++asyncRunning :: Async () -> IO Bool+asyncRunning worker = maybe True (const False) <$> Async.poll worker
src/Test/Hspec/Core/Formatters/Internal.hs view
@@ -53,7 +53,6 @@ import qualified System.IO as IO import System.IO (Handle, stdout)-import Control.Exception (bracket_, bracket) import System.Console.ANSI import Control.Monad.Trans.State hiding (state, gets, modify) import Control.Monad.IO.Class
src/Test/Hspec/Core/Formatters/Pretty.hs view
@@ -52,6 +52,7 @@ go value = case value of Char _ -> False String _ -> True+ Rational _ _ -> False Number _ -> False Record _ _ -> True Constructor _ xs -> any go xs@@ -92,6 +93,7 @@ render value = case value of Char c -> shows c String str -> if unicode then Builder $ ushows str else shows str+ Rational n d -> render n <> " % " <> render d Number n -> fromString n Record name fields -> fromString name <> " {\n " <> (intercalate ",\n " $ map renderField fields) <> "\n}" Constructor name values -> intercalate " " (fromString name : map render values)
src/Test/Hspec/Core/Formatters/Pretty/Parser.hs view
@@ -16,6 +16,7 @@ data Value = Char Char | String String+ | Rational Value Value | Number String | Record Name [(Name, Value)] | Constructor Name [Value]@@ -34,6 +35,7 @@ value = char <|> string+ <|> rational <|> number <|> record <|> constructor@@ -45,6 +47,9 @@ string :: Parser Value string = String <$> (token StringLit >>= readA)++rational :: Parser Value+rational = Rational <$> (number <|> tuple) <* require (Varsym, "%") <*> number number :: Parser Value number = integer <|> float
src/Test/Hspec/Core/Formatters/V1.hs view
@@ -68,7 +68,6 @@ import Test.Hspec.Core.Example (Location(..)) import Text.Printf import Control.Monad.IO.Class-import Control.Exception -- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make -- sure, that we only use the public API to implement formatters.@@ -153,16 +152,16 @@ silent :: Formatter silent = Formatter {- headerFormatter = return ()-, exampleGroupStarted = \_ _ -> return ()-, exampleGroupDone = return ()-, exampleStarted = \_ -> return ()-, exampleProgress = \_ _ -> return ()-, exampleSucceeded = \ _ _ -> return ()-, exampleFailed = \_ _ _ -> return ()-, examplePending = \_ _ _ -> return ()-, failedFormatter = return ()-, footerFormatter = return ()+ headerFormatter = pass+, exampleGroupStarted = \_ _ -> pass+, exampleGroupDone = pass+, exampleStarted = \_ -> pass+, exampleProgress = \_ _ -> pass+, exampleSucceeded = \ _ _ -> pass+, exampleFailed = \_ _ _ -> pass+, examplePending = \_ _ _ -> pass+, failedFormatter = pass+, footerFormatter = pass } checks :: Formatter@@ -278,7 +277,7 @@ write (" " ++ show n ++ ") ") writeLine (formatRequirement path) case reason of- NoReason -> return ()+ NoReason -> pass Reason err -> withFailColor $ indent err ExpectedButGot preface expected actual -> do mapM_ indent preface@@ -306,16 +305,16 @@ forM_ chunks $ \ chunk -> case chunk of Both a -> indented write a First a -> indented extra a- Second _ -> return ()- Omitted _ -> return ()+ Second _ -> pass+ Omitted _ -> pass writeLine "" withFailColor $ write (indentation ++ " but got: ") forM_ chunks $ \ chunk -> case chunk of Both a -> indented write a- First _ -> return ()+ First _ -> pass Second a -> indented missing a- Omitted _ -> return ()+ Omitted _ -> pass writeLine "" Error _ e -> withFailColor . indent $ (("uncaught exception: " ++) . formatException) e
src/Test/Hspec/Core/Formatters/V2.hs view
@@ -87,7 +87,6 @@ import Text.Printf import Test.Hspec.Core.Formatters.Pretty.Unicode (ushow) import Control.Monad.IO.Class-import Control.Exception -- We use an explicit import list for "Test.Hspec.Formatters.Monad", to make -- sure, that we only use the public API to implement formatters.@@ -140,13 +139,13 @@ silent :: Formatter silent = Formatter {- formatterStarted = return ()-, formatterGroupStarted = \ _ -> return ()-, formatterGroupDone = \ _ -> return ()-, formatterProgress = \ _ _ -> return ()-, formatterItemStarted = \ _ -> return ()-, formatterItemDone = \ _ _ -> return ()-, formatterDone = return ()+ formatterStarted = pass+, formatterGroupStarted = \ _ -> pass+, formatterGroupDone = \ _ -> pass+, formatterProgress = \ _ _ -> pass+, formatterItemStarted = \ _ -> pass+, formatterItemDone = \ _ _ -> pass+, formatterDone = pass } checks :: Formatter@@ -165,8 +164,8 @@ Pending {} -> (withPendingColor, fallback "‐" "-") Failure {} -> (withFailColor, fallback "✘" "x") case itemResult item of- Success {} -> return ()- Failure {} -> return ()+ Success {} -> pass+ Failure {} -> pass Pending _ reason -> withPendingColor $ do writeLine $ indentationFor ("" : nesting) ++ "# PENDING: " ++ fromMaybe "No reason given" reason } where@@ -277,7 +276,7 @@ write (" " ++ show n ++ ") ") writeLine (formatRequirement path) case reason of- NoReason -> return ()+ NoReason -> pass Reason err -> withFailColor $ indent err ExpectedButGot preface expected_ actual_ -> do pretty <- prettyPrintFunction
src/Test/Hspec/Core/Hooks.hs view
@@ -31,9 +31,7 @@ import Prelude () import Test.Hspec.Core.Compat-import Data.CallStack (HasCallStack) -import Control.Exception (SomeException, finally, throwIO, try) import Control.Concurrent import Test.Hspec.Core.Example@@ -178,7 +176,7 @@ signal doCleanupNow r <- takeMVar released case r of- Released -> return ()+ Released -> pass ExceptionDuringRelease err -> throwIO err return (acquire, release)
src/Test/Hspec/Core/QuickCheckUtil.hs view
@@ -1,10 +1,27 @@ {-# LANGUAGE RecordWildCards #-}-module Test.Hspec.Core.QuickCheckUtil where+{-# LANGUAGE CPP #-}+module Test.Hspec.Core.QuickCheckUtil (+ liftHook+, aroundProperty +, QuickCheckResult(..)+, Status(..)+, QuickCheckFailure(..)+, parseQuickCheckResult++, formatNumbers++, mkGen+, newSeed+#ifdef TEST+, stripSuffix+, splitBy+#endif+) where+ import Prelude () import Test.Hspec.Core.Compat -import Control.Exception import Data.Maybe import Data.Int import System.Random@@ -21,17 +38,21 @@ import Test.Hspec.Core.Util +liftHook :: r -> ((a -> IO ()) -> IO ()) -> (a -> IO r) -> IO r+liftHook def hook inner = do+ ref <- newIORef def+ hook $ inner >=> writeIORef ref+ readIORef ref+ aroundProperty :: ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property-aroundProperty action p = MkProperty . MkGen $ \r n -> aroundProp action $ \a -> (unGen . unProperty $ p a) r n+aroundProperty hook p = MkProperty . MkGen $ \r n -> aroundProp hook $ \a -> (unGen . unProperty $ p a) r n aroundProp :: ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop-aroundProp action p = MkProp $ aroundRose action (\a -> unProp $ p a)+aroundProp hook p = MkProp $ aroundRose hook (\a -> unProp $ p a) aroundRose :: ((a -> IO ()) -> IO ()) -> (a -> Rose QCP.Result) -> Rose QCP.Result-aroundRose action r = ioRose $ do- ref <- newIORef (return QCP.succeeded)- action $ \a -> reduceRose (r a) >>= writeIORef ref- readIORef ref+aroundRose hook r = ioRose $ do+ liftHook (return QCP.succeeded) hook $ \ a -> reduceRose (r a) newSeed :: IO Int newSeed = fst . randomR (0, fromIntegral (maxBound :: Int32)) <$>
src/Test/Hspec/Core/Runner.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | -- Stability: provisional@@ -90,7 +91,6 @@ import System.IO import System.Environment (getArgs, withArgs) import System.Exit-import qualified Control.Exception as E import System.Random import Control.Monad.ST import Data.STRef@@ -147,7 +147,7 @@ | otherwise = id where removeCleanup :: IO () -> IO ()- removeCleanup _ = return ()+ removeCleanup _ = pass markSuccess :: EvalItem -> EvalItem markSuccess item = item {evalItemAction = \ _ -> return $ Result "" Success}@@ -284,10 +284,13 @@ | configFailOnFocused config = mapItem failFocused | otherwise = id -failFocused :: Item a -> Item a+failFocused :: forall a. Item a -> Item a failFocused item = item {itemExample = example} where+ failure :: ResultStatus failure = Failure Nothing (Reason "item is focused; failing due to --fail-on=focused")++ example :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result example | itemIsFocused item = \ params hook p -> do Result info status <- itemExample item params hook p@@ -302,9 +305,10 @@ | configFailOnPending config = mapItem failPending | otherwise = id -failPending :: Item a -> Item a+failPending :: forall a. Item a -> Item a failPending item = item {itemExample = example} where+ example :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result example params hook p = do Result info status <- itemExample item params hook p return $ Result info $ case status of@@ -431,7 +435,7 @@ withHiddenCursor :: Bool -> Handle -> IO a -> IO a withHiddenCursor useColor h- | useColor = E.bracket_ (hHideCursor h) (hShowCursor h)+ | useColor = bracket_ (hHideCursor h) (hShowCursor h) | otherwise = id colorOutputSupported :: ColorMode -> IO Bool -> IO (Bool, Bool)
src/Test/Hspec/Core/Runner/Eval.hs view
@@ -28,7 +28,6 @@ import Test.Hspec.Core.Compat hiding (Monad) import qualified Test.Hspec.Core.Compat as M -import qualified Control.Exception as E import Control.Concurrent import Control.Concurrent.Async hiding (cancel) @@ -132,11 +131,11 @@ start = parallelizeTree (evalConfigConcurrentJobs config) specs cancel = cancelMany . concatMap toList . map (fmap fst) - E.bracket start cancel $ \ runningSpecs -> do+ bracket start cancel $ \ runningSpecs -> do withTimer 0.05 $ \ timer -> do format Format.Started- runReaderT (run . applyCleanup $ map (fmap (fmap (. reportProgress timer) . snd)) runningSpecs) (Env config ref) `E.finally` do+ runReaderT (run . applyCleanup $ map (fmap (fmap (. reportProgress timer) . snd)) runningSpecs) (Env config ref) `finally` do results <- reverse <$> readIORef ref format (Format.Done results) @@ -161,7 +160,7 @@ , itemAction :: a } deriving Functor -type Job m p a = (p -> m ()) -> m a+type Job m progress a = (progress -> m ()) -> m a type RunningItem = Item (Path -> IO (Seconds, Result)) type RunningTree c = Tree c RunningItem@@ -170,9 +169,9 @@ applyCleanup = map go where go t = case t of- Leaf a -> Leaf a Node label xs -> Node label (go <$> xs) NodeWithCleanup loc cleanup xs -> NodeWithCleanup loc () (addCleanupToLastLeaf loc cleanup $ go <$> xs)+ Leaf a -> Leaf a addCleanupToLastLeaf :: Maybe (String, Location) -> IO () -> NonEmpty (RunningTree ()) -> NonEmpty (RunningTree ()) addCleanupToLastLeaf loc cleanup = go@@ -180,9 +179,9 @@ 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)- NodeWithCleanup loc_ () zs -> NodeWithCleanup loc_ () (go zs)- Node description zs -> Node description (go zs) mapHead :: (a -> a) -> NonEmpty a -> NonEmpty a mapHead f xs = case xs of@@ -230,31 +229,32 @@ (asyncAction, evalAction) <- parallelize (Semaphore (waitQSem sem) (signalQSem sem)) evalItemParallelize (interruptible . evalItemAction) return (asyncAction, Item evalItemDescription evalItemLocation evalAction) -parallelize :: MonadIO m => Semaphore -> Bool -> Job IO p a -> IO (Async (), Job m p (Seconds, a))+parallelize :: MonadIO m => Semaphore -> Bool -> Job IO progress a -> IO (Async (), Job m progress (Seconds, a)) parallelize sem isParallelizable | isParallelizable = runParallel sem | otherwise = runSequentially -runSequentially :: MonadIO m => Job IO p a -> IO (Async (), Job m p (Seconds, a))+runSequentially :: MonadIO m => Job IO progress a -> IO (Async (), Job m progress (Seconds, a)) runSequentially action = do mvar <- newEmptyMVar- (asyncAction, evalAction) <- runParallel (Semaphore (takeMVar mvar) (return ())) action+ (asyncAction, evalAction) <- runParallel (Semaphore (takeMVar mvar) pass) action return (asyncAction, \ notifyPartial -> liftIO (putMVar mvar ()) >> evalAction notifyPartial) -data Parallel p a = Partial p | Return a+data Parallel progress a = Partial progress | Return a -runParallel :: forall m p a. MonadIO m => Semaphore -> Job IO p a -> IO (Async (), Job m p (Seconds, a))+runParallel :: forall m progress a. MonadIO m => Semaphore -> Job IO progress a -> IO (Async (), Job m progress (Seconds, a)) runParallel Semaphore{..} action = do mvar <- newEmptyMVar- asyncAction <- async $ E.bracket_ semaphoreWait semaphoreSignal (worker mvar)+ asyncAction <- async $ bracket_ semaphoreWait semaphoreSignal (worker mvar) return (asyncAction, eval mvar) where+ worker :: MVar (Parallel progress (Seconds, a)) -> IO () worker mvar = do let partialCallback = replaceMVar mvar . Partial result <- measure $ action partialCallback replaceMVar mvar (Return result) - eval :: MVar (Parallel p (Seconds, a)) -> (p -> m ()) -> m (Seconds, a)+ eval :: MVar (Parallel progress (Seconds, a)) -> (progress -> m ()) -> m (Seconds, a) eval mvar notifyPartial = do r <- liftIO (takeMVar mvar) case r of@@ -315,7 +315,7 @@ sequenceActions failFast = go where go :: [EvalM ()] -> EvalM ()- go [] = return ()+ go [] = pass go (action : actions) = do action stopNow <- case failFast of
src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs view
@@ -28,7 +28,7 @@ unless (null xs) $ do putStrLn "\nSlow spec items:" mapM_ printSlowSpecItem xs- _ -> return ()+ _ -> pass toSlowItem :: (Path, Item) -> SlowItem toSlowItem (path, item) = SlowItem (itemLocation item) path (toMilliseconds $ itemDuration item)
src/Test/Hspec/Core/Shuffle.hs view
@@ -16,16 +16,16 @@ import Data.STRef import Data.Array.ST -shuffleForest :: STRef s StdGen -> [Tree c a] -> ST s [Tree c a]+shuffleForest :: STRef st StdGen -> [Tree c a] -> ST st [Tree c a] shuffleForest ref xs = (shuffle ref xs >>= mapM (shuffleTree ref)) -shuffleTree :: STRef s StdGen -> Tree c a -> ST s (Tree c a)+shuffleTree :: STRef st StdGen -> Tree c a -> ST st (Tree c a) shuffleTree ref t = case t of Node d xs -> Node d <$> shuffleForest ref xs NodeWithCleanup loc c xs -> NodeWithCleanup loc c <$> shuffleForest ref xs Leaf {} -> return t -shuffle :: STRef s StdGen -> [a] -> ST s [a]+shuffle :: STRef st StdGen -> [a] -> ST st [a] shuffle ref xs = do arr <- mkArray xs bounds@(_, n) <- getBounds arr@@ -41,5 +41,5 @@ writeSTRef ref gen return a -mkArray :: [a] -> ST s (STArray s Int a)+mkArray :: [a] -> ST st (STArray st Int a) mkArray xs = newListArray (1, length xs) xs
src/Test/Hspec/Core/Spec.hs view
@@ -78,8 +78,6 @@ import Prelude () import Test.Hspec.Core.Compat -import qualified Control.Exception as E-import Data.CallStack import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Reader (asks) @@ -188,16 +186,16 @@ -- > it "can format text in a way that everyone likes" $ -- > pending pending :: HasCallStack => Expectation-pending = E.throwIO (Pending location Nothing)+pending = throwIO (Pending location Nothing) pending_ :: Expectation-pending_ = (E.throwIO (Pending Nothing Nothing))+pending_ = (throwIO (Pending Nothing Nothing)) -- | -- `pendingWith` is similar to `pending`, but it takes an additional string -- argument that can be used to specify the reason for why the spec item is pending. pendingWith :: HasCallStack => String -> Expectation-pendingWith = E.throwIO . Pending location . Just+pendingWith = throwIO . Pending location . Just -- | Get the path of `describe` labels, from the root all the way in to the -- call-site of this function.
src/Test/Hspec/Core/Timer.hs view
@@ -3,7 +3,6 @@ import Prelude () import Test.Hspec.Core.Compat -import Control.Exception import Control.Concurrent.Async import Test.Hspec.Core.Clock
src/Test/Hspec/Core/Tree.hs view
@@ -27,7 +27,7 @@ import Prelude () import Test.Hspec.Core.Compat -import Data.CallStack (HasCallStack, SrcLoc(..))+import Data.CallStack (SrcLoc(..)) import qualified Data.CallStack as CallStack import Data.Maybe @@ -52,7 +52,7 @@ where go spec = case spec of Node d xs -> Node d (map go xs)- NodeWithCleanup loc cleanup xs -> NodeWithCleanup loc (g cleanup) (map go xs)+ NodeWithCleanup loc action xs -> NodeWithCleanup loc (g action) (map go xs) Leaf item -> Leaf (f item) filterTree :: (a -> Bool) -> Tree c a -> Maybe (Tree c a)@@ -144,6 +144,3 @@ defaultDescription = case CallStack.callSite of Just (_, loc) -> Just (srcLocModule loc ++ "[" ++ show (srcLocStartLine loc) ++ ":" ++ show (srcLocStartCol loc) ++ "]") Nothing -> Nothing--toLocation :: SrcLoc -> Location-toLocation loc = Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)
src/Test/Hspec/Core/Util.hs view
@@ -21,7 +21,6 @@ import Data.Char (isSpace) import GHC.IO.Exception-import Control.Exception import Control.Concurrent.Async -- |
test/Helper.hs view
@@ -41,8 +41,6 @@ import Data.Char import System.Environment (withArgs, getEnvironment) import System.Exit-import qualified Control.Exception as E-import Control.Exception import System.IO.Silently import System.SetEnv import System.FilePath@@ -64,10 +62,10 @@ import Data.Orphans() -exceptionEq :: E.SomeException -> E.SomeException -> Bool+exceptionEq :: SomeException -> SomeException -> Bool 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)+ | Just ea <- fromException a, Just eb <- fromException b = ea == (eb :: ErrorCall)+ | Just ea <- fromException a, Just eb <- fromException b = ea == (eb :: ArithException) | otherwise = throw (HUnit.HUnitFailure Nothing $ HUnit.ExpectedButGot Nothing (formatException b) (formatException a)) deriving instance Eq FailureReason@@ -81,16 +79,16 @@ (==) = exceptionEq throwException :: IO a-throwException = E.throwIO DivideByZero+throwException = throwIO DivideByZero throwException_ :: IO () throwException_ = throwException ignoreExitCode :: IO () -> IO ()-ignoreExitCode action = action `E.catch` \e -> let _ = e :: ExitCode in return ()+ignoreExitCode action = action `catch` \e -> let _ = e :: ExitCode in pass ignoreUserInterrupt :: IO () -> IO ()-ignoreUserInterrupt action = E.catchJust (guard . (== E.UserInterrupt)) action return+ignoreUserInterrupt action = catchJust (guard . (== UserInterrupt)) action return captureLines :: IO a -> IO [String] captureLines = fmap lines . capture_@@ -116,7 +114,7 @@ defaultParams = H.defaultParams {H.paramsQuickCheckArgs = stdArgs {replay = Just (mkGen 23, 0), maxSuccess = 1000}} noOpProgressCallback :: H.ProgressCallback-noOpProgressCallback _ = return ()+noOpProgressCallback _ = pass shouldUseArgs :: HasCallStack => [String] -> (Args -> Bool) -> Expectation shouldUseArgs args p = do
test/Test/Hspec/Core/Example/LocationSpec.hs view
@@ -10,8 +10,6 @@ import Prelude () import Helper -import Control.Exception- import Test.Hspec.Core.Example import Test.Hspec.Core.Example.Location @@ -50,7 +48,7 @@ foo :: Either () () foo = do 23 <- Right (42 :: Int)- return ()+ pass Left e <- try (evaluate foo) extractLocation e `shouldBe` location #endif@@ -93,7 +91,7 @@ context "with NoMethodError" $ do it "extracts Location" $ do Left e <- try $ someMethod ()- extractLocation e `shouldBe` Just (Location file 21 10)+ extractLocation e `shouldBe` Just (Location file 19 10) context "with AssertionFailed" $ do it "extracts Location" $ do
test/Test/Hspec/Core/ExampleSpec.hs view
@@ -9,7 +9,6 @@ import Helper import Mock-import Control.Exception import Test.HUnit (assertFailure, assertEqual) import Test.Hspec.Core.Example (Result(..), ResultStatus(..), FailureReason(..))@@ -30,8 +29,54 @@ evaluateExampleWithArgument :: H.Example e => (ActionWith (H.Arg e) -> IO ()) -> e -> IO Result evaluateExampleWithArgument action e = H.evaluateExample e defaultParams action noOpProgressCallback +bottom :: a+bottom = throw DivideByZero+ spec :: Spec spec = do+ describe "safeEvaluate" $ do+ let+ status :: ResultStatus+ status = Failure Nothing (Error Nothing $ toException DivideByZero)++ err :: Result+ err = Result "" status++ it "forces Result" $ do+ H.safeEvaluate (return $ Result "" bottom) `shouldReturn` err++ it "handles ResultStatus exceptions" $ do+ H.safeEvaluate (throwIO status) `shouldReturn` err++ it "forces ResultStatus exceptions" $ do+ H.safeEvaluate (throwIO $ Failure Nothing bottom) `shouldReturn` err++ it "handles other exceptions" $ do+ H.safeEvaluate (throwIO DivideByZero) `shouldReturn` err++ it "forces other exceptions" $ do+ H.safeEvaluate (throwIO $ ErrorCall bottom) `shouldReturn` err++ describe "safeEvaluateResultStatus" $ do+ let+ err :: ResultStatus+ err = Failure Nothing (Error Nothing $ toException DivideByZero)++ it "forces ResultStatus" $ do+ H.safeEvaluateResultStatus (return $ Failure Nothing bottom) `shouldReturn` err++ it "handles ResultStatus exceptions" $ do+ H.safeEvaluateResultStatus (throwIO err) `shouldReturn` err++ it "forces ResultStatus exceptions" $ do+ H.safeEvaluateResultStatus (throwIO $ Failure Nothing bottom) `shouldReturn` err++ it "handles other exceptions" $ do+ H.safeEvaluateResultStatus (throwIO DivideByZero) `shouldReturn` err++ it "forces other exceptions" $ do+ H.safeEvaluateResultStatus (throwIO $ ErrorCall bottom) `shouldReturn` err+ describe "safeEvaluateExample" $ do context "for Expectation" $ do it "returns Failure if an expectation does not hold" $ do@@ -131,7 +176,7 @@ it "returns Failure if property does not hold" $ do Result "" (Failure _ _) <- evaluateExample $ property $ \n -> n /= (n :: Int)- return ()+ pass it "shows what falsified it" $ do Result "" (Failure _ r) <- evaluateExample $ property $ \ (x :: Int) (y :: Int) -> (x == 0 && y == 1) ==> False
test/Test/Hspec/Core/FailureReportSpec.hs view
@@ -4,7 +4,6 @@ import Helper import System.IO-import qualified Control.Exception as E import Test.Hspec.Core.FailureReport import Test.Hspec.Core.Config @@ -12,7 +11,7 @@ spec = do describe "writeFailureReport" $ do it "prints a warning on unexpected exceptions" $ do- r <- hCapture_ [stderr] $ writeFailureReport defaultConfig (E.throw (E.ErrorCall "some error"))+ r <- hCapture_ [stderr] $ writeFailureReport defaultConfig (throw (ErrorCall "some error")) r `shouldBe` "WARNING: Could not write environment variable HSPEC_FAILURES (some error)\n" describe "readFailureReport" $ do
test/Test/Hspec/Core/FormatSpec.hs view
@@ -3,8 +3,6 @@ import Prelude () import Helper -import Control.Exception- import Test.Hspec.Core.Format spec :: Spec
test/Test/Hspec/Core/Formatters/Pretty/ParserSpec.hs view
@@ -35,18 +35,23 @@ it "parses strings" $ do show "foo" `shouldParseAs` String "foo" - context "when parsing numbers" $ do- it "accepts integers" $ do- "23" `shouldParseAs` Number "23"+ it "accepts rationals" $ do+ show (0.5 :: Rational) `shouldParseAs` Rational (Number "1") (Number "2") - it "accepts negative integers" $ do- "-23" `shouldParseAs` Number "-23"+ it "accepts negative rationals" $ do+ show (-0.5 :: Rational) `shouldParseAs` Rational (parentheses $ Number "-1") (Number "2") - it "accepts floats" $ do- show (23.0 :: Float) `shouldParseAs` Number "23.0"+ it "accepts integers" $ do+ "23" `shouldParseAs` Number "23" - it "accepts negative floats" $ do- show (-23.0 :: Float) `shouldParseAs` Number "-23.0"+ it "accepts negative integers" $ do+ "-23" `shouldParseAs` Number "-23"++ it "accepts floats" $ do+ show (23.0 :: Float) `shouldParseAs` Number "23.0"++ it "accepts negative floats" $ do+ show (-23.0 :: Float) `shouldParseAs` Number "-23.0" it "parses lists" $ do show ["foo", "bar", "baz"] `shouldParseAs` List [String "foo", String "bar", String "baz"]
test/Test/Hspec/Core/Formatters/PrettySpec.hs view
@@ -57,11 +57,11 @@ ] it "pretty-prints tuples" $ do- pretty True (show (person, 23 :: Double)) `shouldBe` just [+ pretty True (show (person, -0.5 :: Rational)) `shouldBe` just [ "(Person {" , " personName = \"Joe\"," , " personAge = 23"- , "}, 23.0)"+ , "}, (-1) % 2)" ] it "pretty-prints lists" $ do
test/Test/Hspec/Core/Formatters/V1Spec.hs view
@@ -6,8 +6,7 @@ import Helper import Data.String import Control.Monad.IO.Class-import Control.Monad.Trans.Writer-import qualified Control.Exception as E+import Control.Monad.Trans.Writer hiding (pass) import qualified Test.Hspec.Core.Spec as H import qualified Test.Hspec.Core.Runner as H@@ -192,7 +191,7 @@ H.describe "foo" $ do H.it "example 1" True H.describe "bar" $ do- return ()+ pass H.describe "baz" $ do H.it "example 2" True @@ -283,7 +282,7 @@ it "prints the exception type for requirements that fail due to an uncaught exception" $ do r <- runSpec $ do- H.it "foobar" (E.throw (E.ErrorCall "baz") :: Bool)+ H.it "foobar" (throw (ErrorCall "baz") :: Bool) r `shouldContain` [ " 1) foobar" , " uncaught exception: ErrorCall"
test/Test/Hspec/Core/Formatters/V2Spec.hs view
@@ -2,7 +2,6 @@ import Prelude () import Helper-import qualified Control.Exception as E import qualified Test.Hspec.Core.Spec as H import qualified Test.Hspec.Core.Spec as Spec@@ -192,7 +191,7 @@ H.describe "foo" $ do H.it "example 1" True H.describe "bar" $ do- return ()+ pass H.describe "baz" $ do H.it "example 2" True @@ -292,7 +291,7 @@ it "prints the exception type for requirements that fail due to an uncaught exception" $ do r <- runSpec $ do- H.it "foobar" (E.throw (E.ErrorCall "baz") :: Bool)+ H.it "foobar" (throw (ErrorCall "baz") :: Bool) r `shouldContain` [ " 1) foobar" , " uncaught exception: ErrorCall"
test/Test/Hspec/Core/HooksSpec.hs view
@@ -6,8 +6,6 @@ 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@@ -23,7 +21,7 @@ evalSpec = fmap normalize . (toEvalForest >=> runFormatter config) where config = EvalConfig {- evalConfigFormat = \ _ -> return ()+ evalConfigFormat = \ _ -> pass , evalConfigConcurrentJobs = 1 , evalConfigFailFast = False }@@ -154,7 +152,7 @@ it "does not run specified action" $ do (rec, retrieve) <- mkAppend evalSpec_ $ H.beforeAll (rec "beforeAll" >> return "value") $ do- return ()+ pass retrieve `shouldReturn` [] describe "beforeAll_" $ do@@ -246,7 +244,7 @@ (rec, retrieve) <- mkAppend evalSpec_ $ H.beforeAll (return (23 :: Int)) $ H.beforeAllWith (\_ -> rec "beforeAllWith" >> return "value") $ do- return ()+ pass retrieve `shouldReturn` [] describe "after" $ do@@ -328,7 +326,7 @@ context "when used with an empty list of examples" $ do it "does not run specified action" $ do evalSpec $ H.before undefined $ H.afterAll undefined $ do- return ()+ pass `shouldReturn` [] context "when action throws an exception" $ do@@ -373,7 +371,7 @@ it "does not run specified action" $ do (rec, retrieve) <- mkAppend evalSpec_ $ H.afterAll_ (rec "afterAll_") $ do- return ()+ pass retrieve `shouldReturn` [] context "when action is pending" $ do@@ -401,7 +399,7 @@ context "when action is successful" $ do it "does not report anything" $ do evalSpec $ do- H.afterAll_ (return ()) $ do+ H.afterAll_ pass $ do H.it "foo" True `shouldReturn` [ item ["foo"] Success
test/Test/Hspec/Core/Runner/EvalSpec.hs view
@@ -4,7 +4,6 @@ import Prelude () import Helper -import Control.Exception import NonEmpty (fromList) import Test.Hspec.Core.Spec (FailureReason(..), Result(..), ResultStatus(..), Location(..))@@ -80,7 +79,7 @@ ref <- newIORef [] (_, actionA) <- runSequentially $ \ _ -> modifyIORef ref (23 :) (_, actionB) <- runSequentially $ \ _ -> modifyIORef ref (42 :)- (_, ()) <- actionB (\_ -> return ())+ (_, ()) <- actionB (\_ -> pass) readIORef ref `shouldReturn` [42 :: Int]- (_, ()) <- actionA (\_ -> return ())+ (_, ()) <- actionA (\_ -> pass) readIORef ref `shouldReturn` [23, 42]
test/Test/Hspec/Core/Runner/PrintSlowSpecItemsSpec.hs view
@@ -25,7 +25,7 @@ spec :: Spec spec = do describe "printSlowSpecItems" $ do- let format = printSlowSpecItems 2 $ \ _ -> return ()+ let format = printSlowSpecItems 2 $ \ _ -> pass it "prints slow spec items" $ do capture_ $ format $ Done [ ((["foo", "bar"], "one"), item {itemDuration = 0.100})
test/Test/Hspec/Core/RunnerSpec.hs view
@@ -16,7 +16,6 @@ import System.Environment (withArgs, withProgName, getArgs) import System.Exit import Control.Concurrent-import qualified Control.Exception as E import Control.Concurrent.Async import Mock import System.SetEnv@@ -59,15 +58,15 @@ mvar <- newEmptyMVar hspec_ $ do H.it "foo" $ do- E.getMaskingState >>= putMVar mvar- takeMVar mvar `shouldReturn` E.Unmasked+ getMaskingState >>= putMVar mvar+ takeMVar mvar `shouldReturn` Unmasked it "runs finalizers" $ do mvar <- newEmptyMVar ref <- newIORef "did not run finalizer" a <- async $ hspec_ $ do H.it "foo" $ do- (putMVar mvar () >> threadDelay 10000000) `E.finally`+ (putMVar mvar () >> threadDelay 10000000) `finally` writeIORef ref "ran finalizer" takeMVar mvar cancel a@@ -195,7 +194,7 @@ H.it "baz" True putMVar mvar r takeMVar sync- throwTo threadId E.UserInterrupt+ throwTo threadId UserInterrupt r <- takeMVar mvar normalizeSummary r `shouldBe` [ ""@@ -221,10 +220,10 @@ H.it "foo" $ do putMVar sync () threadDelay 1000000- `E.catch` putMVar mvar+ `catch` putMVar mvar takeMVar sync- throwTo threadId E.UserInterrupt- takeMVar mvar `shouldReturn` E.UserInterrupt+ throwTo threadId UserInterrupt+ takeMVar mvar `shouldReturn` UserInterrupt context "with --dry-run" $ do let withDryRun = captureLines . withArgs ["--dry-run"] . H.hspec@@ -271,7 +270,7 @@ context "with --fail-on=empty" $ do it "fails if no spec items have been run" $ do- (out, r) <- capture . E.try . withArgs ["--skip=", "--fail-on=empty"] . H.hspec $ do+ (out, r) <- capture . try . withArgs ["--skip=", "--fail-on=empty"] . H.hspec $ do H.it "foo" True H.it "bar" True H.it "baz" True@@ -312,7 +311,7 @@ r <- run $ do H.it "foo" True H.it "bar" $ do- void $ E.throwIO (H.Pending Nothing Nothing)+ void $ throwIO (H.Pending Nothing Nothing) normalizeSummary r `shouldBe` [ ""@@ -368,7 +367,7 @@ H.it "bar" $ do -- NOTE: waitQSem should never return here, as we want to -- guarantee that the thread is killed before hspec returns- (signalQSem child1 >> waitQSem child2 >> writeIORef ref "foo") `E.finally` signalQSem parent+ (signalQSem child1 >> waitQSem child2 >> writeIORef ref "foo") `finally` signalQSem parent signalQSem child2 waitQSem parent readIORef ref `shouldReturn` ""@@ -737,7 +736,7 @@ atomicModifyIORef highRef $ \x -> (max x current, ()) stop = atomicModifyIORef currentRef $ \x -> (pred x, ()) r <- hspecResult ["-j", show j] . H.parallel $ do- replicateM_ n $ H.it "foo" $ E.bracket_ start stop $ sleep t+ replicateM_ n $ H.it "foo" $ bracket_ start stop $ sleep t r `shouldBe` H.Summary n 0 high <- readIORef highRef high `shouldBe` j
test/Test/Hspec/Core/TimerSpec.hs view
@@ -8,7 +8,7 @@ spec :: Spec spec = do describe "timer action provided by withTimer" $ do- return () -- this test is fragile, see e.g. https://github.com/hspec/hspec/issues/352+ pass -- this test is fragile, see e.g. https://github.com/hspec/hspec/issues/352 {- let
test/Test/Hspec/Core/UtilSpec.hs view
@@ -4,7 +4,6 @@ import Helper import Control.Concurrent-import qualified Control.Exception as E import Test.Hspec.Core.Util @@ -22,12 +21,12 @@ describe "formatException" $ do it "converts exception to string" $ do- formatException (E.toException E.DivideByZero) `shouldBe` "ArithException\ndivide by zero"+ formatException (toException DivideByZero) `shouldBe` "ArithException\ndivide by zero" context "when used with an IOException" $ do it "includes the IOErrorType" $ do inTempDirectory $ do- Left e <- E.try (readFile "foo")+ Left e <- try (readFile "foo") formatException e `shouldBe` intercalate "\n" [ "IOException of type NoSuchThing" , "foo: openFile: does not exist (No such file or directory)"@@ -59,21 +58,21 @@ it "returns Left on exception" $ do Left e <- safeTry throwException- E.fromException e `shouldBe` Just E.DivideByZero+ fromException e `shouldBe` Just DivideByZero it "evaluates result to weak head normal form" $ do- Left e <- safeTry (return $ E.throw $ E.ErrorCall "foo")+ Left e <- safeTry (return $ throw $ ErrorCall "foo") show e `shouldBe` "foo" it "does not catch asynchronous exceptions" $ do mvar <- newEmptyMVar sync <- newEmptyMVar threadId <- forkIO $ do- safeTry (putMVar sync () >> threadDelay 1000000) >> return ()- `E.catch` putMVar mvar+ safeTry (putMVar sync () >> threadDelay 1000000) >> pass+ `catch` putMVar mvar takeMVar sync- throwTo threadId E.UserInterrupt- readMVar mvar `shouldReturn` E.UserInterrupt+ throwTo threadId UserInterrupt+ readMVar mvar `shouldReturn` UserInterrupt describe "filterPredicate" $ do it "tries to match a pattern against a path" $ do
version.yaml view
@@ -1,1 +1,1 @@-&version 2.10.7+&version 2.10.8