On Thu, Feb 20, 2014 at 5:02 PM, Klaus Aehlig <[email protected]> wrote:

> Add a test verifying that by opportunistic union the set of locks
> held, and the level at which the locks are held, only increases.
>
> Signed-off-by: Klaus Aehlig <[email protected]>
> ---
>  test/hs/Test/Ganeti/Locking/Allocation.hs | 15 +++++++++++++++
>  1 file changed, 15 insertions(+)
>
> diff --git a/test/hs/Test/Ganeti/Locking/Allocation.hs
> b/test/hs/Test/Ganeti/Locking/Allocation.hs
> index 257d281..0e3ba17 100644
> --- a/test/hs/Test/Ganeti/Locking/Allocation.hs
> +++ b/test/hs/Test/Ganeti/Locking/Allocation.hs
> @@ -257,6 +257,20 @@ prop_BlockNecessary =
>          . F.foldl freeLocks state
>          $ S.filter (/= blocker) blockers
>
> +-- | Verify that opportunistic union only increases the locks held.
> +prop_OpportunisticMonotone :: Property
> +prop_OpportunisticMonotone =
> +  forAll (arbitrary :: Gen (LockAllocation TestLock TestOwner)) $ \state
> ->
> +  forAll (arbitrary :: Gen TestOwner) $ \a ->
> +  forAll ((choose (1,3) >>= vector) :: Gen [(TestLock, OwnerState)]) $
> \req ->
> +  let (state', _) = opportunisticLockUnion a req state
> +      oldOwned = listLocks a state
> +      oldLocks = M.keys oldOwned
> +      newOwned = listLocks a state'
> +  in printTestCase "Opportunistic union may only increase the set of
> locks held"
> +     . flip all oldLocks $ \lock ->
> +       (>=) (M.lookup lock newOwned) (M.lookup lock oldOwned)
>

I'd suggest just

       M.lookup lock newOwned >= M.lookup lock oldOwned



> +
>  testSuite "Locking/Allocation"
>   [ 'prop_LocksDisjoint
>   , 'prop_LockImplicationX
> @@ -266,4 +280,5 @@ testSuite "Locking/Allocation"
>   , 'prop_LockReleaseSucceeds
>   , 'prop_BlockSufficient
>   , 'prop_BlockNecessary
> + , 'prop_OpportunisticMonotone
>   ]
> --
> 1.9.0.rc1.175.g0b1dcb5
>
>
Otherwise LGTM, no need to resend.

Reply via email to