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 - [email protected]
+
+- 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
