Tests specifying safeUpdateLocksWaiting
authorKlaus Aehlig <aehlig@google.com>
Fri, 29 May 2015 16:27:19 +0000 (18:27 +0200)
committerKlaus Aehlig <aehlig@google.com>
Mon, 1 Jun 2015 08:19:27 +0000 (10:19 +0200)
Add tests that verify the defining properties of safeUpdateLocksWaiting.

1.) If the state contains no pending request by the requester, then
    updateLocksWaiting and safeUpdateLocksWaiting coincide.

2.) safeUpdateLocksWaiting is idempotent on all states.

Signed-off-by: Klaus Aehlig <aehlig@google.com>
Reviewed-by: Petr Pudlak <pudlak@google.com>

test/hs/Test/Ganeti/Locking/Waiting.hs

index 915f5c5..3950663 100644 (file)
@@ -310,6 +310,46 @@ prop_SimulateUpdateLocksWaiting =
            , extRepr finState == extRepr finState'
            ]
 
+-- | Verify that if a requestor has no pending requests, `safeUpdateWaiting`
+-- conincides with `updateLocksWaiting`.
+prop_SafeUpdateWaitingCorrect :: Property
+prop_SafeUpdateWaitingCorrect  =
+  forAll (arbitrary :: Gen TestOwner) $ \owner ->
+  forAll ((arbitrary :: Gen (LockWaiting TestLock TestOwner Integer))
+          `suchThat` (not . hasPendingRequest owner)) $ \state ->
+  forAll (arbitrary :: Gen Integer) $ \prio ->
+  forAll (arbitrary :: Gen [LockRequest TestLock]) $ \req ->
+  let (state', answer') = updateLocksWaiting prio owner req state
+      (state'', answer'') = safeUpdateLocksWaiting prio owner req state
+  in conjoin [ printTestCase ("safeUpdateLocksWaiting gave different answer: "
+                              ++ show answer' ++ " /= " ++ show answer'')
+               $ answer' == answer''
+             , printTestCase ("safeUpdateLocksWaiting gave different states\
+                              \ after answer " ++ show answer' ++ ": "
+                              ++ show (extRepr state') ++ " /= "
+                              ++ show (extRepr state''))
+               $ extRepr state' == extRepr state''
+             ]
+
+-- | Verify that `safeUpdateLocksWaiting` is idempotent, that in the repetition
+-- no notifications are done.
+prop_SafeUpdateWaitingIdempotent :: Property
+prop_SafeUpdateWaitingIdempotent =
+  forAll (arbitrary :: Gen (LockWaiting TestLock TestOwner Integer)) $ \state ->
+  forAll (arbitrary :: Gen TestOwner) $ \owner ->
+  forAll (arbitrary :: Gen Integer) $ \prio ->
+  forAll (arbitrary :: Gen [LockRequest TestLock]) $ \req ->
+  let (state', (answer', _)) = safeUpdateLocksWaiting prio owner req state
+      (state'', (answer'', nfy)) = safeUpdateLocksWaiting prio owner req state'
+  in conjoin [ printTestCase ("repeated safeUpdateLocks waiting gave different\
+                              \ answers: " ++ show answer' ++ " /= "
+                              ++ show answer'') $ answer' == answer''
+             , printTestCase "safeUpdateLocksWaiting not idempotent"
+               $ extRepr state' == extRepr state''
+             , printTestCase ("notifications (" ++ show nfy ++ ") on replay")
+               $ S.null nfy
+             ]
+
 -- | Verify that for LockWaiting we have readJSON . showJSON is extensionally
 -- equivalent to Ok.
 prop_ReadShow :: Property
@@ -374,6 +414,8 @@ testSuite "Locking/Waiting"
  , 'prop_SimulateUpdateLocks
  , 'prop_SimulateUpdateLocksWaiting
  , 'prop_ReadShow
+ , 'prop_SafeUpdateWaitingCorrect
+ , 'prop_SafeUpdateWaitingIdempotent
  , 'prop_OpportunisticMonotone
  , 'prop_OpportunisticAnswer
  ]