LGTM, thanks.
On Sat, Feb 15, 2014 at 12:40 AM, Klaus Aehlig <[email protected]> wrote: > Verify the minimal consistency property for any form > of lock handling: if a user holds an exclusive lock, > then no other user can hold the same lock (neither > exclusively, nor shared). > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > Makefile.am | 2 + > test/hs/Test/Ganeti/Locking/Allocation.hs | 106 > ++++++++++++++++++++++++++++++ > test/hs/htest.hs | 2 + > 3 files changed, 110 insertions(+) > create mode 100644 test/hs/Test/Ganeti/Locking/Allocation.hs > > diff --git a/Makefile.am b/Makefile.am > index 00b2e52..d1f5e63 100644 > --- a/Makefile.am > +++ b/Makefile.am > @@ -147,6 +147,7 @@ HS_DIRS = \ > test/hs/Test/Ganeti/HTools/Backend \ > test/hs/Test/Ganeti/Hypervisor \ > test/hs/Test/Ganeti/Hypervisor/Xen \ > + test/hs/Test/Ganeti/Locking \ > test/hs/Test/Ganeti/Query \ > test/hs/Test/Ganeti/THH > > @@ -809,6 +810,7 @@ HS_TEST_SRCS = \ > test/hs/Test/Ganeti/JQueue.hs \ > test/hs/Test/Ganeti/Kvmd.hs \ > test/hs/Test/Ganeti/Luxi.hs \ > + test/hs/Test/Ganeti/Locking/Allocation.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/Allocation.hs > b/test/hs/Test/Ganeti/Locking/Allocation.hs > new file mode 100644 > index 0000000..4f75f4d > --- /dev/null > +++ b/test/hs/Test/Ganeti/Locking/Allocation.hs > @@ -0,0 +1,106 @@ > +{-# LANGUAGE TemplateHaskell #-} > +{-# OPTIONS_GHC -fno-warn-orphans #-} > + > +{-| Tests for lock allocation. > + > +-} > + > +{- > + > +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.Allocation (testLocking_Allocation) where > + > +import Control.Applicative > +import qualified Data.Set as S > + > +import Test.QuickCheck > + > +import Test.Ganeti.TestHelper > + > +import Ganeti.Locking.Allocation > + > +{- > + > +Ganeti.Locking.Allocation is polymorphic in the types of locks > +and lock owners. So we can use much simpler types here than Ganeti's > +real locks and lock owners, knowning at polymorphic functions cannot > +exploit the simplicity of the types they're deling with. > + > +-} > + > +data TestOwner = TestOwner Int deriving (Ord, Eq, Show) > + > +instance Arbitrary TestOwner where > + arbitrary = TestOwner <$> choose (0, 7) > + > +data TestLock = TestLock Int deriving (Ord, Eq, Show) > + > +instance Arbitrary TestLock where > + arbitrary = TestLock <$> choose (0, 7) > + > + > +{- > + > +All states of a LockAllocation can be obtained by starting from the > +empty allocation, and sequentially requesting (successfully or not) > +lock updates. So we first define what arbitrary updates sequences are. > + > +-} > + > +instance Arbitrary a => Arbitrary (LockRequest a) where > + arbitrary = oneof [ ReqRelease <$> arbitrary > + , ReqShared <$> arbitrary > + , ReqExclusive <$> arbitrary > + ] > + > +data UpdateRequest a b = UpdateRequest a [LockRequest b] deriving Show > + > +instance (Arbitrary a, Arbitrary b) => Arbitrary (UpdateRequest a b) where > + arbitrary = UpdateRequest <$> arbitrary <*> arbitrary > + > +-- | Fold a sequence of update requests; all allocationscan be obtained in > +-- this way, starting from the empty allocation. > +foldUpdates :: (Ord a, Ord b, Show b) > + => LockAllocation b a -> [UpdateRequest a b] -> > LockAllocation b a > +foldUpdates = foldl (\s (UpdateRequest owner updates) -> > + fst $ updateLocks owner updates s) > + > +instance (Arbitrary a, Arbitrary b, Ord a, Ord b, Show a, Show b) > + => Arbitrary (LockAllocation a b) where > + arbitrary = foldUpdates emptyAllocation <$> arbitrary > + > +-- | Basic property of locking: the exclusive locks of one user > +-- are disjoint from any locks of any other user. > +prop_LocksDisjoint :: Property > +prop_LocksDisjoint = > + forAll (arbitrary :: Gen (LockAllocation TestLock TestOwner)) $ \state > -> > + forAll (arbitrary :: Gen TestOwner) $ \a -> > + forAll (arbitrary `suchThat` (/= a)) $ \b -> > + let aExclusive = S.map fst . S.filter ((==) OwnExclusive . snd) > + $ listLocks a state > + bAll = S.map fst $ listLocks b state > + in printTestCase > + (show a ++ "'s exclusive lock" ++ " is not respected by " ++ show b) > + (S.null $ S.intersection aExclusive bAll) > + > +testSuite "Locking/Allocation" > + [ 'prop_LocksDisjoint > + ] > diff --git a/test/hs/htest.hs b/test/hs/htest.hs > index f601efd..40ada70 100644 > --- a/test/hs/htest.hs > +++ b/test/hs/htest.hs > @@ -56,6 +56,7 @@ import Test.Ganeti.JSON > import Test.Ganeti.Jobs > import Test.Ganeti.JQueue > import Test.Ganeti.Kvmd > +import Test.Ganeti.Locking.Allocation > import Test.Ganeti.Luxi > import Test.Ganeti.Network > import Test.Ganeti.Objects > @@ -121,6 +122,7 @@ allTests = > , testJobs > , testJQueue > , testKvmd > + , testLocking_Allocation > , testLuxi > , testNetwork > , testObjects > -- > 1.9.0.rc1.175.g0b1dcb5 > >
