LGTM, thanks.
On Tue, Apr 8, 2014 at 2:02 PM, Klaus Aehlig <[email protected]> wrote: > Add a basic sanity check for progress on pending requests. If a > request is pending and all owners it is blocked on release their > locks, there is at least one pending request that can be granted > (the said one). So verify that at least one owner gets notified > of the granting of his request. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > test/hs/Test/Ganeti/Locking/Waiting.hs | 17 +++++++++++++++++ > 1 file changed, 17 insertions(+) > > diff --git a/test/hs/Test/Ganeti/Locking/Waiting.hs > b/test/hs/Test/Ganeti/Locking/Waiting.hs > index 8c17b98..b684fef 100644 > --- a/test/hs/Test/Ganeti/Locking/Waiting.hs > +++ b/test/hs/Test/Ganeti/Locking/Waiting.hs > @@ -174,9 +174,26 @@ prop_PendingGetNotifiedEventually = > \ resources, a pending owner must be notified" > $ S.member owner notified > > +-- | Verify that some progress is made after the direct blockers give up > their > +-- locks. Note that we cannot guarantee that the original requester gets > its > +-- request granted, as someone else might have a more important priority. > +prop_Progress :: Property > +prop_Progress = > + forAllBlocked $ \state owner prio req -> > + let (state', (resultBlockers, _)) = updateLocksWaiting prio owner req > state > + blockers = genericResult (const S.empty) id resultBlockers > + releaseOneOwner (s, tonotify) o = > + let (s', newnotify) = releaseResources o s > + in (s', newnotify `S.union` tonotify) > + (_, notified) = S.foldl releaseOneOwner (state', S.empty) blockers > + in printTestCase "Some progress must be made after all blockers release\ > + \ their locks" > + . not $ S.null notified > + > testSuite "Locking/Waiting" > [ 'prop_NoActionWithPendingRequests > , 'prop_WaitingRequestsGetPending > , 'prop_PendingGetFulfilledEventually > , 'prop_PendingGetNotifiedEventually > + , 'prop_Progress > ] > -- > 1.9.1.423.g4596e3a > >
