concurrent-extra 0.7.0.7 → 0.7.0.8

raw patch · 3 files changed

+36/−14 lines, 3 filesdep +asyncdep +randomPVP ok

version bump matches the API change (PVP)

Dependencies added: async, random

API changes (from Hackage documentation)

Files

• Control/Concurrent/ReadWriteLock.hs +7/−11
• Control/Concurrent/ReadWriteLock/Test.hs +26/−2
• concurrent-extra.cabal +3/−1

@@ -73,9 +73,9 @@  -- from base: import Control.Applicative     ( liftA2, liftA3 )-import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, swapMVar )+import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar ) import Control.Exception       ( bracket_, onException )-import Control.Monad           ( return, return, (>>), when )+import Control.Monad           ( return, (>>) ) import Data.Bool               ( Bool(False, True) ) import Data.Eq                 ( Eq, (==) ) import Data.Function           ( ($), on )@@ -97,9 +97,9 @@ -- from concurrent-extra (this package): import           Control.Concurrent.Lock ( Lock ) import qualified Control.Concurrent.Lock as Lock-    ( new, newAcquired, acquire, tryAcquire, release, wait )+    ( new, newAcquired, acquire, release, wait ) -import Utils ( void, mask, mask_ )+import Utils ( mask, mask_ )   -------------------------------------------------------------------------------@@ -277,8 +277,8 @@                                   Lock.wait readLock                                   acqWrite                       Write  → do putMVar state st-                                  Lock.acquire writeLock-                                  void $ swapMVar state Write+                                  Lock.wait writeLock+                                  acqWrite  {-| Try to acquire the write lock; non blocking.@@ -293,12 +293,8 @@     Free   → do Lock.acquire writeLock                 putMVar state Write                 return True-    Read _ → do putMVar state st+    _      → do putMVar state st                 return False-    Write  → do putMVar state st-                b ← Lock.tryAcquire writeLock-                when b $ void $ swapMVar state Write-                return b  {-| Release the write lock.

@@ -8,9 +8,12 @@ -------------------------------------------------------------------------------  -- from base:-import Control.Monad      ( (>>) )+import Control.Monad      ( (>>), (>>=), replicateM_ ) import Control.Concurrent ( forkIO, threadDelay ) import Data.Function      ( ($) )+import Data.Foldable      ( sequenceA_ )+import Data.List          ( map, replicate, (++) )+import System.Random      ( randomRIO )  #if __GLASGOW_HASKELL__ < 700 import Prelude            ( fromInteger )@@ -20,9 +23,12 @@ -- from base-unicode-symbols: import Prelude.Unicode    ( (⋅) ) +-- from async:+import Control.Concurrent.Async ( Concurrently(Concurrently), runConcurrently )+ -- from concurrent-extra: import qualified Control.Concurrent.ReadWriteLock as RWLock-    ( new, acquireWrite, acquireRead, releaseWrite, releaseRead  )+    ( new, acquireWrite, acquireRead, releaseWrite, releaseRead, withRead, withWrite  )  import TestUtils ( within, a_moment ) @@ -45,6 +51,7 @@ tests ∷ [Test] tests = [ testCase "test1" test1         , testCase "test2" test2+        , testCase "stressTest" stressTest         ]  test1 ∷ Assertion@@ -90,3 +97,20 @@           -- The read-write-lock should now be in the "Free" state so the           -- following shouldn't deadlock:           RWLock.acquireRead rwl++stressTest :: Assertion+stressTest = assert $ within (500 ⋅ a_moment) $ do+  lock <- RWLock.new++  let randomDelay hi = randomRIO (0, hi) >>= threadDelay++      reader = replicateM_ 500 $ do+        randomDelay 100+        RWLock.withRead lock $ randomDelay 10++      writer = replicateM_ 500 $ do+        randomDelay 100+        RWLock.withWrite lock $ randomDelay 10++  runConcurrently $ sequenceA_ $ map Concurrently $+    replicate 10 reader ++ replicate 10 writer

@@ -1,5 +1,5 @@ name:          concurrent-extra-version:       0.7.0.7+version:       0.7.0.8 cabal-version: >= 1.8 build-type:    Custom stability:     experimental@@ -85,7 +85,9 @@                , stm                  >= 2.1.2.1 && < 2.5                , unbounded-delays     >= 0.1     && < 0.2                , HUnit                >= 1.2.2   && < 1.3+               , random               >= 1.0     && < 1.1                , test-framework       >= 0.2.4   && < 0.9                , test-framework-hunit >= 0.2.4   && < 0.4+               , async                >= 2.0     && < 2.1  -------------------------------------------------------------------------------