Hello community, here is the log from the commit of package ghc-enclosed-exceptions for openSUSE:Factory checked in at 2015-04-30 11:51:22 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-enclosed-exceptions (Old) and /work/SRC/openSUSE:Factory/.ghc-enclosed-exceptions.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-enclosed-exceptions" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-enclosed-exceptions/ghc-enclosed-exceptions.changes 2015-02-05 11:00:20.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-enclosed-exceptions.new/ghc-enclosed-exceptions.changes 2015-04-30 11:51:23.000000000 +0200 @@ -1,0 +2,6 @@ +Wed Apr 22 09:18:08 UTC 2015 - mimi.vx@gmail.com + +- update to 1.0.1.1 +* no upstream changelog + +------------------------------------------------------------------- Old: ---- enclosed-exceptions-1.0.1.tar.gz New: ---- enclosed-exceptions-1.0.1.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-enclosed-exceptions.spec ++++++ --- /var/tmp/diff_new_pack.FWuwuO/_old 2015-04-30 11:51:24.000000000 +0200 +++ /var/tmp/diff_new_pack.FWuwuO/_new 2015-04-30 11:51:24.000000000 +0200 @@ -1,5 +1,5 @@ # -# spec file for package ghc-exceptions +# spec file for package ghc # # Copyright (c) 2015 SUSE LINUX GmbH, Nuernberg, Germany. # @@ -15,10 +15,11 @@ # Please submit bugfixes or comments via http://bugs.opensuse.org/ # + %global pkg_name enclosed-exceptions Name: ghc-%{pkg_name} -Version: 1.0.1 +Version: 1.0.1.1 Release: 0 Summary: Catching all exceptions raised within an enclosed computation License: MIT @@ -30,12 +31,12 @@ BuildRequires: fdupes BuildRequires: ghc-Cabal-devel -BuildRequires: ghc-rpm-macros +BuildRequires: ghc-async-devel BuildRequires: ghc-deepseq-devel +BuildRequires: ghc-lifted-base-devel BuildRequires: ghc-monad-control-devel -BuildRequires: ghc-async-devel +BuildRequires: ghc-rpm-macros BuildRequires: ghc-transformers-devel -BuildRequires: ghc-lifted-base-devel %description Catching all exceptions raised within an enclosed computation, while @@ -50,7 +51,6 @@ Requires: %{name} = %{version}-%{release} Requires: ghc-compiler = %{ghc_version} - %description -n ghc-%{pkg_name}-devel Catching all exceptions raised within an enclosed computation, while remaining responsive to (external) asynchronous exceptions. ++++++ enclosed-exceptions-1.0.1.tar.gz -> enclosed-exceptions-1.0.1.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/enclosed-exceptions-1.0.1/enclosed-exceptions.cabal new/enclosed-exceptions-1.0.1.1/enclosed-exceptions.cabal --- old/enclosed-exceptions-1.0.1/enclosed-exceptions.cabal 2014-09-28 16:18:40.000000000 +0200 +++ new/enclosed-exceptions-1.0.1.1/enclosed-exceptions.cabal 2015-03-24 07:50:47.000000000 +0100 @@ -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. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/enclosed-exceptions-1.0.1/test/main.hs new/enclosed-exceptions-1.0.1.1/test/main.hs --- old/enclosed-exceptions-1.0.1/test/main.hs 2014-09-28 16:18:40.000000000 +0200 +++ new/enclosed-exceptions-1.0.1.1/test/main.hs 2015-03-24 07:50:47.000000000 +0100 @@ -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) - - 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) - - 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 - - it "tryDeep" $ do - eres <- tryDeep $ return $ throw DummyException - case eres of - Left DummyException -> return () - Right () -> error "Expected an exception" :: IO () - - 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 () + 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 + + -- 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 + + 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 + + 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 + + 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