Test.hs

{-# LANGUAGE CPP, NoImplicitPrelude , UnicodeSyntax #-}

module Control.Concurrent.ReadWriteLock.Test ( tests ) where


-------------------------------------------------------------------------------
-- Imports
-------------------------------------------------------------------------------

-- from base:
import Control.Monad      ( (>>) )
import Control.Concurrent ( forkIO, threadDelay )
import Data.Function      ( ($) )

#if __GLASGOW_HASKELL__ < 700
import Prelude            ( fromInteger )
import Control.Monad      ( (>>=), fail )
#endif

-- from base-unicode-symbols:
import Prelude.Unicode    ( (⋅) )

-- from concurrent-extra:
import qualified Control.Concurrent.ReadWriteLock as RWLock
    ( new, acquireWrite, acquireRead, releaseWrite, releaseRead  )

import TestUtils ( within, a_moment )

import Utils ( void )

-- from HUnit:
import Test.HUnit ( Assertion, assert )

-- from test-framework:
import Test.Framework  ( Test )

-- from test-framework-hunit:
import Test.Framework.Providers.HUnit ( testCase )


-------------------------------------------------------------------------------
-- Tests for ReadWriteLock
-------------------------------------------------------------------------------

tests ∷ [Test]
tests = [ testCase "test1" test1
        , testCase "test2" test2
        ]

test1 ∷ Assertion
test1 = assert $ within (10 ⋅ a_moment) $ do
          -- Create a new read-write-lock (in the "Free" state):
          rwl ← RWLock.new

          -- Put the read-write-lock in the "Write" state:
          RWLock.acquireWrite rwl

          -- Fork a thread that releases the write-lock after a moment:
          void $ forkIO $ threadDelay a_moment >> RWLock.releaseWrite rwl

          -- This blocks until the write-lock is released in the above thread.
          RWLock.acquireRead rwl

          -- Release the read-lock so that the read-write-lock can either be
          -- acquired again by 'acquireRead' or 'acquireWrite':
          RWLock.releaseRead rwl

          -- The read-write-lock should now be in the "Free" state so the
          -- following shouldn't deadlock:
          RWLock.acquireWrite rwl

test2 ∷ Assertion
test2 = assert $ within (10 ⋅ a_moment) $ do
          -- Create a new read-write-lock (in the "Free" state):
          rwl ← RWLock.new

          -- Put the read-write-lock in the "Read" state:
          RWLock.acquireRead rwl

          -- Fork a thread that releases the read-lock after a moment:
          void $ forkIO $ threadDelay a_moment >> RWLock.releaseRead rwl

          -- This blocks until the read-lock is released in the above thread.
          RWLock.acquireWrite rwl

          -- Release the write-lock so that the read-write-lock can either be
          -- acquired again by 'acquireRead' or 'acquireWrite':
          RWLock.releaseWrite rwl

          -- The read-write-lock should now be in the "Free" state so the
          -- following shouldn't deadlock:
          RWLock.acquireRead rwl