resourcet 0.4.10.1 → 0.4.10.2

raw patch · 3 files changed

+31/−10 lines, 3 files

Files

• Control/Monad/Trans/Resource.hs +2/−2
• resourcet.cabal +1/−1
• test/main.hs +28/−7

@@ -196,9 +196,9 @@          -> Int          -> (Maybe (IO ()) -> IO a)          -> IO a-release' istate key act = E.mask $ \restore -> do+release' istate key act = E.mask_ $ do     maction <- I.atomicModifyIORef istate lookupAction-    restore (act maction)+    act maction   where     lookupAction rm@(ReleaseMap next rf m) =         case IntMap.lookup key m of

@@ -1,5 +1,5 @@ Name:                resourcet-Version:             0.4.10.1+Version:             0.4.10.2 Synopsis:            Deterministic allocation and freeing of scarce resources. Description: 	This package was originally included with the conduit package, and has since been split off. For more information, please see <http://www.yesodweb.com/book/conduits>.

@@ -1,12 +1,17 @@+{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE ScopedTypeVariables #-} -import Test.Hspec-import Control.Monad.Trans.Resource-import Data.IORef-import Control.Concurrent-import Control.Monad.IO.Class (liftIO)-import Control.Concurrent.Lifted (fork)-import Control.Exception (handle, SomeException)+import           Control.Concurrent+import           Control.Concurrent.Lifted    (fork)+import           Control.Exception            (Exception, MaskingState (MaskedInterruptible),+                                               getMaskingState, throwIO, try)+import           Control.Exception            (SomeException, handle)+import           Control.Monad                (unless)+import           Control.Monad.IO.Class       (liftIO)+import           Control.Monad.Trans.Resource+import           Data.IORef+import           Data.Typeable                (Typeable)+import           Test.Hspec  main :: IO () main = hspec $ do@@ -37,6 +42,22 @@               unprotect key             y <- readIORef x             y `shouldBe` 0+    it "cleanup actions are masked #144" $ do+        let checkMasked name = do+                ms <- getMaskingState+                unless (ms == MaskedInterruptible) $+                    error $ show (name, ms)+        runResourceT $ do+            register (checkMasked "release") >>= release+            register (checkMasked "normal")+        Left Dummy <- try $ runResourceT $ do+            register (checkMasked "exception")+            liftIO $ throwIO Dummy+        return ()++data Dummy = Dummy+    deriving (Show, Typeable)+instance Exception Dummy  forkHelper s fork' = describe s $ do     it "waits for all threads" $ do