Commit dce9bbb3 authored by Iustin Pop's avatar Iustin Pop
Browse files

Add a complex allocation/serialisation/load test



This is unfortunately a complex test that checks if:

- starting from a empty cluster
- allocating a few instances on it
- serialising it via the Text backend
- loading it back into internal data structures

we end up with the same thing. More precisely, it checks that the
cluster after dump/load is the same as after allocation.

While this is in the Text unittests, as the docstring saying, this
check more stuff than just the dump/load. It increases the overall
coverage by about 3%.

There were a few changes needed for this unittest: adding some Eq
instances for some data types, and fixing a cosmetic bug in
Cluster.iterateAlloc, where the instance indices were growing by 2
instead of by 1 in each round.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarRené Nussbaumer <rn@google.com>
parent e73c5fe2
...@@ -1161,7 +1161,7 @@ iterateAlloc :: AllocMethod ...@@ -1161,7 +1161,7 @@ iterateAlloc :: AllocMethod
iterateAlloc nl il limit newinst allocnodes ixes cstats = iterateAlloc nl il limit newinst allocnodes ixes cstats =
let depth = length ixes let depth = length ixes
newname = printf "new-%d" depth::String newname = printf "new-%d" depth::String
newidx = Container.size il + depth newidx = Container.size il
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
newlimit = fmap (flip (-) 1) limit newlimit = fmap (flip (-) 1) limit
in case tryAlloc nl il newi2 allocnodes of in case tryAlloc nl il newi2 allocnodes of
......
...@@ -79,7 +79,7 @@ data Instance = Instance ...@@ -79,7 +79,7 @@ data Instance = Instance
, autoBalance :: Bool -- ^ Is the instance auto-balanced? , autoBalance :: Bool -- ^ Is the instance auto-balanced?
, tags :: [String] -- ^ List of instance tags , tags :: [String] -- ^ List of instance tags
, diskTemplate :: T.DiskTemplate -- ^ The disk template of the instance , diskTemplate :: T.DiskTemplate -- ^ The disk template of the instance
} deriving (Show, Read) } deriving (Show, Read, Eq)
instance T.Element Instance where instance T.Element Instance where
nameOf = name nameOf = name
......
...@@ -91,7 +91,7 @@ data ClusterData = ClusterData ...@@ -91,7 +91,7 @@ data ClusterData = ClusterData
, cdInstances :: Instance.List -- ^ The instance list , cdInstances :: Instance.List -- ^ The instance list
, cdTags :: [String] -- ^ The cluster tags , cdTags :: [String] -- ^ The cluster tags
, cdIPolicy :: IPolicy -- ^ The cluster instance policy , cdIPolicy :: IPolicy -- ^ The cluster instance policy
} deriving (Show, Read) } deriving (Show, Read, Eq)
-- | The priority of a match in a lookup result. -- | The priority of a match in a lookup result.
data MatchPriority = ExactMatch data MatchPriority = ExactMatch
......
...@@ -146,6 +146,12 @@ setInstanceSmallerThanNode node inst = ...@@ -146,6 +146,12 @@ setInstanceSmallerThanNode node inst =
, Instance.vcpus = Node.availCpu node `div` 2 , Instance.vcpus = Node.availCpu node `div` 2
} }
-- | Check if an instance is smaller than a node.
isInstanceSmallerThanNode node inst =
Instance.mem inst <= Node.availMem node `div` 2 &&
Instance.dsk inst <= Node.availDisk node `div` 2 &&
Instance.vcpus inst <= Node.availCpu node `div` 2
-- | Create an instance given its spec. -- | Create an instance given its spec.
createInstance mem dsk vcpus = createInstance mem dsk vcpus =
Instance.create "inst-unnamed" mem dsk vcpus Types.Running [] True (-1) (-1) Instance.create "inst-unnamed" mem dsk vcpus Types.Running [] True (-1) (-1)
...@@ -223,6 +229,38 @@ getFQDN = do ...@@ -223,6 +229,38 @@ getFQDN = do
let frest' = map (map dnsGetChar) frest let frest' = map (map dnsGetChar) frest
return (felem ++ "." ++ intercalate "." frest') return (felem ++ "." ++ intercalate "." frest')
-- | Defines a tag type.
newtype TagChar = TagChar { tagGetChar :: Char }
-- | All valid tag chars. This doesn't need to match _exactly_
-- Ganeti's own tag regex, just enough for it to be close.
tagChar :: [Char]
tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
instance Arbitrary TagChar where
arbitrary = do
c <- elements tagChar
return (TagChar c)
-- | Generates a tag
genTag :: Gen [TagChar]
genTag = do
-- the correct value would be C.maxTagLen, but that's way too
-- verbose in unittests, and at the moment I don't see any possible
-- bugs with longer tags and the way we use tags in htools
n <- choose (1, 10)
vector n
-- | Generates a list of tags (correctly upper bounded).
genTags :: Gen [String]
genTags = do
-- the correct value would be C.maxTagsPerObj, but per the comment
-- in genTag, we don't use tags enough in htools to warrant testing
-- such big values
n <- choose (0, 10::Int)
tags <- mapM (const genTag) [1..n]
return $ map (map tagGetChar) tags
instance Arbitrary Types.InstanceStatus where instance Arbitrary Types.InstanceStatus where
arbitrary = elements [minBound..maxBound] arbitrary = elements [minBound..maxBound]
...@@ -732,12 +770,53 @@ prop_Text_NodeLSIdempotent node = ...@@ -732,12 +770,53 @@ prop_Text_NodeLSIdempotent node =
where n = node { Node.failN1 = True, Node.offline = False where n = node { Node.failN1 = True, Node.offline = False
, Node.iPolicy = Types.defIPolicy } , Node.iPolicy = Types.defIPolicy }
-- | This property, while being in the text tests, does more than just
-- test end-to-end the serialisation and loading back workflow; it
-- also tests the Loader.mergeData and the actuall
-- Cluster.iterateAlloc (for well-behaving w.r.t. instance
-- allocations, not for the business logic). As such, it's a quite
-- complex and slow test, and that's the reason we restrict it to
-- small cluster sizes.
prop_Text_CreateSerialise =
forAll genTags $ \ctags ->
forAll (choose (1, 2)) $ \reqnodes ->
forAll (choose (1, 20)) $ \maxiter ->
forAll (choose (2, 10)) $ \count ->
forAll genOnlineNode $ \node ->
forAll (arbitrary `suchThat` isInstanceSmallerThanNode node) $ \inst ->
let inst' = Instance.setMovable inst $ Utils.if' (reqnodes == 2) True False
nl = makeSmallCluster node count
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= \allocn ->
Cluster.iterateAlloc nl Container.empty (Just maxiter) inst' allocn [] []
of
Types.Bad msg -> printTestCase ("Failed to allocate: " ++ msg) False
Types.Ok (_, _, _, [], _) -> printTestCase
"Failed to allocate: no allocations" False
Types.Ok (_, nl', il', _, _) ->
let cdata = Loader.ClusterData defGroupList nl' il' ctags
Types.defIPolicy
saved = Text.serializeCluster cdata
in case Text.parseData saved >>= Loader.mergeData [] [] [] [] of
Types.Bad msg -> printTestCase ("Failed to load/merge: " ++
msg) False
Types.Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) ->
ctags ==? ctags2 .&&.
Types.defIPolicy ==? cpol2 .&&.
il' ==? il2 .&&.
-- we need to override the policy manually for now for
-- nodes and groups
defGroupList ==? (Container.map (\g -> g { Group.iPolicy =
nullIPolicy } )
gl2) .&&.
nl' ==? Container.map (Node.setPolicy nullIPolicy) nl2
testSuite "Text" testSuite "Text"
[ 'prop_Text_Load_Instance [ 'prop_Text_Load_Instance
, 'prop_Text_Load_InstanceFail , 'prop_Text_Load_InstanceFail
, 'prop_Text_Load_Node , 'prop_Text_Load_Node
, 'prop_Text_Load_NodeFail , 'prop_Text_Load_NodeFail
, 'prop_Text_NodeLSIdempotent , 'prop_Text_NodeLSIdempotent
, 'prop_Text_CreateSerialise
] ]
-- ** Node tests -- ** Node tests
......
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