LGTM
On Tue, Apr 8, 2014 at 2:02 PM, Klaus Aehlig <[email protected]> wrote: > Add a basic sanity check on notification: if a request is blocked, > and all old pending owners and blockers give up their resources, > the owner gets notified of his lock being granted. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > test/hs/Test/Ganeti/Locking/Waiting.hs | 18 ++++++++++++++++++ > 1 file changed, 18 insertions(+) > > diff --git a/test/hs/Test/Ganeti/Locking/Waiting.hs > b/test/hs/Test/Ganeti/Locking/Waiting.hs > index b0ce39f..8c17b98 100644 > --- a/test/hs/Test/Ganeti/Locking/Waiting.hs > +++ b/test/hs/Test/Ganeti/Locking/Waiting.hs > @@ -157,8 +157,26 @@ prop_PendingGetFulfilledEventually = > \ resources, a pending request must be granted > automatically" > $ all (requestSucceeded finallyOwned) req > > +-- | Verify that the owner of a pending request gets notified once all > blockers > +-- release their resources. > +prop_PendingGetNotifiedEventually :: Property > +prop_PendingGetNotifiedEventually = > + forAllBlocked $ \state owner prio req -> > + let oldpending = getPendingOwners state > + (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) > + $ S.union oldpending blockers > + in printTestCase "After all blockers and old pending owners give up > their\ > + \ resources, a pending owner must be notified" > + $ S.member owner notified > + > testSuite "Locking/Waiting" > [ 'prop_NoActionWithPendingRequests > , 'prop_WaitingRequestsGetPending > , 'prop_PendingGetFulfilledEventually > + , 'prop_PendingGetNotifiedEventually > ] > -- > 1.9.1.423.g4596e3a > >
