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

Clean up from LockAllocation what is no longer used



With the change from LockAllocations to LockWaitings, several
manipulation operations had to be implemented for LockWaitings
and became unused in LockAllocation. Remove these functions that
are no longer used.
Signed-off-by: default avatarKlaus Aehlig <aehlig@google.com>
Reviewed-by: default avatarPetr Pudlak <pudlak@google.com>
parent 39c1e700
......@@ -38,17 +38,12 @@ module Ganeti.Locking.Allocation
, requestRelease
, updateLocks
, freeLocks
, freeLocksPredicate
, downGradePredicate
, intersectLocks
, opportunisticLockUnion
) where
import Control.Applicative (liftA2, (<$>), (<*>), pure)
import Control.Arrow (second, (***))
import Control.Monad
import Data.Foldable (for_, find)
import Data.List (sort)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import qualified Data.Set as S
......@@ -353,39 +348,6 @@ freeLocksPredicate prop = flip $ manipulateLocksPredicate requestRelease prop
freeLocks :: (Lock a, Ord b) => LockAllocation a b -> b -> LockAllocation a b
freeLocks = freeLocksPredicate (const True)
-- | Downgrade to shared all locks held that satisfy a given predicate.
downGradePredicate :: (Lock a, Ord b)
=> (a -> Bool)
-> b -> LockAllocation a b -> LockAllocation a b
downGradePredicate = manipulateLocksPredicate requestShared
-- | Restrict the locks of a user to a given set.
intersectLocks :: (Lock a, Ord b) => b -> [a]
-> LockAllocation a b -> LockAllocation a b
intersectLocks owner locks state =
let lockset = S.fromList locks
toFree = filter (not . flip S.member lockset)
. M.keys $ listLocks owner state
in fst $ updateLocks owner (map requestRelease toFree) state
-- | Opportunistically allocate locks for a given user; return the set
-- of actually acquired. The signature is chosen to be suitable for
-- atomicModifyIORef.
opportunisticLockUnion :: (Lock a, Ord b)
=> b -> [(a, OwnerState)]
-> LockAllocation a b -> (LockAllocation a b, S.Set a)
opportunisticLockUnion owner reqs state =
let locks = listLocks owner state
reqs' = sort $ filter (uncurry (<) . (flip M.lookup locks *** Just)) reqs
maybeAllocate (s, success) (lock, ownstate) =
let (s', result) = updateLocks owner
[(if ownstate == OwnShared
then requestShared
else requestExclusive) lock]
s
in (s', if result == Ok S.empty then lock:success else success)
in second S.fromList $ foldl maybeAllocate (state, []) reqs'
{-| Serializaiton of Lock Allocations
To serialize a lock allocation, we only remember which owner holds
......
......@@ -100,18 +100,12 @@ instance Arbitrary a => Arbitrary (LockRequest a) where
arbitrary = LockRequest <$> arbitrary <*> genMaybe arbitrary
data UpdateRequest b a = UpdateRequest b [LockRequest a]
| IntersectRequest b [a]
| OpportunisticUnion b [(a, OwnerState)]
| FreeLockRequest b
deriving Show
instance (Arbitrary a, Arbitrary b) => Arbitrary (UpdateRequest a b) where
arbitrary =
frequency [ (4, UpdateRequest <$> arbitrary <*> (choose (1, 4) >>= vector))
, (2, IntersectRequest <$> arbitrary
<*> (choose (1, 4) >>= vector))
, (2, OpportunisticUnion <$> arbitrary
<*> (choose (1, 4) >>= vector))
, (1, FreeLockRequest <$> arbitrary)
]
......@@ -120,10 +114,6 @@ asAllocTrans :: (Lock a, Ord b, Show b)
=> LockAllocation a b -> UpdateRequest b a -> LockAllocation a b
asAllocTrans state (UpdateRequest owner updates) =
fst $ updateLocks owner updates state
asAllocTrans state (IntersectRequest owner locks) =
intersectLocks owner locks state
asAllocTrans state (OpportunisticUnion owner locks) =
fst $ opportunisticLockUnion owner locks state
asAllocTrans state (FreeLockRequest owner) = freeLocks state owner
-- | Fold a sequence of requests to transform a lock allocation onto the empty
......@@ -308,49 +298,6 @@ 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
-- | Verify the result list of the opportunistic union: if a lock is not in
-- the result that, than its state has not changed, and if it is, it is as
-- requested. The latter property is tested in that liberal way, so that we
-- really can take arbitrary requests, including those that require both, shared
-- and exlusive state for the same lock.
prop_OpportunisticAnswer :: Property
prop_OpportunisticAnswer =
forAll (arbitrary :: Gen (LockAllocation TestLock TestOwner)) $ \state ->
forAll (arbitrary :: Gen TestOwner) $ \a ->
forAll ((choose (1,3) >>= vector) :: Gen [(TestLock, OwnerState)]) $ \req ->
let (state', result) = opportunisticLockUnion a req state
oldOwned = listLocks a state
newOwned = listLocks a state'
involvedLocks = M.keys oldOwned ++ map fst req
in conjoin [ printTestCase ("Locks not in the answer set " ++ show result
++ " may not be changed, but found "
++ show state')
. flip all involvedLocks $ \lock ->
(lock `S.member` result)
|| (M.lookup lock oldOwned == M.lookup lock newOwned)
, printTestCase ("Locks not in the answer set " ++ show result
++ " must be as requested, but found "
++ show state')
. flip all involvedLocks $ \lock ->
(lock `S.notMember` result)
|| maybe False (flip elem req . (,) lock)
(M.lookup lock newOwned)
]
instance J.JSON TestOwner where
showJSON (TestOwner x) = J.showJSON x
readJSON = (>>= return . TestOwner) . J.readJSON
......@@ -400,8 +347,6 @@ testSuite "Locking/Allocation"
, 'prop_LockReleaseSucceeds
, 'prop_BlockSufficient
, 'prop_BlockNecessary
, 'prop_OpportunisticMonotone
, 'prop_OpportunisticAnswer
, 'prop_ReadShow
, 'prop_OwnerComplete
, 'prop_OwnerSound
......
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