1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
{-# LANGUAGE CPP, NoImplicitPrelude #-}
module Control.Concurrent.ReadWriteLock.Test ( tests ) where
-------------------------------------------------------------------------------
-- Imports
-------------------------------------------------------------------------------
-- from base:
import Prelude ( (*) )
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 )
import Control.Monad ( (>>=), fail )
#endif
-- from async:
import Control.Concurrent.Async ( Concurrently(Concurrently), runConcurrently )
-- from concurrent-extra:
import qualified Control.Concurrent.ReadWriteLock as RWLock
( new, acquireWrite, acquireRead, releaseWrite, releaseRead, withRead, withWrite )
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
, testCase "stressTest" stressTest
]
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
stressTest :: Assertion
stressTest = assert $ within (1000 * 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
|
