LGTM, thanks
On Thu, Feb 20, 2014 at 5:02 PM, Klaus Aehlig <[email protected]> wrote: > Verify that the result returned by the opportunistic union correctly > reflects the state change: locks not in the result are not changed, > locks in the result are as requested. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > test/hs/Test/Ganeti/Locking/Allocation.hs | 32 > +++++++++++++++++++++++++++++++ > 1 file changed, 32 insertions(+) > > diff --git a/test/hs/Test/Ganeti/Locking/Allocation.hs > b/test/hs/Test/Ganeti/Locking/Allocation.hs > index 0e3ba17..49a9bee 100644 > --- a/test/hs/Test/Ganeti/Locking/Allocation.hs > +++ b/test/hs/Test/Ganeti/Locking/Allocation.hs > @@ -271,6 +271,37 @@ prop_OpportunisticMonotone = > . flip all oldLocks $ \lock -> > (>=) (M.lookup lock newOwned) (M.lookup lock oldOwned) > > +-- | Verify the result list of the opportunistic union: if a lock is not > in > +-- the result that, than its state has not changed, and if it is, it is as > +-- requested. The latter property is tested in that liberal way, so that > we > +-- really can take arbitrary requests, including those that require both, > shared > +-- and exlusive state for the same lock. > +prop_OpportunisticAnswer :: Property > +prop_OpportunisticAnswer = > + forAll (arbitrary :: Gen (LockAllocation TestLock TestOwner)) $ \state > -> > + forAll (arbitrary :: Gen TestOwner) $ \a -> > + forAll ((choose (1,3) >>= vector) :: Gen [(TestLock, OwnerState)]) $ > \req -> > + let (state', result) = opportunisticLockUnion a req state > + oldOwned = listLocks a state > + newOwned = listLocks a state' > + involvedLocks = M.keys oldOwned ++ map fst req > + in conjoin [ printTestCase ("Locks not in the answer set " ++ show > result > + ++ " may not be changed, but found " > + ++ show state') > + . flip all involvedLocks $ \lock -> > + (lock `S.member` result) > + || (M.lookup lock oldOwned == M.lookup lock newOwned) > + , printTestCase ("Locks not in the answer set " ++ show > result > + ++ " must be as requested, but found " > + ++ show state') > + . flip all involvedLocks $ \lock -> > + (lock `S.notMember` result) > + || maybe False (flip elem req . (,) lock) > + (M.lookup lock newOwned) > + ] > + > + > + > testSuite "Locking/Allocation" > [ 'prop_LocksDisjoint > , 'prop_LockImplicationX > @@ -281,4 +312,5 @@ testSuite "Locking/Allocation" > , 'prop_BlockSufficient > , 'prop_BlockNecessary > , 'prop_OpportunisticMonotone > + , 'prop_OpportunisticAnswer > ] > -- > 1.9.0.rc1.175.g0b1dcb5 > >
