async-dejafu 0.1.2.0 → 0.1.2.1

raw patch · 2 files changed

+19/−4 lines, 2 files

Files

• async-dejafu.cabal +2/−2
• tests/Main.hs +17/−2

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                async-dejafu-version:             0.1.2.0+version:             0.1.2.1 synopsis:            Run MonadConc operations asynchronously and wait for their results.  description:@@ -37,7 +37,7 @@ source-repository this   type:     git   location: https://github.com/barrucadu/dejafu.git-  tag:      async-dejafu-0.1.2.0+  tag:      async-dejafu-0.1.2.1  library   exposed-modules:     Control.Concurrent.Async

@@ -1,8 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE LambdaCase         #-}  module Main where +import Control.Applicative ((<|>)) import Control.Concurrent.Async import Control.Exception (AsyncException(..), BlockedIndefinitelyOnMVar(..), Exception, SomeException(..), fromException) import Control.Monad (forever)@@ -13,6 +15,16 @@ import Test.HUnit (Test(..), runTestTT, test) import Test.HUnit.DejaFu +#if !MIN_VERSION_dejafu(0,3,0)+type MVar m = CVar m++newEmptyMVar :: MonadConc m => m (MVar m a)+newEmptyMVar = newEmptyCVar++takeMVar :: MonadConc m => MVar m a -> m a+takeMVar = takeCVar+#endif+ main :: IO () main = void . runTestTT $ TestList   [ TestLabel "async" $ test@@ -91,13 +103,16 @@   a <- withAsync (forever yield) return   r <- waitCatch a   return $ case r of-    Left (SomeException e) -> Left $ cast e+    -- dejafu-0.2 needs the 'cast', whereas dejafu-0.3 needs the+    -- 'fromException'. This is due to me fixing some bugs with+    -- exception handling in the test implementations.+    Left  e@(SomeException e') -> Left (fromException e <|> cast e')     Right x -> Right x  withasync_waitCatch_blocked :: MonadConc m => m (Maybe BlockedIndefinitelyOnMVar) withasync_waitCatch_blocked = do   _concAllKnown-  r <- withAsync (_concAllKnown >> newEmptyCVar >>= takeCVar) waitCatch+  r <- withAsync (_concAllKnown >> newEmptyMVar >>= takeMVar) waitCatch   return $ case r of     Left e -> fromException e     _      -> Nothing