From 8f48f67d8c4efd85470951c1f07162d9be92b75c Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Wed, 6 Jul 2011 22:30:42 +0200
Subject: [PATCH] htools: add optional limit to allocation count
Currently, the tieredAlloc/iterateAlloc functions will not return
until the allocation fails; this means unit-testing their
functionality (e.g. that an instance can be allocated) is slow, since
they will allocate all possible instances.
This patch adds an optional limit that allows allocation to return
early; this makes the cluster unittests twice as fast.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
htools/Ganeti/HTools/Cluster.hs | 33 +++++++++++++++++++++++----------
htools/Ganeti/HTools/QC.hs | 4 ++--
htools/hspace.hs | 5 +++--
3 files changed, 28 insertions(+), 14 deletions(-)
diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs
index fbca04a5d..42a91de5c 100644
--- a/htools/Ganeti/HTools/Cluster.hs
+++ b/htools/Ganeti/HTools/Cluster.hs
@@ -1036,45 +1036,58 @@ tryNodeEvac _ ini_nl ini_il mode idxs =
-- | Recursively place instances on the cluster until we're out of space.
iterateAlloc :: Node.List
-> Instance.List
+ -> Maybe Int
-> Instance.Instance
-> AllocNodes
-> [Instance.Instance]
-> [CStats]
-> Result AllocResult
-iterateAlloc nl il newinst allocnodes ixes cstats =
+iterateAlloc nl il limit newinst allocnodes ixes cstats =
let depth = length ixes
newname = printf "new-%d" depth::String
newidx = length (Container.elems il) + depth
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
+ newlimit = fmap (flip (-) 1) limit
in case tryAlloc nl il newi2 allocnodes of
Bad s -> Bad s
Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) ->
+ let newsol = Ok (collapseFailures errs, nl, il, ixes, cstats) in
case sols3 of
- [] -> Ok (collapseFailures errs, nl, il, ixes, cstats)
+ [] -> newsol
(xnl, xi, _, _):[] ->
- iterateAlloc xnl (Container.add newidx xi il)
- newinst allocnodes (xi:ixes)
- (totalResources xnl:cstats)
+ if limit == Just 0
+ then newsol
+ else iterateAlloc xnl (Container.add newidx xi il)
+ newlimit newinst allocnodes (xi:ixes)
+ (totalResources xnl:cstats)
_ -> Bad "Internal error: multiple solutions for single\
\ allocation"
-- | The core of the tiered allocation mode.
tieredAlloc :: Node.List
-> Instance.List
+ -> Maybe Int
-> Instance.Instance
-> AllocNodes
-> [Instance.Instance]
-> [CStats]
-> Result AllocResult
-tieredAlloc nl il newinst allocnodes ixes cstats =
- case iterateAlloc nl il newinst allocnodes ixes cstats of
+tieredAlloc nl il limit newinst allocnodes ixes cstats =
+ case iterateAlloc nl il limit newinst allocnodes ixes cstats of
Bad s -> Bad s
Ok (errs, nl', il', ixes', cstats') ->
+ let newsol = Ok (errs, nl', il', ixes', cstats')
+ ixes_cnt = length ixes'
+ (stop, newlimit) = case limit of
+ Nothing -> (False, Nothing)
+ Just n -> (n <= ixes_cnt,
+ Just (n - ixes_cnt)) in
+ if stop then newsol else
case Instance.shrinkByType newinst . fst . last $
sortBy (comparing snd) errs of
- Bad _ -> Ok (errs, nl', il', ixes', cstats')
- Ok newinst' ->
- tieredAlloc nl' il' newinst' allocnodes ixes' cstats'
+ Bad _ -> newsol
+ Ok newinst' -> tieredAlloc nl' il' newlimit
+ newinst' allocnodes ixes' cstats'
-- | Compute the tiered spec string description from a list of
-- allocated instances.
diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index 4e38a31f1..56ba8be93 100644
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -866,7 +866,7 @@ prop_ClusterCanTieredAlloc node inst =
il = Container.empty
allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
in case allocnodes >>= \allocnodes' ->
- Cluster.tieredAlloc nl il inst allocnodes' [] [] of
+ Cluster.tieredAlloc nl il (Just 1) inst allocnodes' [] [] of
Types.Bad _ -> False
Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) &&
IntMap.size il' == length ixes &&
@@ -909,7 +909,7 @@ prop_ClusterAllocBalance =
allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True
i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
in case allocnodes >>= \allocnodes' ->
- Cluster.iterateAlloc nl' il i_templ allocnodes' [] [] of
+ Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of
Types.Bad _ -> False
Types.Ok (_, xnl, il', _, _) ->
let ynl = Container.add (Node.idx hnode) hnode xnl
diff --git a/htools/hspace.hs b/htools/hspace.hs
index 6b1a613ad..dec1bf703 100644
--- a/htools/hspace.hs
+++ b/htools/hspace.hs
@@ -302,7 +302,7 @@ main = do
(_, trl_nl, trl_il, trl_ixes, _) <-
if stop_allocation
then return result_noalloc
- else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
+ else exitifbad (Cluster.tieredAlloc nl il Nothing (iofspec tspec)
allocnodes [] [])
let spec_map' = Cluster.tieredSpecMap trl_ixes
@@ -324,7 +324,8 @@ main = do
(ereason, fin_nl, fin_il, ixes, _) <-
if stop_allocation
then return result_noalloc
- else exitifbad (Cluster.iterateAlloc nl il reqinst allocnodes [] [])
+ else exitifbad (Cluster.iterateAlloc nl il Nothing
+ reqinst allocnodes [] [])
let allocs = length ixes
sreason = reverse $ sortBy (comparing snd) ereason
--
GitLab