Revision 9bf17b50 test/hs/Test/Ganeti/Locking/Allocation.hs

b/test/hs/Test/Ganeti/Locking/Allocation.hs
29 29
module Test.Ganeti.Locking.Allocation (testLocking_Allocation) where
30 30

  
31 31
import Control.Applicative
32
import qualified Data.Foldable as F
32 33
import qualified Data.Map as M
33 34
import qualified Data.Set as S
34 35

  
......
164 165
       ++ show result)
165 166
     (isOk result)
166 167

  
168
-- | Verify the property that only the blocking owners prevent
169
-- lock allocation. We deliberatly go for the expensive variant
170
-- restraining by suchThat, as otherwise the number of cases actually
171
-- covered is too small.
172
prop_BlockSufficient :: Property
173
prop_BlockSufficient =
174
  forAll (arbitrary :: Gen TestOwner) $ \a ->
175
  forAll (arbitrary :: Gen TestLock) $ \lock ->
176
  forAll (elements [ [requestShared lock]
177
                   , [requestExclusive lock]]) $ \request ->
178
  forAll ((arbitrary :: Gen (LockAllocation TestLock TestOwner))
179
           `suchThat` (genericResult (const False) (not . S.null)
180
                        . snd . updateLocks a request)) $ \state ->
181
  let (_, result) = updateLocks a request state
182
      blockedOn = genericResult (const S.empty) id result
183
  in  printTestCase "After all blockers release, a request must succeed"
184
      . isOk . snd . updateLocks a request $ F.foldl freeLocks state blockedOn
185

  
167 186
testSuite "Locking/Allocation"
168 187
 [ 'prop_LocksDisjoint
169 188
 , 'prop_LocksStable
170 189
 , 'prop_LockupdateAtomic
171 190
 , 'prop_LockReleaseSucceeds
191
 , 'prop_BlockSufficient
172 192
 ]

Also available in: Unified diff