, testJobs
, testCluster
, testLoader
+ , testTypes
) where
import Test.QuickCheck
-- | Create an instance given its spec.
createInstance mem dsk vcpus =
Instance.create "inst-unnamed" mem dsk vcpus "running" [] True (-1) (-1)
+ Types.DTDrbd8
-- | Create a small cluster by repeating a node spec.
makeSmallCluster :: Node.Node -> Int -> Node.List
sn <- arbitrary
vcpus <- choose (0, maxCpu)
return $ Instance.create name mem dsk vcpus run_st [] True pn sn
+ Types.DTDrbd8
-- | Generas an arbitrary node based on sizing information.
genNode :: Maybe Int -- ^ Minimum node size in terms of units
v <- choose (0, 1)
return $ SmallRatio v
+instance Arbitrary Types.AllocPolicy where
+ arbitrary = elements [minBound..maxBound]
+
+instance Arbitrary Types.DiskTemplate where
+ arbitrary = elements [minBound..maxBound]
+
-- * Actual tests
-- ** Utils tests
random_key (def_value+1) == Just def_value
where _types = def_value :: Integer
+-- | Test that functional if' behaves like the syntactic sugar if.
+prop_Utils_if'if :: Bool -> Int -> Int -> Bool
+prop_Utils_if'if cnd a b = Utils.if' cnd a b == if cnd then a else b
+
+-- | Test basic select functionality
+prop_Utils_select :: Int -- ^ Default result
+ -> [Int] -- ^ List of False values
+ -> [Int] -- ^ List of True values
+ -> Bool -- ^ Test result
+prop_Utils_select def lst1 lst2 =
+ Utils.select def cndlist == expectedresult
+ where expectedresult = Utils.if' (null lst2) def (head lst2)
+ flist = map (\e -> (False, e)) lst1
+ tlist = map (\e -> (True, e)) lst2
+ cndlist = flist ++ tlist
+
+-- | Test basic select functionality with undefined default
+prop_Utils_select_undefd :: [Int] -- ^ List of False values
+ -> NonEmptyList Int -- ^ List of True values
+ -> Bool -- ^ Test result
+prop_Utils_select_undefd lst1 (NonEmpty lst2) =
+ Utils.select undefined cndlist == head lst2
+ where flist = map (\e -> (False, e)) lst1
+ tlist = map (\e -> (True, e)) lst2
+ cndlist = flist ++ tlist
+
+-- | Test basic select functionality with undefined list values
+prop_Utils_select_undefv :: [Int] -- ^ List of False values
+ -> NonEmptyList Int -- ^ List of True values
+ -> Bool -- ^ Test result
+prop_Utils_select_undefv lst1 (NonEmpty lst2) =
+ Utils.select undefined cndlist == head lst2
+ where flist = map (\e -> (False, e)) lst1
+ tlist = map (\e -> (True, e)) lst2
+ cndlist = flist ++ tlist ++ [undefined]
+
+prop_Utils_parseUnit (NonNegative n) =
+ Utils.parseUnit (show n) == Types.Ok n &&
+ Utils.parseUnit (show n ++ "m") == Types.Ok n &&
+ (case Utils.parseUnit (show n ++ "M") of
+ Types.Ok m -> if n > 0
+ then m < n -- for positive values, X MB is less than X MiB
+ else m == 0 -- but for 0, 0 MB == 0 MiB
+ Types.Bad _ -> False) &&
+ Utils.parseUnit (show n ++ "g") == Types.Ok (n*1024) &&
+ Utils.parseUnit (show n ++ "t") == Types.Ok (n*1048576) &&
+ Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int)
+ where _types = (n::Int)
+
-- | Test list for the Utils module.
testUtils =
[ run prop_Utils_commaJoinSplit
, run prop_Utils_commaSplitJoin
, run prop_Utils_fromObjWithDefault
+ , run prop_Utils_if'if
+ , run prop_Utils_select
+ , run prop_Utils_select_undefd
+ , run prop_Utils_select_undefv
+ , run prop_Utils_parseUnit
]
-- ** PeerMap tests
prop_Text_Load_Instance name mem dsk vcpus status
(NonEmpty pnode) snode
- (NonNegative pdx) (NonNegative sdx) autobal =
+ (NonNegative pdx) (NonNegative sdx) autobal dt =
pnode /= snode && pdx /= sdx ==>
let vcpus_s = show vcpus
dsk_s = show dsk
nl = Data.Map.fromList ndx
tags = ""
sbal = if autobal then "Y" else "N"
+ sdt = Types.dtToString dt
inst = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status,
- sbal, pnode, snode, tags]:: Maybe (String, Instance.Instance)
+ sbal, pnode, snode, sdt, tags]
fail1 = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status,
- sbal, pnode, pnode, tags]:: Maybe (String, Instance.Instance)
+ sbal, pnode, pnode, tags]
_types = ( name::String, mem::Int, dsk::Int
, vcpus::Int, status::String
, snode::String
, autobal::Bool)
in
case inst of
- Nothing -> False
- Just (_, i) ->
+ Types.Bad msg -> printTestCase ("Failed to load instance: " ++ msg)
+ False
+ Types.Ok (_, i) -> printTestCase ("Mismatch in some field while\
+ \ loading the instance") $
Instance.name i == name &&
Instance.vcpus i == vcpus &&
Instance.mem i == mem &&
then Node.noSecondary
else sdx) &&
Instance.autoBalance i == autobal &&
- isNothing fail1
+ Types.isBad fail1
prop_Text_Load_InstanceFail ktn fields =
- length fields /= 9 ==>
+ length fields /= 10 ==>
case Text.loadInst nl fields of
- Types.Ok _ -> False
- Types.Bad msg -> "Invalid/incomplete instance data: '" `isPrefixOf` msg
+ Types.Ok _ -> printTestCase "Managed to load instance from invalid\
+ \ data" False
+ Types.Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
+ "Invalid/incomplete instance data: '" `isPrefixOf` msg
where nl = Data.Map.fromList ktn
prop_Text_Load_Node name tm nm fm td fd tc fo =
-- | Checks for memory reservation changes.
prop_Node_rMem inst =
- forAll (arbitrary `suchThat` ((> 0) . Node.fMem)) $ \node ->
+ forAll (arbitrary `suchThat` ((> Types.unitMem) . Node.fMem)) $ \node ->
-- ab = auto_balance, nb = non-auto_balance
-- we use -1 as the primary node of the instance
let inst' = inst { Instance.pNode = -1, Instance.autoBalance = True }
(not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
(Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
let fn = Node.buildPeers node Container.empty
- nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
- nl = Container.fromList nlst
- score = Cluster.compCV nl
+ nlst = replicate count fn
+ score = Cluster.compCVNodes nlst
-- we can't say == 0 here as the floating point errors accumulate;
-- this should be much lower than the default score in CLI.hs
in score <= 1e-12
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 &&
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
in (sum . map (length . Node.pList)) nodes == 0 &&
null instances
+-- | Check that compareNameComponent on equal strings works.
+prop_Loader_compareNameComponent_equal :: String -> Bool
+prop_Loader_compareNameComponent_equal s =
+ Loader.compareNameComponent s s ==
+ Loader.LookupResult Loader.ExactMatch s
+
+-- | Check that compareNameComponent on prefix strings works.
+prop_Loader_compareNameComponent_prefix :: NonEmptyList Char -> String -> Bool
+prop_Loader_compareNameComponent_prefix (NonEmpty s1) s2 =
+ Loader.compareNameComponent (s1 ++ "." ++ s2) s1 ==
+ Loader.LookupResult Loader.PartialMatch s1
+
testLoader =
[ run prop_Loader_lookupNode
, run prop_Loader_lookupInstance
, run prop_Loader_assignIndices
, run prop_Loader_mergeData
+ , run prop_Loader_compareNameComponent_equal
+ , run prop_Loader_compareNameComponent_prefix
]
+
+-- ** Types tests
+
+prop_AllocPolicy_serialisation apol =
+ case Types.apolFromString (Types.apolToString apol) of
+ Types.Ok p -> printTestCase ("invalid deserialisation " ++ show p) $
+ p == apol
+ Types.Bad s -> printTestCase ("failed to deserialise: " ++ s) False
+
+prop_DiskTemplate_serialisation dt =
+ case Types.dtFromString (Types.dtToString dt) of
+ Types.Ok p -> printTestCase ("invalid deserialisation " ++ show p) $
+ p == dt
+ Types.Bad s -> printTestCase ("failed to deserialise: " ++ s) False
+
+testTypes =
+ [ run prop_AllocPolicy_serialisation
+ , run prop_DiskTemplate_serialisation
+ ]
projects / ganeti-local / blobdiff