{-
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2010 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
import Test.QuickCheck
import Test.QuickCheck.Batch
-import Data.List (findIndex)
+import Data.List (findIndex, intercalate, nub)
import Data.Maybe
import Control.Monad
import qualified Text.JSON as J
isFailure (Types.OpFail _) = True
isFailure _ = False
--- | Simple checker for whether Result is fail or pass
-isOk :: Types.Result a -> Bool
-isOk (Types.Ok _ ) = True
-isOk _ = False
-
-isBad :: Types.Result a -> Bool
-isBad = not . isOk
-
-- | Update an instance to be smaller than a node
setInstanceSmallerThanNode node inst =
inst { Instance.mem = Node.availMem node `div` 2
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
+ in nlst
-- | Checks if a node is "big" enough
isNodeBig :: Node.Node -> Int -> Bool
&& Node.availCpu node > size * Types.unitCpu
canBalance :: Cluster.Table -> Bool -> Bool -> Bool
-canBalance tbl dm evac = isJust $ Cluster.tryBalance tbl dm evac
+canBalance tbl dm evac = isJust $ Cluster.tryBalance tbl dm evac 0 0
+
+-- | Assigns a new fresh instance to a cluster; this is not
+-- allocation, so no resource checks are done
+assignInstance :: Node.List -> Instance.List -> Instance.Instance ->
+ Types.Idx -> Types.Idx ->
+ (Node.List, Instance.List)
+assignInstance nl il inst pdx sdx =
+ let pnode = Container.find pdx nl
+ snode = Container.find sdx nl
+ maxiidx = if Container.null il
+ then 0
+ else fst (Container.findMax il) + 1
+ inst' = inst { Instance.idx = maxiidx,
+ Instance.pNode = pdx, Instance.sNode = sdx }
+ pnode' = Node.setPri pnode inst'
+ snode' = Node.setSec snode inst'
+ nl' = Container.addTwo pdx pnode' sdx snode' nl
+ il' = Container.add maxiidx inst' il
+ in (nl', il')
-- * Arbitrary instances
instance Arbitrary Char where
arbitrary = choose ('\32', '\128')
+newtype DNSChar = DNSChar { dnsGetChar::Char }
+instance Arbitrary DNSChar where
+ arbitrary = do
+ x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
+ return (DNSChar x)
+
+getName :: Gen String
+getName = do
+ n <- choose (1, 64)
+ dn <- vector n::Gen [DNSChar]
+ return (map dnsGetChar dn)
+
+
+getFQDN :: Gen String
+getFQDN = do
+ felem <- getName
+ ncomps <- choose (1, 4)
+ frest <- vector ncomps::Gen [[DNSChar]]
+ let frest' = map (map dnsGetChar) frest
+ return (felem ++ "." ++ intercalate "." frest')
+
-- let's generate a random instance
instance Arbitrary Instance.Instance where
arbitrary = do
- name <- arbitrary
+ name <- getFQDN
mem <- choose (0, maxMem)
dsk <- choose (0, maxDsk)
run_st <- elements ["ERROR_up", "ERROR_down", "ADMIN_down"
-- and a random node
instance Arbitrary Node.Node where
arbitrary = do
- name <- arbitrary
+ name <- getFQDN
mem_t <- choose (0, maxMem)
mem_f <- choose (0, mem_t)
mem_n <- choose (0, mem_t - mem_f)
offl <- arbitrary
let n = Node.create name (fromIntegral mem_t) mem_n mem_f
(fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl
+ Utils.defaultGroupID
n' = Node.buildPeers n Container.empty
return n'
-- * Actual tests
--- | Test utils separator/joiner functions
-
-- If the list is not just an empty element, and if the elements do
-- not contain commas, then join+split should be idepotent
prop_Utils_commaJoinSplit lst = lst /= [""] &&
cont = foldl (\c x -> Container.add x x c) Container.empty cdata
fn x1 x2 = Container.addTwo x1 x1 x2 x2
+prop_Container_nameOf node =
+ let nl = makeSmallCluster node 1
+ fnode = head (Container.elems nl)
+ in Container.nameOf nl (Node.idx fnode) == Node.name fnode
+
+-- We test that in a cluster, given a random node, we can find it by
+-- its name and alias, as long as all names and aliases are unique,
+-- and that we fail to find a non-existing name
+prop_Container_findByName node othername =
+ forAll (choose (1, 20)) $ \ cnt ->
+ forAll (choose (0, cnt - 1)) $ \ fidx ->
+ forAll (vector cnt) $ \ names ->
+ (length . nub) (map fst names ++ map snd names) ==
+ length names * 2 &&
+ not (othername `elem` (map fst names ++ map snd names)) ==>
+ let nl = makeSmallCluster node cnt
+ nodes = Container.elems nl
+ nodes' = map (\((name, alias), nn) -> (Node.idx nn,
+ nn { Node.name = name,
+ Node.alias = alias }))
+ $ zip names nodes
+ nl' = Container.fromAssocList nodes'
+ target = snd (nodes' !! fidx)
+ in Container.findByName nl' (Node.name target) == Just target &&
+ Container.findByName nl' (Node.alias target) == Just target &&
+ Container.findByName nl' othername == Nothing
+
testContainer =
- [ run prop_Container_addTwo ]
+ [ run prop_Container_addTwo
+ , run prop_Container_nameOf
+ , run prop_Container_findByName
+ ]
-- Simple instance tests, we only have setter/getters
prop_Instance_shrinkMF inst =
Instance.mem inst < 2 * Types.unitMem ==>
- isBad $ Instance.shrinkByType inst Types.FailMem
+ Types.isBad $ Instance.shrinkByType inst Types.FailMem
prop_Instance_shrinkCG inst =
Instance.vcpus inst >= 2 * Types.unitCpu ==>
prop_Instance_shrinkCF inst =
Instance.vcpus inst < 2 * Types.unitCpu ==>
- isBad $ Instance.shrinkByType inst Types.FailCPU
+ Types.isBad $ Instance.shrinkByType inst Types.FailCPU
prop_Instance_shrinkDG inst =
Instance.dsk inst >= 2 * Types.unitDsk ==>
prop_Instance_shrinkDF inst =
Instance.dsk inst < 2 * Types.unitDsk ==>
- isBad $ Instance.shrinkByType inst Types.FailDisk
+ Types.isBad $ Instance.shrinkByType inst Types.FailDisk
prop_Instance_setMovable inst m =
Instance.movable inst' == m
ndx = if null snode
then [(pnode, pdx)]
else [(pnode, pdx), (snode, rsdx)]
+ nl = Data.Map.fromList ndx
tags = ""
- inst = Text.loadInst ndx
+ inst = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status, pnode, snode, tags]::
Maybe (String, Instance.Instance)
- fail1 = Text.loadInst ndx
+ fail1 = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status, pnode, pnode, tags]::
Maybe (String, Instance.Instance)
_types = ( name::String, mem::Int, dsk::Int
isNothing fail1)
prop_Text_Load_InstanceFail ktn fields =
- length fields /= 8 ==> isNothing $ Text.loadInst ktn fields
+ length fields /= 8 ==> isNothing $ Text.loadInst nl fields
+ where nl = Data.Map.fromList ktn
prop_Text_Load_Node name tm nm fm td fd tc fo =
let conv v = if v < 0
prop_Text_Load_NodeFail fields =
length fields /= 8 ==> isNothing $ Text.loadNode fields
+prop_Text_NodeLSIdempotent node =
+ (Text.loadNode .
+ Utils.sepSplit '|' . Text.serializeNode) n ==
+ Just (Node.name n, n)
+ -- override failN1 to what loadNode returns by default
+ where n = node { Node.failN1 = True, Node.offline = False }
+
testText =
[ run prop_Text_Load_Instance
, run prop_Text_Load_InstanceFail
, run prop_Text_Load_Node
, run prop_Text_Load_NodeFail
+ , run prop_Text_NodeLSIdempotent
]
-- Node tests
fst (Node.showHeader field) /= Types.unknownField &&
Node.showField node field /= Types.unknownField
+
+prop_Node_computeGroups nodes =
+ let ng = Node.computeGroups nodes
+ onlyuuid = map fst ng
+ in length nodes == sum (map (length . snd) ng) &&
+ all (\(guuid, ns) -> all ((== guuid) . Node.group) ns) ng &&
+ length (nub onlyuuid) == length onlyuuid &&
+ if null nodes then True else not (null ng)
+
testNode =
[ run prop_Node_setAlias
, run prop_Node_setOffline
, run prop_Node_tagMaps_idempotent
, run prop_Node_tagMaps_reject
, run prop_Node_showField
+ , run prop_Node_computeGroups
]
inst' = setInstanceSmallerThanNode node inst
in case Cluster.tryAlloc nl il inst' rqnodes of
Types.Bad _ -> False
- Types.Ok (_, _, sols3) ->
- case sols3 of
+ Types.Ok as ->
+ case Cluster.asSolutions as of
[] -> False
- (_, (xnl, xi, _)):[] ->
- let cv = Cluster.compCV xnl
- il' = Container.add (Instance.idx xi) xi il
+ (xnl, xi, _, cv):[] ->
+ let il' = Container.add (Instance.idx xi) xi il
tbl = Cluster.Table xnl il' cv []
in not (canBalance tbl True False)
_ -> False
il = Container.empty
in case Cluster.tieredAlloc nl il inst rqnodes [] of
Types.Bad _ -> False
- Types.Ok (_, _, ixes) -> not (null ixes)
+ Types.Ok (_, _, il', ixes) -> not (null ixes) &&
+ IntMap.size il' == length ixes
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
-- we can also evacuate it
inst' = setInstanceSmallerThanNode node inst
in case Cluster.tryAlloc nl il inst' rqnodes of
Types.Bad _ -> False
- Types.Ok (_, _, sols3) ->
- case sols3 of
+ Types.Ok as ->
+ case Cluster.asSolutions as of
[] -> False
- (_, (xnl, xi, _)):[] ->
+ (xnl, xi, _, _):[] ->
let sdx = Instance.sNode xi
il' = Container.add (Instance.idx xi) xi il
in case Cluster.tryEvac xnl il' [sdx] of
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) ->
+ Types.Ok (_, xnl, il', _) ->
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
+-- | Checks consistency
+prop_ClusterCheckConsistency node inst =
+ let nl = makeSmallCluster node 3
+ [node1, node2, node3] = Container.elems nl
+ node3' = node3 { Node.group = "other-uuid" }
+ nl' = Container.add (Node.idx node3') node3' nl
+ inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2)
+ inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary
+ inst3 = Instance.setBoth inst (Node.idx node1) (Node.idx node3)
+ ccheck = Cluster.findSplitInstances nl' . Container.fromAssocList
+ in null (ccheck [(0, inst1)]) &&
+ null (ccheck [(0, inst2)]) &&
+ (not . null $ ccheck [(0, inst3)])
+
+-- For now, we only test that we don't lose instances during the split
+prop_ClusterSplitCluster node inst =
+ forAll (choose (0, 100)) $ \icnt ->
+ let nl = makeSmallCluster node 2
+ (nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1)
+ (nl, Container.empty) [1..icnt]
+ gni = Cluster.splitCluster nl' il'
+ in sum (map (Container.size . snd . snd) gni) == icnt &&
+ all (\(guuid, (nl'', _)) -> all ((== guuid) . Node.group)
+ (Container.elems nl'')) gni
+
testCluster =
[ run prop_Score_Zero
, run prop_CStats_sane
, run prop_ClusterCanTieredAlloc
, run prop_ClusterAllocEvac
, run prop_ClusterAllocBalance
+ , run prop_ClusterCheckConsistency
+ , run prop_ClusterSplitCluster
]
-- | Check that opcode serialization is idempotent
-- | Loader tests
prop_Loader_lookupNode ktn inst node =
- isJust (Loader.lookupNode ktn inst node) == (node `elem` names)
- where names = map fst ktn
+ Loader.lookupNode nl inst node == Data.Map.lookup node nl
+ where nl = Data.Map.fromList ktn
prop_Loader_lookupInstance kti inst =
- isJust (Loader.lookupInstance kti inst) == (inst `elem` names)
- where names = map fst kti
-
-prop_Loader_lookupInstanceIdx kti inst =
- case (Loader.lookupInstance kti inst,
- findIndex (\p -> fst p == inst) kti) of
- (Nothing, Nothing) -> True
- (Just idx, Just ex) -> idx == snd (kti !! ex)
- _ -> False
-
-prop_Loader_assignIndices enames =
- length nassoc == length enames &&
- length kt == length enames &&
- (if not (null enames)
- then maximum (map fst kt) == length enames - 1
+ Loader.lookupInstance il inst == Data.Map.lookup inst il
+ where il = Data.Map.fromList kti
+
+prop_Loader_assignIndices nodes =
+ Data.Map.size nassoc == length nodes &&
+ Container.size kt == length nodes &&
+ (if not (null nodes)
+ then maximum (IntMap.keys kt) == length nodes - 1
else True)
- where (nassoc, kt) = Loader.assignIndices enames
- _types = enames::[(String, Node.Node)]
+ where (nassoc, kt) = Loader.assignIndices (map (\n -> (Node.name n, n)) nodes)
-- | Checks that the number of primary instances recorded on the nodes
-- is zero
prop_Loader_mergeData ns =
- let na = map (\n -> (Node.idx n, n)) ns
- in case Loader.mergeData [] [] [] (na, [], []) of
+ let na = Container.fromAssocList $ map (\n -> (Node.idx n, n)) ns
+ in case Loader.mergeData [] [] [] (na, Container.empty, []) of
Types.Bad _ -> False
Types.Ok (nl, il, _) ->
let nodes = Container.elems nl
testLoader =
[ run prop_Loader_lookupNode
, run prop_Loader_lookupInstance
- , run prop_Loader_lookupInstanceIdx
, run prop_Loader_assignIndices
, run prop_Loader_mergeData
]