Commit e247c590 authored by Klaus Aehlig's avatar Klaus Aehlig
Browse files

Verify soundness of notifications



Verify that, if a lock owner gets notified, he
- had a pending request, and
- the request is fulfilled now.
Signed-off-by: default avatarKlaus Aehlig <aehlig@google.com>
Reviewed-by: default avatarPetr Pudlak <pudlak@google.com>
parent f24f0e5c
...@@ -37,7 +37,7 @@ import Test.QuickCheck ...@@ -37,7 +37,7 @@ import Test.QuickCheck
import Test.Ganeti.TestHelper import Test.Ganeti.TestHelper
import Test.Ganeti.Locking.Allocation (TestLock, TestOwner, requestSucceeded) import Test.Ganeti.Locking.Allocation (TestLock, TestOwner, requestSucceeded)
import Ganeti.BasicTypes (isBad, genericResult) import Ganeti.BasicTypes (isBad, genericResult, runListHead)
import Ganeti.Locking.Allocation (LockRequest, listLocks) import Ganeti.Locking.Allocation (LockRequest, listLocks)
import Ganeti.Locking.Types (Lock) import Ganeti.Locking.Types (Lock)
import Ganeti.Locking.Waiting import Ganeti.Locking.Waiting
...@@ -190,10 +190,33 @@ prop_Progress = ...@@ -190,10 +190,33 @@ prop_Progress =
\ their locks" \ their locks"
. not . S.null $ notified S.\\ blockers . not . S.null $ notified S.\\ blockers
-- | Verify that the notifications send out are sound, i.e., upon notification
-- the requests actually are fulfilled. To be sure to have at least one
-- notification we, again, use the scenario that a request is blocked and then
-- all the blockers release their resources.
prop_ProgressSound :: Property
prop_ProgressSound =
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)
(state'', notified) = S.foldl releaseOneOwner (state', S.empty) blockers
requestFulfilled o =
runListHead False
(\(_, _, r) ->
all (requestSucceeded . listLocks o $ getAllocation state'') r)
. S.toList . S.filter (\(_, b, _) -> b == o)
. getPendingRequests $ state'
in printTestCase "If an owner gets notified, his request must be satisfied"
. all requestFulfilled . S.toList $ notified S.\\ blockers
testSuite "Locking/Waiting" testSuite "Locking/Waiting"
[ 'prop_NoActionWithPendingRequests [ 'prop_NoActionWithPendingRequests
, 'prop_WaitingRequestsGetPending , 'prop_WaitingRequestsGetPending
, 'prop_PendingGetFulfilledEventually , 'prop_PendingGetFulfilledEventually
, 'prop_PendingGetNotifiedEventually , 'prop_PendingGetNotifiedEventually
, 'prop_Progress , 'prop_Progress
, 'prop_ProgressSound
] ]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment