diff --git a/hspec-core.cabal b/hspec-core.cabal --- a/hspec-core.cabal +++ b/hspec-core.cabal @@ -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, diff --git a/src/Test/Hspec/Core/Compat.hs b/src/Test/Hspec/Core/Compat.hs --- a/src/Test/Hspec/Core/Compat.hs +++ b/src/Test/Hspec/Core/Compat.hs @@ -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 diff --git a/src/Test/Hspec/Core/Config.hs b/src/Test/Hspec/Core/Config.hs --- a/src/Test/Hspec/Core/Config.hs +++ b/src/Test/Hspec/Core/Config.hs @@ -18,7 +18,6 @@ import Prelude () import Test.Hspec.Core.Compat -import Control.Exception import Data.Maybe import System.IO import System.IO.Error diff --git a/src/Test/Hspec/Core/Config/Definition.hs b/src/Test/Hspec/Core/Config/Definition.hs --- a/src/Test/Hspec/Core/Config/Definition.hs +++ b/src/Test/Hspec/Core/Config/Definition.hs @@ -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) diff --git a/src/Test/Hspec/Core/Example.hs b/src/Test/Hspec/Core/Example.hs --- a/src/Test/Hspec/Core/Example.hs +++ b/src/Test/Hspec/Core/Example.hs @@ -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 $ diff --git a/src/Test/Hspec/Core/Example/Location.hs b/src/Test/Hspec/Core/Example/Location.hs --- a/src/Test/Hspec/Core/Example/Location.hs +++ b/src/Test/Hspec/Core/Example/Location.hs @@ -16,7 +16,6 @@ import Prelude () import Test.Hspec.Core.Compat -import Control.Exception import Data.Char import Data.Maybe import GHC.IO.Exception diff --git a/src/Test/Hspec/Core/FailureReport.hs b/src/Test/Hspec/Core/FailureReport.hs --- a/src/Test/Hspec/Core/FailureReport.hs +++ b/src/Test/Hspec/Core/FailureReport.hs @@ -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 diff --git a/src/Test/Hspec/Core/Format.hs b/src/Test/Hspec/Core/Format.hs --- a/src/Test/Hspec/Core/Format.hs +++ b/src/Test/Hspec/Core/Format.hs @@ -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 diff --git a/src/Test/Hspec/Core/Formatters/Internal.hs b/src/Test/Hspec/Core/Formatters/Internal.hs --- a/src/Test/Hspec/Core/Formatters/Internal.hs +++ b/src/Test/Hspec/Core/Formatters/Internal.hs @@ -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 diff --git a/src/Test/Hspec/Core/Formatters/Pretty.hs b/src/Test/Hspec/Core/Formatters/Pretty.hs --- a/src/Test/Hspec/Core/Formatters/Pretty.hs +++ b/src/Test/Hspec/Core/Formatters/Pretty.hs @@ -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) diff --git a/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs b/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs --- a/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs +++ b/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs @@ -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 diff --git a/src/Test/Hspec/Core/Formatters/V1.hs b/src/Test/Hspec/Core/Formatters/V1.hs --- a/src/Test/Hspec/Core/Formatters/V1.hs +++ b/src/Test/Hspec/Core/Formatters/V1.hs @@ -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 diff --git a/src/Test/Hspec/Core/Formatters/V2.hs b/src/Test/Hspec/Core/Formatters/V2.hs --- a/src/Test/Hspec/Core/Formatters/V2.hs +++ b/src/Test/Hspec/Core/Formatters/V2.hs @@ -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 diff --git a/src/Test/Hspec/Core/Hooks.hs b/src/Test/Hspec/Core/Hooks.hs --- a/src/Test/Hspec/Core/Hooks.hs +++ b/src/Test/Hspec/Core/Hooks.hs @@ -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) diff --git a/src/Test/Hspec/Core/QuickCheckUtil.hs b/src/Test/Hspec/Core/QuickCheckUtil.hs --- a/src/Test/Hspec/Core/QuickCheckUtil.hs +++ b/src/Test/Hspec/Core/QuickCheckUtil.hs @@ -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)) <$> diff --git a/src/Test/Hspec/Core/Runner.hs b/src/Test/Hspec/Core/Runner.hs --- a/src/Test/Hspec/Core/Runner.hs +++ b/src/Test/Hspec/Core/Runner.hs @@ -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) diff --git a/src/Test/Hspec/Core/Runner/Eval.hs b/src/Test/Hspec/Core/Runner/Eval.hs --- a/src/Test/Hspec/Core/Runner/Eval.hs +++ b/src/Test/Hspec/Core/Runner/Eval.hs @@ -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 diff --git a/src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs b/src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs --- a/src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs +++ b/src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs @@ -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) diff --git a/src/Test/Hspec/Core/Shuffle.hs b/src/Test/Hspec/Core/Shuffle.hs --- a/src/Test/Hspec/Core/Shuffle.hs +++ b/src/Test/Hspec/Core/Shuffle.hs @@ -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 diff --git a/src/Test/Hspec/Core/Spec.hs b/src/Test/Hspec/Core/Spec.hs --- a/src/Test/Hspec/Core/Spec.hs +++ b/src/Test/Hspec/Core/Spec.hs @@ -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. diff --git a/src/Test/Hspec/Core/Timer.hs b/src/Test/Hspec/Core/Timer.hs --- a/src/Test/Hspec/Core/Timer.hs +++ b/src/Test/Hspec/Core/Timer.hs @@ -3,7 +3,6 @@ import Prelude () import Test.Hspec.Core.Compat -import Control.Exception import Control.Concurrent.Async import Test.Hspec.Core.Clock diff --git a/src/Test/Hspec/Core/Tree.hs b/src/Test/Hspec/Core/Tree.hs --- a/src/Test/Hspec/Core/Tree.hs +++ b/src/Test/Hspec/Core/Tree.hs @@ -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) diff --git a/src/Test/Hspec/Core/Util.hs b/src/Test/Hspec/Core/Util.hs --- a/src/Test/Hspec/Core/Util.hs +++ b/src/Test/Hspec/Core/Util.hs @@ -21,7 +21,6 @@ import Data.Char (isSpace) import GHC.IO.Exception -import Control.Exception import Control.Concurrent.Async -- | diff --git a/test/Helper.hs b/test/Helper.hs --- a/test/Helper.hs +++ b/test/Helper.hs @@ -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 diff --git a/test/Test/Hspec/Core/Example/LocationSpec.hs b/test/Test/Hspec/Core/Example/LocationSpec.hs --- a/test/Test/Hspec/Core/Example/LocationSpec.hs +++ b/test/Test/Hspec/Core/Example/LocationSpec.hs @@ -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 diff --git a/test/Test/Hspec/Core/ExampleSpec.hs b/test/Test/Hspec/Core/ExampleSpec.hs --- a/test/Test/Hspec/Core/ExampleSpec.hs +++ b/test/Test/Hspec/Core/ExampleSpec.hs @@ -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 diff --git a/test/Test/Hspec/Core/FailureReportSpec.hs b/test/Test/Hspec/Core/FailureReportSpec.hs --- a/test/Test/Hspec/Core/FailureReportSpec.hs +++ b/test/Test/Hspec/Core/FailureReportSpec.hs @@ -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 diff --git a/test/Test/Hspec/Core/FormatSpec.hs b/test/Test/Hspec/Core/FormatSpec.hs --- a/test/Test/Hspec/Core/FormatSpec.hs +++ b/test/Test/Hspec/Core/FormatSpec.hs @@ -3,8 +3,6 @@ import Prelude () import Helper -import Control.Exception - import Test.Hspec.Core.Format spec :: Spec diff --git a/test/Test/Hspec/Core/Formatters/Pretty/ParserSpec.hs b/test/Test/Hspec/Core/Formatters/Pretty/ParserSpec.hs --- a/test/Test/Hspec/Core/Formatters/Pretty/ParserSpec.hs +++ b/test/Test/Hspec/Core/Formatters/Pretty/ParserSpec.hs @@ -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"] diff --git a/test/Test/Hspec/Core/Formatters/PrettySpec.hs b/test/Test/Hspec/Core/Formatters/PrettySpec.hs --- a/test/Test/Hspec/Core/Formatters/PrettySpec.hs +++ b/test/Test/Hspec/Core/Formatters/PrettySpec.hs @@ -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 diff --git a/test/Test/Hspec/Core/Formatters/V1Spec.hs b/test/Test/Hspec/Core/Formatters/V1Spec.hs --- a/test/Test/Hspec/Core/Formatters/V1Spec.hs +++ b/test/Test/Hspec/Core/Formatters/V1Spec.hs @@ -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" diff --git a/test/Test/Hspec/Core/Formatters/V2Spec.hs b/test/Test/Hspec/Core/Formatters/V2Spec.hs --- a/test/Test/Hspec/Core/Formatters/V2Spec.hs +++ b/test/Test/Hspec/Core/Formatters/V2Spec.hs @@ -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" diff --git a/test/Test/Hspec/Core/HooksSpec.hs b/test/Test/Hspec/Core/HooksSpec.hs --- a/test/Test/Hspec/Core/HooksSpec.hs +++ b/test/Test/Hspec/Core/HooksSpec.hs @@ -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 diff --git a/test/Test/Hspec/Core/Runner/EvalSpec.hs b/test/Test/Hspec/Core/Runner/EvalSpec.hs --- a/test/Test/Hspec/Core/Runner/EvalSpec.hs +++ b/test/Test/Hspec/Core/Runner/EvalSpec.hs @@ -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] diff --git a/test/Test/Hspec/Core/Runner/PrintSlowSpecItemsSpec.hs b/test/Test/Hspec/Core/Runner/PrintSlowSpecItemsSpec.hs --- a/test/Test/Hspec/Core/Runner/PrintSlowSpecItemsSpec.hs +++ b/test/Test/Hspec/Core/Runner/PrintSlowSpecItemsSpec.hs @@ -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}) diff --git a/test/Test/Hspec/Core/RunnerSpec.hs b/test/Test/Hspec/Core/RunnerSpec.hs --- a/test/Test/Hspec/Core/RunnerSpec.hs +++ b/test/Test/Hspec/Core/RunnerSpec.hs @@ -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 diff --git a/test/Test/Hspec/Core/TimerSpec.hs b/test/Test/Hspec/Core/TimerSpec.hs --- a/test/Test/Hspec/Core/TimerSpec.hs +++ b/test/Test/Hspec/Core/TimerSpec.hs @@ -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 diff --git a/test/Test/Hspec/Core/UtilSpec.hs b/test/Test/Hspec/Core/UtilSpec.hs --- a/test/Test/Hspec/Core/UtilSpec.hs +++ b/test/Test/Hspec/Core/UtilSpec.hs @@ -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 diff --git a/version.yaml b/version.yaml --- a/version.yaml +++ b/version.yaml @@ -1,1 +1,1 @@ -&version 2.10.7 +&version 2.10.8