Revision 64df329d
b/test/hs/Test/Ganeti/Locking/Allocation.hs | ||
---|---|---|
183 | 183 |
in printTestCase "After all blockers release, a request must succeed" |
184 | 184 |
. isOk . snd . updateLocks a request $ F.foldl freeLocks state blockedOn |
185 | 185 |
|
186 |
-- | Verify the property that every blocking owner is necessary, i.e., even |
|
187 |
-- if we only keep the locks of one of the blocking owners, the request still |
|
188 |
-- will be blocked. We deliberatly use the expensive variant of restraining |
|
189 |
-- to ensure good coverage. To make sure the request can always be blocked |
|
190 |
-- by two owners, for a shared request we request two different locks. |
|
191 |
prop_BlockNecessary :: Property |
|
192 |
prop_BlockNecessary = |
|
193 |
forAll (arbitrary :: Gen TestOwner) $ \a -> |
|
194 |
forAll (arbitrary :: Gen TestLock) $ \lock -> |
|
195 |
forAll (arbitrary `suchThat` (/= lock)) $ \lock' -> |
|
196 |
forAll (elements [ [requestShared lock, requestShared lock'] |
|
197 |
, [requestExclusive lock]]) $ \request -> |
|
198 |
forAll ((arbitrary :: Gen (LockAllocation TestLock TestOwner)) |
|
199 |
`suchThat` (genericResult (const False) ((>= 2) . S.size) |
|
200 |
. snd . updateLocks a request)) $ \state -> |
|
201 |
let (_, result) = updateLocks a request state |
|
202 |
blockers = genericResult (const S.empty) id result |
|
203 |
in printTestCase "Each blocker alone must block the request" |
|
204 |
. flip all (S.elems blockers) $ \blocker -> |
|
205 |
(==) (Ok $ S.singleton blocker) . snd . updateLocks a request |
|
206 |
. F.foldl freeLocks state |
|
207 |
$ S.filter (/= blocker) blockers |
|
208 |
|
|
186 | 209 |
testSuite "Locking/Allocation" |
187 | 210 |
[ 'prop_LocksDisjoint |
188 | 211 |
, 'prop_LocksStable |
189 | 212 |
, 'prop_LockupdateAtomic |
190 | 213 |
, 'prop_LockReleaseSucceeds |
191 | 214 |
, 'prop_BlockSufficient |
215 |
, 'prop_BlockNecessary |
|
192 | 216 |
] |
Also available in: Unified diff