On Tue, Feb 18, 2014 at 3:28 PM, Klaus Aehlig <[email protected]> wrote:
> If a request is blocked by multiple lock owners, verify that each > single one of them actually blocks the request. In other words, > verify that, whenever all but one release their lock, the request > still does not succeed. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > test/hs/Test/Ganeti/Locking/Allocation.hs | 24 ++++++++++++++++++++++++ > 1 file changed, 24 insertions(+) > > diff --git a/test/hs/Test/Ganeti/Locking/Allocation.hs > b/test/hs/Test/Ganeti/Locking/Allocation.hs > index b5209fc..4496e4d 100644 > --- a/test/hs/Test/Ganeti/Locking/Allocation.hs > +++ b/test/hs/Test/Ganeti/Locking/Allocation.hs > @@ -188,10 +188,34 @@ prop_BlockSufficient = > in printTestCase "After all blockers release, a request must succeed" > . isOk . snd . updateLocks a request $ S.foldl freeLocks state > blockedOn > > +-- | Verify the property that every blocking owner is necessary, i.e., > even > +-- if we only keep the locks of one of the blocking owners, the request > still > +-- will be blocked. We deliberatly use the expensive variant of > restraining > +-- to ensure good coverage. To make sure, the request can always be > blocked > +-- by two owners, for a shared request, we request two different locks. > Just nitpicking: I'd remove the commas after "sure" and "request", because they confused me a bit at first, but I'm not a native speaker, so it's just a guess > +prop_BlockNecessary :: Property > +prop_BlockNecessary = > + forAll (arbitrary :: Gen TestOwner) $ \a -> > + forAll (arbitrary :: Gen TestLock) $ \lock -> > + forAll (arbitrary `suchThat` (/= lock)) $ \lock' -> > + forAll (elements [ [requestShared lock, requestShared lock'] > + , [requestExclusive lock]]) $ \request -> > + forAll ((arbitrary :: Gen (LockAllocation TestLock TestOwner)) > + `suchThat` (genericResult (const False) ((>= 2) . S.size) > + . snd . updateLocks a request)) $ \state -> > + let (_, result) = updateLocks a request state > + blockers = genericResult (const S.empty) id result > + in printTestCase "Each blocker alone must block the request" > + . flip all (S.elems blockers) $ \blocker -> > + (==) (Ok $ S.singleton blocker) . snd . updateLocks a request > + . S.foldl freeLocks state > + $ S.filter (/= blocker) blockers > + > testSuite "Locking/Allocation" > [ 'prop_LocksDisjoint > , 'prop_LocksStable > , 'prop_LockupdateAtomic > , 'prop_LockReleaseSucceeds > , 'prop_BlockSufficient > + , 'prop_BlockNecessary > ] > -- > 1.9.0.rc1.175.g0b1dcb5 > > Otherwise LGTM (including the Foldable interdiff), no need to resend.
