On Tue, Apr 8, 2014 at 2:02 PM, Klaus Aehlig <[email protected]> wrote:
> Add a verify first sanity check for lock waiting: a user that has a pending > request cannot modify his locks. This patch also brings in the necessary > infra structure for having arbitrary waiting structures. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > Makefile.am | 1 + > test/hs/Test/Ganeti/Locking/Waiting.hs | 107 > +++++++++++++++++++++++++++++++++ > test/hs/htest.hs | 2 + > 3 files changed, 110 insertions(+) > create mode 100644 test/hs/Test/Ganeti/Locking/Waiting.hs > > diff --git a/Makefile.am b/Makefile.am > index 1617dd3..eb39b74 100644 > --- a/Makefile.am > +++ b/Makefile.am > @@ -871,6 +871,7 @@ HS_TEST_SRCS = \ > test/hs/Test/Ganeti/Luxi.hs \ > test/hs/Test/Ganeti/Locking/Allocation.hs \ > test/hs/Test/Ganeti/Locking/Locks.hs \ > + test/hs/Test/Ganeti/Locking/Waiting.hs \ > test/hs/Test/Ganeti/Network.hs \ > test/hs/Test/Ganeti/Objects.hs \ > test/hs/Test/Ganeti/OpCodes.hs \ > diff --git a/test/hs/Test/Ganeti/Locking/Waiting.hs > b/test/hs/Test/Ganeti/Locking/Waiting.hs > new file mode 100644 > index 0000000..5796980 > --- /dev/null > +++ b/test/hs/Test/Ganeti/Locking/Waiting.hs > @@ -0,0 +1,107 @@ > +{-# LANGUAGE TemplateHaskell #-} > +{-# OPTIONS_GHC -fno-warn-orphans #-} > + > +{-| Tests for lock waiting structure. > + > +-} > + > +{- > + > +Copyright (C) 2014 Google Inc. > + > +This program is free software; you can redistribute it and/or modify > +it under the terms of the GNU General Public License as published by > +the Free Software Foundation; either version 2 of the License, or > +(at your option) any later version. > + > +This program is distributed in the hope that it will be useful, but > +WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU > +General Public License for more details. > + > +You should have received a copy of the GNU General Public License > +along with this program; if not, write to the Free Software > +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA > +02110-1301, USA. > + > +-} > + > +module Test.Ganeti.Locking.Waiting (testLocking_Waiting) where > + > +import Control.Applicative ((<$>), (<*>)) > +import qualified Data.Set as S > + > +import Test.QuickCheck > + > +import Test.Ganeti.TestHelper > +import Test.Ganeti.Locking.Allocation (TestLock, TestOwner) > + > +import Ganeti.BasicTypes (isBad) > +import Ganeti.Locking.Allocation (LockRequest) > +import Ganeti.Locking.Types (Lock) > +import Ganeti.Locking.Waiting > + > +{- > + > +Ganeti.Locking.Waiting is polymorphic in the types of locks, lock owners, > +and priorities. So we can use much simpler types here than Ganeti's > +real locks and lock owners, knowning that polymorphic functions cannot > +exploit the simplicity of the types they're deling with. To avoid code > +duplication, we use the test structure from > Test.Ganeti.Locking.Allocation. > + > +-} > + > +{- > + > +All states of a LockWaiting ever available outside the module can be > +obtained from @emptyWaiting@ applying one of the update operations. > + > +-} > + > +data UpdateRequest a b c = Update b [LockRequest a] > + | UpdateWaiting c b [LockRequest a] > + deriving Show > + > +instance (Arbitrary a, Arbitrary b, Arbitrary c) > + => Arbitrary (UpdateRequest a b c) where > + arbitrary = > + frequency [ (1, Update <$> arbitrary <*> (choose (1, 4) >>= vector)) > + , (2, UpdateWaiting <$> arbitrary <*> arbitrary > + <*> (choose (1, 4) >>= vector)) > + ] > + > +-- | Transform an UpdateRequest into the corresponding state transformer. > +asWaitingTrans :: (Lock a, Ord b, Ord c) > + => LockWaiting a b c -> UpdateRequest a b c -> LockWaiting > a b c > +asWaitingTrans state (Update owner req) = fst $ updateLocks owner req > state > +asWaitingTrans state (UpdateWaiting prio owner req) = > + fst $ updateLocksWaiting prio owner req state > + > + > +-- | Fold a sequence of requests to transform a waiting strucutre onto the > +-- empt waiting. As we consider all exported transformations, any waiting > s/empt /empty / > +-- structure can be obtained this way. > +foldUpdates :: (Lock a, Ord b, Ord c) > + => [UpdateRequest a b c] -> LockWaiting a b c > +foldUpdates = foldl asWaitingTrans emptyWaiting > + > +instance (Arbitrary a, Lock a, Arbitrary b, Ord b, Arbitrary c, Ord c) > + => Arbitrary (LockWaiting a b c) where > + arbitrary = foldUpdates <$> (choose (0, 8) >>= vector) > + > +-- | Verify that an owner with a pending request cannot make any > +-- changes to the lock structure. > +prop_NoActionWithPendingRequests :: Property > +prop_NoActionWithPendingRequests = > + forAll (arbitrary :: Gen TestOwner) $ \a -> > + forAll ((arbitrary :: Gen (LockWaiting TestLock TestOwner Integer)) > + `suchThat` (S.member a . getPendingOwners)) $ \state -> > + forAll (arbitrary :: Gen [LockRequest TestLock]) $ \req -> > + forAll arbitrary $ \prio -> > + printTestCase "Owners with pending requests may not update locks" > + . all (isBad . fst . snd) > + $ [updateLocks, updateLocksWaiting prio] <*> [a] <*> [req] <*> [state] > + > +testSuite "Locking/Waiting" > + [ 'prop_NoActionWithPendingRequests > + ] > diff --git a/test/hs/htest.hs b/test/hs/htest.hs > index 2c04020..17f047f 100644 > --- a/test/hs/htest.hs > +++ b/test/hs/htest.hs > @@ -58,6 +58,7 @@ import Test.Ganeti.JQueue > import Test.Ganeti.Kvmd > import Test.Ganeti.Locking.Allocation > import Test.Ganeti.Locking.Locks > +import Test.Ganeti.Locking.Waiting > import Test.Ganeti.Luxi > import Test.Ganeti.Network > import Test.Ganeti.Objects > @@ -125,6 +126,7 @@ allTests = > , testKvmd > , testLocking_Allocation > , testLocking_Locks > + , testLocking_Waiting > , testLuxi > , testNetwork > , testObjects > -- > 1.9.1.423.g4596e3a > > LGTM
