enclosed-exceptions 1.0.1 → 1.0.1.1
raw patch · 2 files changed
+179/−54 lines, 2 filesnew-uploaderPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- enclosed-exceptions.cabal +1/−1
- test/main.hs +178/−53
enclosed-exceptions.cabal view
@@ -1,5 +1,5 @@ name: enclosed-exceptions-version: 1.0.1+version: 1.0.1.1 synopsis: Catching all exceptions from within an enclosed computation description: Catching all exceptions raised within an enclosed computation, while remaining responsive to (external) asynchronous exceptions.
test/main.hs view
@@ -8,70 +8,195 @@ import Control.Exception.Lifted hiding (throwTo) import Data.IORef import Data.Typeable-import Control.Monad.IO.Class-import Control.Concurrent (throwTo, threadDelay, forkIO)+import Control.Concurrent (threadDelay)+import Control.Concurrent.Async (async, cancelWith, waitCatch)+import Control.Concurrent.MVar import Control.Exception.Enclosed+import Control.Monad (forever) {-# ANN main ("HLint: ignore Redundant do"::String) #-} main :: IO () main = hspec $ do- describe "any exceptions" $ do- it "catchAny" $ do- failed <- newIORef 0- tid <- forkIO $ do- catchAny- (threadDelay 20000)- (const $ writeIORef failed 1)- writeIORef failed 2- threadDelay 10000- throwTo tid DummyException- threadDelay 50000- didFail <- readIORef failed- liftIO $ didFail `shouldBe` (0 :: Int)+ context "Unhandled.Exception" $ do+ -- const :: Catcher+ describe "const" $ do+ it "doesn't catch exceptions thrown from the inside" $ do+ const `catcherCatchesInside` False+ it "doesn't catch exceptions thrown from the outside" $ do+ const `catcherCatchesOutside` False+ it "doesn't catch exceptions lazily thrown in its pure result" $ do+ const `catcherCatchesDeep` False - it "catchDeep" $ do- failed <- newIORef 0- tid <- forkIO $ do- catchDeep- (threadDelay 10000 >> return (throw DummyExceptionInternal))- (\(_::DummyExceptionInternal) -> writeIORef failed 1)- threadDelay 20000- writeIORef failed 2- threadDelay 20000- throwTo tid DummyException- threadDelay 50000- didFail <- readIORef failed- liftIO $ didFail `shouldBe` (1 :: Int)+ -- fmap Right :: Trier+ describe "fmap Right" $ do+ it "doesn't catch exceptions thrown from the inside" $ do+ fmap Right `trierCatchesInside` False+ it "doesn't catch exceptions thrown from the outside" $ do+ fmap Right `trierCatchesOutside` False+ it "doesn't catch exceptions lazily thrown in its pure result" $ do+ fmap Right `trierCatchesDeep` False - it "tryAny" $ do- failed <- newIORef False- tid <- forkIO $ do- _ <- tryAny $ threadDelay 20000- writeIORef failed True- threadDelay 10000- throwTo tid DummyException- threadDelay 50000- didFail <- readIORef failed- liftIO $ didFail `shouldBe` False+ context "Control.Exception" $ do+ describe "catch" $ do+ it "catches exceptions thrown from the inside" $ do+ catch `catcherCatchesInside` True+ it "catches exceptions thrown from the outside" $ do+ catch `catcherCatchesOutside` True+ it "doesn't catch exceptions lazily thrown in its pure result" $ do+ catch `catcherCatchesDeep` False+ describe "try" $ do+ it "catches exceptions thrown from the inside" $ do+ try `trierCatchesInside` True+ it "catches exceptions thrown from the outside" $ do+ try `trierCatchesOutside` True+ it "doesn't catch exceptions lazily thrown in its pure result" $ do+ try `trierCatchesDeep` False - it "tryDeep" $ do- eres <- tryDeep $ return $ throw DummyException- case eres of- Left DummyException -> return ()- Right () -> error "Expected an exception" :: IO ()+ context "Control.Exception.Enclosed" $ do+ describe "catchAny" $ do+ it "catches exceptions thrown from the inside" $ do+ catchAny `catcherCatchesInside` True+ it "doesn't catch exceptions thrown from the outside" $ do+ catchAny `catcherCatchesOutside` False+ it "doesn't catch exceptions lazily thrown in its pure result" $ do+ catchAny `catcherCatchesDeep` False - it "tryAnyDeep" $ do- eres <- tryAnyDeep $ return $ throw DummyException- case eres of- Left e- | Just DummyException <- fromException e -> return ()- | otherwise -> error "Expected a DummyException"- Right () -> error "Expected an exception" :: IO ()+ describe "catchDeep" $ do+ it "catches exceptions thrown from the inside" $ do+ catchDeep `catcherCatchesInside` True+ it "catches exceptions thrown from the outside" $ do+ catchDeep `catcherCatchesOutside` True+ it "catches exceptions lazily thrown in its pure result" $ do+ catchDeep `catcherCatchesDeep` True + describe "tryAny" $ do+ it "catches exceptions thrown from the inside" $ do+ tryAny `trierCatchesInside` True+ it "doesn't catch exceptions thrown from the outside" $ do+ tryAny `trierCatchesOutside` False+ it "doesn't catch exceptions lazily thrown in its pure result" $ do+ tryAny `trierCatchesDeep` False++ describe "tryDeep" $ do+ it "catches exceptions thrown from the inside" $ do+ tryDeep `trierCatchesInside` True+ it "catches exceptions thrown from the outside" $ do+ tryDeep `trierCatchesOutside` True+ it "catches exceptions lazily thrown in its pure result" $ do+ tryDeep `trierCatchesDeep` True++ describe "tryAnyDeep" $ do+ it "catches exceptions thrown from the inside" $ do+ tryAnyDeep `trierCatchesInside` True+ it "doesn't catch exceptions thrown from the outside" $ do+ tryAnyDeep `trierCatchesOutside` False+ it "catches exceptions lazily thrown in its pure result" $ do+ tryAnyDeep `trierCatchesDeep` True+++type Catcher = IO () -> (SomeException -> IO ()) -> IO ()+type Trier = IO () -> IO (Either SomeException ())++-- Dummy exception types used just for testing. data DummyException = DummyException deriving (Show, Typeable) instance Exception DummyException -data DummyExceptionInternal = DummyExceptionInternal- deriving (Show, Typeable)-instance Exception DummyExceptionInternal+-- A handler that fails the test if it catches the wrong type of exception.+catchAssert :: forall e. Exception e => e -> IO () -> SomeException -> IO ()+catchAssert _ act se = case fromException se of+ Just (_ :: e) -> act+ Nothing -> expectationFailure "Caught an unexpected exception"++-- Block a thread+blockIndefinitely :: IO ()+blockIndefinitely = forever $ threadDelay maxBound+++-- Test whether a catcher will catch exceptions thrown from the inside.+catcherCatchesInside :: Catcher -> Bool -> IO ()+catcherCatchesInside fCatch asExpected = do+ caughtRef <- newIORef False+ thread <- async $ do+ fCatch+ (throwIO DummyException)+ (catchAssert DummyException $ writeIORef caughtRef True)+ -- No known catchers will catch an exception without also handling it.+ readIORef caughtRef `shouldReturn` True+ _ <- waitCatch thread+ readIORef caughtRef `shouldReturn` asExpected+++-- Test whether a catcher will catch exceptions thrown from the outside.+catcherCatchesOutside :: Catcher -> Bool -> IO ()+catcherCatchesOutside fCatch asExpected = do+ caughtRef <- newIORef False+ baton <- newEmptyMVar+ thread <- async $ do+ fCatch+ (do putMVar baton ()+ -- DummyException can happen from here on+ blockIndefinitely)+ (catchAssert DummyException $ writeIORef caughtRef True)+ -- No known catchers will catch an exception without also handling it.+ readIORef caughtRef `shouldReturn` True+ takeMVar baton+ cancelWith thread DummyException+ _ <- waitCatch thread+ readIORef caughtRef `shouldReturn` asExpected+++-- Test whether a catcher will catch exceptions lazily thrown in a pure result.+-- This is done by `return (throw DummyException)`, which will not+-- raise the exception until the return value is forced.+catcherCatchesDeep :: Catcher -> Bool -> IO ()+catcherCatchesDeep fCatch asExpected = do+ caughtRef <- newIORef False+ thread <- async $ do+ fCatch+ (return (throw DummyException))+ (catchAssert DummyException $ writeIORef caughtRef True)+ _ <- waitCatch thread+ readIORef caughtRef `shouldReturn` asExpected+++-- Test whether a trier will catch exceptions thrown from the inside.+trierCatchesInside :: Trier -> Bool -> IO ()+trierCatchesInside fTry asExpected = do+ caughtRef <- newIORef False+ thread <- async $ do+ _ <- fTry (throwIO DummyException)+ writeIORef caughtRef True+ _ <- waitCatch thread+ readIORef caughtRef `shouldReturn` asExpected+++-- Test whether a trier will catch exceptions thrown from the outside.+trierCatchesOutside :: Trier -> Bool -> IO ()+trierCatchesOutside fTry asExpected = do+ caughtRef <- newIORef False+ baton <- newEmptyMVar+ thread <- async $ do+ _ <- fTry $ do+ putMVar baton ()+ -- DummyException can happen from here on+ blockIndefinitely+ writeIORef caughtRef True+ takeMVar baton+ cancelWith thread DummyException+ _ <- waitCatch thread+ readIORef caughtRef `shouldReturn` asExpected+++-- Test whether a trier will catch exceptions lazily thrown in a pure result.+-- This is done by `return (throw DummyException)`, which will not+-- raise the exception until the return value is forced.+trierCatchesDeep :: Trier -> Bool -> IO ()+trierCatchesDeep fTry asExpected = do+ eres <- fTry $ return $ throw DummyException+ let caughtDummyException = case eres of+ Left e+ | Just DummyException <- fromException e -> True+ | otherwise -> error "Caught an unexpected exception"+ Right _ -> False+ caughtDummyException `shouldBe` asExpected