resourcet 0.4.3 → 0.4.4

raw patch · 3 files changed

+80/−11 lines, 3 filesdep +hspecdep +resourcetdep ~basedep ~lifted-basedep ~transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hspec, resourcet

Dependency ranges changed: base, lifted-base, transformers

API changes (from Hackage documentation)

Files

• Control/Monad/Trans/Resource.hs +12/−10
• resourcet.cabal +13/−1
• test/main.hs +55/−0

@@ -113,7 +113,7 @@ -- 'register' and 'allocate', and is passed to 'release'. -- -- Since 0.3.0-newtype ReleaseKey = ReleaseKey Int+data ReleaseKey = ReleaseKey !(I.IORef ReleaseMap) !Int     deriving Typeable  type RefCount = Word@@ -207,8 +207,8 @@ -- actions to be performed. -- -- Since 0.3.0-release :: MonadResource m => ReleaseKey -> m ()-release = liftResourceT . releaseRIO+release :: MonadIO m => ReleaseKey -> m ()+release (ReleaseKey istate rk) = liftIO $ release' istate rk  -- | Perform some allocation, and automatically register a cleanup action. --@@ -244,9 +244,6 @@ registerRIO :: IO () -> ResourceT IO ReleaseKey registerRIO rel = ResourceT $ \istate -> liftIO $ register' istate rel -releaseRIO :: ReleaseKey -> ResourceT IO ()-releaseRIO rk = ResourceT $ \istate -> liftIO $ release' istate rk- resourceMaskRIO :: ((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b) -> ResourceT IO b resourceMaskRIO f = ResourceT $ \istate -> liftIO $ E.mask $ \restore ->     let ResourceT f' = f (go restore)@@ -279,7 +276,7 @@     case rm of         ReleaseMap key rf m ->             ( ReleaseMap (key - 1) rf (IntMap.insert key rel m)-            , ReleaseKey key+            , ReleaseKey istate key             )         ReleaseMapClosed -> throw $ InvalidAccess "register'" @@ -300,9 +297,9 @@ instance Exception InvalidAccess  release' :: I.IORef ReleaseMap-         -> ReleaseKey+         -> Int          -> IO ()-release' istate (ReleaseKey key) = E.mask $ \restore -> key `seq` do+release' istate key = E.mask $ \restore -> do     maction <- I.atomicModifyIORef istate lookupAction     maybe (return ()) restore maction   where@@ -313,7 +310,12 @@                 ( ReleaseMap next rf $ IntMap.delete key m                 , Just action                 )-    lookupAction ReleaseMapClosed = throw $ InvalidAccess "release'"+    -- We tried to call release, but since the state is already closed, we+    -- can assume that the release action was already called. Previously,+    -- this threw an exception, though given that @release@ can be called+    -- from outside the context of a @ResourceT@ starting with version+    -- 0.4.4, it's no longer a library misuse or a library bug.+    lookupAction ReleaseMapClosed = (ReleaseMapClosed, Nothing)  stateAlloc :: I.IORef ReleaseMap -> IO () stateAlloc istate = do

@@ -1,5 +1,5 @@ Name:                resourcet-Version:             0.4.3+Version:             0.4.4 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>.@@ -22,6 +22,18 @@                      , transformers             >= 0.2.2        && < 0.4                      , mtl                      >= 2.0          && < 2.2   ghc-options:     -Wall++test-suite test+    hs-source-dirs: test+    main-is: main.hs+    type: exitcode-stdio-1.0+    cpp-options:   -DTEST+    build-depends:   resourcet+                   , base+                   , hspec >= 1.3+                   , lifted-base+                   , transformers+    ghc-options:     -Wall  source-repository head   type:     git

@@ -0,0 +1,55 @@+{-# 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)++main :: IO ()+main = hspec $ do+    describe "general" $ do+        it "survives releasing bottom" $ do+            x <- newIORef 0+            handle (\(_ :: SomeException) -> return ()) $ runResourceT $ do+                _ <- register $ writeIORef x 1+                release undefined+            x' <- readIORef x+            x' `shouldBe` 1+    describe "early release" $ do+        it "works from a different context" $ do+            x <- newIORef 0+            runResourceT $ do+                key <- register $ writeIORef x 1+                runResourceT $ release key+                y <- liftIO $ readIORef x+                liftIO $ y `shouldBe` 1+    describe "forking" $ do+        forkHelper "resourceForkIO" resourceForkIO+        --forkHelper "lifted fork" fork++forkHelper s fork' = describe s $ do+    it "waits for all threads" $ do+        x <- newEmptyMVar+        y <- newIORef 0+        z <- newEmptyMVar+        runResourceT $ do+            _ <- register $ writeIORef y 1+            fork' $ do+                () <- liftIO $ takeMVar x+                y' <- liftIO $ readIORef y+                _ <- register $ putMVar z y'+                return ()++        y1 <- readIORef y+        y1 `shouldBe` 0++        putMVar x ()++        z' <- takeMVar z+        z' `shouldBe` 0++        y2 <- readIORef y+        Just y2 `shouldBe` Just 1