Commit 3fea6959 authored by Iustin Pop's avatar Iustin Pop
Browse files

Add more unit tests for allocation/balance

The patch adds some simple unit-tests for both the allocation function
(we can allocate small instances on an empty cluster, we can allocate in
tiered more starting from any size) and the balancing functions (one
single instance is placed optimally, a full cluster plus an empty node
can be rebalanced). The coverage has increased greatly, since this is
the bulk of the algorithm/code.

Also, the cluster tests are now being run with different options, since
they are much slower.
parent 3ce8009a
......@@ -476,18 +476,16 @@ checkMove nodes_idx disk_moves ini_tbl victims =
else best_tbl
-- | Check if we are allowed to go deeper in the balancing
doNextBalance :: Table -- ^ The starting table
-> Int -- ^ Remaining length
-> Score -- ^ Score at which to stop
-> Bool -- ^ The resulting table and commands
doNextBalance :: Table -- ^ The starting table
-> Int -- ^ Remaining length
-> Score -- ^ Score at which to stop
-> Bool -- ^ The resulting table and commands
doNextBalance ini_tbl max_rounds min_score =
let Table _ _ ini_cv ini_plc = ini_tbl
ini_plc_len = length ini_plc
in (max_rounds < 0 || ini_plc_len < max_rounds) && ini_cv > min_score
-- | Run a balance move
tryBalance :: Table -- ^ The starting table
-> Bool -- ^ Allow disk moves
-> Bool -- ^ Only evacuate moves
......@@ -599,7 +597,7 @@ tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \
\destinations required (" ++ show reqn ++
"), only one supported"
-- | Try to allocate an instance on the cluster.
-- | Try to evacuate a list of nodes.
tryEvac :: (Monad m) =>
Node.List -- ^ The node list
-> Instance.List -- ^ The instance list
......
......@@ -36,6 +36,7 @@ import Test.QuickCheck
import Test.QuickCheck.Batch
import Data.Maybe
import qualified Data.Map
import qualified Data.IntMap as IntMap
import qualified Ganeti.HTools.CLI as CLI
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Container as Container
......@@ -48,6 +49,8 @@ import qualified Ganeti.HTools.Text as Text
import qualified Ganeti.HTools.Types as Types
import qualified Ganeti.HTools.Utils as Utils
-- * Constants
-- | Maximum memory (1TiB, somewhat random value)
maxMem :: Int
maxMem = 1024 * 1024
......@@ -60,6 +63,8 @@ maxDsk = 1024 * 1024 * 8
maxCpu :: Int
maxCpu = 1024
-- * Helper functions
-- | Simple checker for whether OpResult is fail or pass
isFailure :: Types.OpResult a -> Bool
isFailure (Types.OpFail _) = True
......@@ -70,6 +75,36 @@ isOk :: Types.Result a -> Bool
isOk (Types.Ok _ ) = True
isOk _ = False
-- | Update an instance to be smaller than a node
setInstanceSmallerThanNode node inst =
inst { Instance.mem = (Node.availMem node) `div` 2
, Instance.dsk = (Node.availDisk node) `div` 2
, Instance.vcpus = (Node.availCpu node) `div` 2
}
-- | Create an instance given its spec
createInstance mem dsk vcpus =
Instance.create "inst-unnamed" mem dsk vcpus "running" [] (-1) (-1)
-- | Create a small cluster by repeating a node spec
makeSmallCluster :: Node.Node -> Int -> Node.List
makeSmallCluster node count =
let fn = Node.buildPeers node Container.empty
namelst = map (\n -> (Node.name n, n)) (replicate count fn)
(_, nlst) = Loader.assignIndices namelst
in Container.fromAssocList nlst
-- | Checks if a node is "big" enough
isNodeBig :: Node.Node -> Int -> Bool
isNodeBig node size = Node.availDisk node > size * Types.unitDsk
&& Node.availMem node > size * Types.unitMem
&& Node.availCpu node > size * Types.unitCpu
canBalance :: Cluster.Table -> Bool -> Bool -> Bool
canBalance tbl dm evac = isJust $ Cluster.tryBalance tbl dm evac
-- * Arbitrary instances
-- copied from the introduction to quickcheck
instance Arbitrary Char where
arbitrary = choose ('\32', '\128')
......@@ -105,11 +140,7 @@ instance Arbitrary Node.Node where
n' = Node.buildPeers n Container.empty
return n'
setInstanceSmallerThanNode node inst =
inst { Instance.mem = (Node.availMem node) `div` 2
, Instance.dsk = (Node.availDisk node) `div` 2
, Instance.vcpus = (Node.availCpu node) `div` 2
}
-- * Actual tests
-- | Make sure add is idempotent
prop_PeerMap_addIdempotent pmap key em =
......@@ -394,7 +425,7 @@ prop_Score_Zero node count =
-- | Check that cluster stats are sane
prop_CStats_sane node count =
(not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
(Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
(Node.availDisk node > 0) && (Node.availMem node > 0)) ==>
let fn = Node.buildPeers node Container.empty
nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
nl = Container.fromAssocList nlst
......@@ -402,7 +433,102 @@ prop_CStats_sane node count =
in Cluster.csAdsk cstats >= 0 &&
Cluster.csAdsk cstats <= Cluster.csFdsk cstats
-- | Check that one instance is allocated correctly, without
-- rebalances needed
prop_ClusterAlloc_sane node inst =
forAll (choose (5, 20)) $ \count ->
not (Node.offline node)
&& not (Node.failN1 node)
&& Node.availDisk node > 0
&& Node.availMem node > 0
==>
let nl = makeSmallCluster node count
il = Container.empty
rqnodes = 2
inst' = setInstanceSmallerThanNode node inst
in case Cluster.tryAlloc nl il inst' rqnodes of
Types.Bad _ -> False
Types.Ok (errs, _, sols3) ->
case sols3 of
[] -> False
(_, (xnl, xi, _)):[] ->
let cv = Cluster.compCV xnl
il' = Container.add (Instance.idx xi) xi il
tbl = Cluster.Table xnl il' cv []
in not (canBalance tbl True False)
_ -> False
-- | Checks that on a 2-5 node cluster, we can allocate a random
-- instance spec via tiered allocation (whatever the original instance
-- spec), on either one or two nodes
prop_ClusterCanTieredAlloc node inst =
forAll (choose (2, 5)) $ \count ->
forAll (choose (1, 2)) $ \rqnodes ->
not (Node.offline node)
&& not (Node.failN1 node)
&& isNodeBig node 4
==>
let nl = makeSmallCluster node count
il = Container.empty
in case Cluster.tieredAlloc nl il inst rqnodes [] of
Types.Bad _ -> False
Types.Ok (_, _, ixes) -> not (null ixes)
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
-- we can also evacuate it
prop_ClusterAllocEvac node inst =
forAll (choose (4, 8)) $ \count ->
not (Node.offline node)
&& not (Node.failN1 node)
&& isNodeBig node 4
==>
let nl = makeSmallCluster node count
il = Container.empty
rqnodes = 2
inst' = setInstanceSmallerThanNode node inst
in case Cluster.tryAlloc nl il inst' rqnodes of
Types.Bad _ -> False
Types.Ok (errs, _, sols3) ->
case sols3 of
[] -> False
(_, (xnl, xi, _)):[] ->
let sdx = Instance.sNode xi
il' = Container.add (Instance.idx xi) xi il
in case Cluster.tryEvac xnl il' [sdx] of
Just _ -> True
_ -> False
_ -> False
-- | Check that allocating multiple instances on a cluster, then
-- adding an empty node, results in a valid rebalance
prop_ClusterAllocBalance node =
forAll (choose (3, 5)) $ \count ->
not (Node.offline node)
&& not (Node.failN1 node)
&& isNodeBig node 4
&& not (isNodeBig node 8)
==>
let nl = makeSmallCluster node count
(hnode, nl') = IntMap.deleteFindMax nl
il = Container.empty
rqnodes = 2
i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
in case Cluster.iterateAlloc nl' il i_templ rqnodes [] of
Types.Bad _ -> False
Types.Ok (_, xnl, insts) ->
let ynl = Container.add (Node.idx hnode) hnode xnl
cv = Cluster.compCV ynl
il' = foldl (\l i ->
Container.add (Instance.idx i) i l)
il insts
tbl = Cluster.Table ynl il' cv []
in canBalance tbl True False
testCluster =
[ run prop_Score_Zero
, run prop_CStats_sane
, run prop_ClusterAlloc_sane
, run prop_ClusterCanTieredAlloc
, run prop_ClusterAllocEvac
, run prop_ClusterAllocBalance
]
......@@ -25,7 +25,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Main(main) where
import Control.Monad
import Data.IORef
import Test.QuickCheck.Batch
import System.IO
......@@ -33,12 +32,17 @@ import System.Exit
import Ganeti.HTools.QC
options :: TestOptions
options = TestOptions
{ no_of_tests = 500
, length_of_tests = 10
, debug_tests = False }
fastOptions :: TestOptions
fastOptions = TestOptions
{ no_of_tests = 500
, length_of_tests = 10
, debug_tests = False }
slowOptions :: TestOptions
slowOptions = TestOptions
{ no_of_tests = 50
, length_of_tests = 100
, debug_tests = False }
incIORef :: IORef Int -> IO ()
incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
......@@ -59,12 +63,12 @@ main :: IO ()
main = do
errs <- newIORef 0
let wrap = map (wrapTest errs)
runTests "PeerMap" options $ wrap testPeerMap
runTests "Container" options $ wrap testContainer
runTests "Instance" options $ wrap testInstance
runTests "Node" options $ wrap testNode
runTests "Text" options $ wrap testText
runTests "Cluster" options $ wrap testCluster
runTests "PeerMap" fastOptions $ wrap testPeerMap
runTests "Container" fastOptions $ wrap testContainer
runTests "Instance" fastOptions $ wrap testInstance
runTests "Node" fastOptions $ wrap testNode
runTests "Text" fastOptions $ wrap testText
runTests "Cluster" slowOptions $ wrap testCluster
terr <- readIORef errs
(if terr > 0
then do
......
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