Revision 8fcf251f
| b/Ganeti/HTools/QC.hs | ||
|---|---|---|
| 35 | 35 |
import Test.QuickCheck |
| 36 | 36 |
import Test.QuickCheck.Batch |
| 37 | 37 |
import Data.Maybe |
| 38 |
import qualified Data.Map |
|
| 38 | 39 |
import qualified Ganeti.HTools.CLI as CLI |
| 39 | 40 |
import qualified Ganeti.HTools.Cluster as Cluster |
| 40 | 41 |
import qualified Ganeti.HTools.Container as Container |
| ... | ... | |
| 47 | 48 |
import qualified Ganeti.HTools.Types as Types |
| 48 | 49 |
import qualified Ganeti.HTools.Utils as Utils |
| 49 | 50 |
|
| 51 |
-- | Maximum memory (1TiB, somewhat random value) |
|
| 52 |
maxMem :: Int |
|
| 53 |
maxMem = 1024 * 1024 |
|
| 54 |
|
|
| 55 |
-- | Maximum disk (1PiB, somewhat random value) |
|
| 56 |
maxDsk :: Int |
|
| 57 |
maxDsk = 1024 * 1024 * 1024 |
|
| 58 |
|
|
| 59 |
-- | Max CPUs (1024, somewhat random value) |
|
| 60 |
maxCpu :: Int |
|
| 61 |
maxCpu = 1024 |
|
| 62 |
|
|
| 50 | 63 |
-- | Simple checker for whether OpResult is fail or pass |
| 51 | 64 |
isFailure :: Types.OpResult a -> Bool |
| 52 | 65 |
isFailure (Types.OpFail _) = True |
| 53 | 66 |
isFailure _ = False |
| 54 | 67 |
|
| 68 |
-- | Simple checker for whether Result is fail or pass |
|
| 69 |
isOk :: Types.Result a -> Bool |
|
| 70 |
isOk (Types.Ok _ ) = True |
|
| 71 |
isOk _ = False |
|
| 72 |
|
|
| 55 | 73 |
-- copied from the introduction to quickcheck |
| 56 | 74 |
instance Arbitrary Char where |
| 57 | 75 |
arbitrary = choose ('\32', '\128')
|
| ... | ... | |
| 60 | 78 |
instance Arbitrary Instance.Instance where |
| 61 | 79 |
arbitrary = do |
| 62 | 80 |
name <- arbitrary |
| 63 |
mem <- choose(0, 100)
|
|
| 64 |
dsk <- choose(0, 100)
|
|
| 81 |
mem <- choose (0, maxMem)
|
|
| 82 |
dsk <- choose (0, maxDsk)
|
|
| 65 | 83 |
run_st <- elements ["ERROR_up", "ERROR_down", "ADMIN_down" |
| 66 | 84 |
, "ERROR_nodedown", "ERROR_nodeoffline" |
| 67 | 85 |
, "running" |
| 68 | 86 |
, "no_such_status1", "no_such_status2"] |
| 69 | 87 |
pn <- arbitrary |
| 70 | 88 |
sn <- arbitrary |
| 71 |
vcpus <- arbitrary
|
|
| 89 |
vcpus <- choose (0, maxCpu)
|
|
| 72 | 90 |
return $ Instance.create name mem dsk vcpus run_st [] pn sn |
| 73 | 91 |
|
| 74 | 92 |
-- and a random node |
| 75 | 93 |
instance Arbitrary Node.Node where |
| 76 | 94 |
arbitrary = do |
| 77 | 95 |
name <- arbitrary |
| 78 |
mem_t <- arbitrary
|
|
| 96 |
mem_t <- choose (0, maxMem)
|
|
| 79 | 97 |
mem_f <- choose (0, mem_t) |
| 80 | 98 |
mem_n <- choose (0, mem_t - mem_f) |
| 81 |
dsk_t <- arbitrary
|
|
| 99 |
dsk_t <- choose (0, maxDsk)
|
|
| 82 | 100 |
dsk_f <- choose (0, dsk_t) |
| 83 |
cpu_t <- arbitrary
|
|
| 101 |
cpu_t <- choose (0, maxCpu)
|
|
| 84 | 102 |
offl <- arbitrary |
| 85 | 103 |
let n = Node.create name (fromIntegral mem_t) mem_n mem_f |
| 86 |
(fromIntegral dsk_t) dsk_f cpu_t offl
|
|
| 104 |
(fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl
|
|
| 87 | 105 |
n' = Node.buildPeers n Container.empty |
| 88 | 106 |
return n' |
| 89 | 107 |
|
| 108 |
setInstanceSmallerThanNode node inst = |
|
| 109 |
inst { Instance.mem = (Node.availMem node) `div` 2
|
|
| 110 |
, Instance.dsk = (Node.availDisk node) `div` 2 |
|
| 111 |
, Instance.vcpus = (Node.availCpu node) `div` 2 |
|
| 112 |
} |
|
| 113 |
|
|
| 90 | 114 |
-- | Make sure add is idempotent |
| 91 | 115 |
prop_PeerMap_addIdempotent pmap key em = |
| 92 | 116 |
fn puniq == fn (fn puniq) |
| ... | ... | |
| 178 | 202 |
in |
| 179 | 203 |
run_tx `notElem` Instance.runningStates ==> not run_st |
| 180 | 204 |
|
| 205 |
prop_Instance_shrinkMG inst = |
|
| 206 |
Instance.mem inst >= 2 * Types.unitMem ==> |
|
| 207 |
case Instance.shrinkByType inst Types.FailMem of |
|
| 208 |
Types.Ok inst' -> |
|
| 209 |
Instance.mem inst' == Instance.mem inst - Types.unitMem |
|
| 210 |
_ -> False |
|
| 211 |
where _types = (inst::Instance.Instance) |
|
| 212 |
|
|
| 213 |
prop_Instance_shrinkMF inst = |
|
| 214 |
Instance.mem inst < 2 * Types.unitMem ==> |
|
| 215 |
not . isOk $ Instance.shrinkByType inst Types.FailMem |
|
| 216 |
where _types = (inst::Instance.Instance) |
|
| 217 |
|
|
| 218 |
prop_Instance_shrinkCG inst = |
|
| 219 |
Instance.vcpus inst >= 2 * Types.unitCpu ==> |
|
| 220 |
case Instance.shrinkByType inst Types.FailCPU of |
|
| 221 |
Types.Ok inst' -> |
|
| 222 |
Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu |
|
| 223 |
_ -> False |
|
| 224 |
where _types = (inst::Instance.Instance) |
|
| 225 |
|
|
| 226 |
prop_Instance_shrinkCF inst = |
|
| 227 |
Instance.vcpus inst < 2 * Types.unitCpu ==> |
|
| 228 |
not . isOk $ Instance.shrinkByType inst Types.FailCPU |
|
| 229 |
where _types = (inst::Instance.Instance) |
|
| 230 |
|
|
| 231 |
prop_Instance_shrinkDG inst = |
|
| 232 |
Instance.dsk inst >= 2 * Types.unitDsk ==> |
|
| 233 |
case Instance.shrinkByType inst Types.FailDisk of |
|
| 234 |
Types.Ok inst' -> |
|
| 235 |
Instance.dsk inst' == Instance.dsk inst - Types.unitDsk |
|
| 236 |
_ -> False |
|
| 237 |
where _types = (inst::Instance.Instance) |
|
| 238 |
|
|
| 239 |
prop_Instance_shrinkDF inst = |
|
| 240 |
Instance.dsk inst < 2 * Types.unitDsk ==> |
|
| 241 |
not . isOk $ Instance.shrinkByType inst Types.FailDisk |
|
| 242 |
where _types = (inst::Instance.Instance) |
|
| 243 |
|
|
| 244 |
prop_Instance_setMovable inst m = |
|
| 245 |
Instance.movable inst' == m |
|
| 246 |
where _types = (inst::Instance.Instance, m::Bool) |
|
| 247 |
inst' = Instance.setMovable inst m |
|
| 248 |
|
|
| 181 | 249 |
testInstance = |
| 182 | 250 |
[ run prop_Instance_setIdx |
| 183 | 251 |
, run prop_Instance_setName |
| ... | ... | |
| 186 | 254 |
, run prop_Instance_setBoth |
| 187 | 255 |
, run prop_Instance_runStatus_True |
| 188 | 256 |
, run prop_Instance_runStatus_False |
| 257 |
, run prop_Instance_shrinkMG |
|
| 258 |
, run prop_Instance_shrinkMF |
|
| 259 |
, run prop_Instance_shrinkCG |
|
| 260 |
, run prop_Instance_shrinkCF |
|
| 261 |
, run prop_Instance_shrinkDG |
|
| 262 |
, run prop_Instance_shrinkDF |
|
| 263 |
, run prop_Instance_setMovable |
|
| 189 | 264 |
] |
| 190 | 265 |
|
| 191 | 266 |
-- Instance text loader tests |
| ... | ... | |
| 224 | 299 |
-- Node tests |
| 225 | 300 |
|
| 226 | 301 |
-- | Check that an instance add with too high memory or disk will be rejected |
| 227 |
prop_Node_addPri node inst = (Instance.mem inst >= Node.fMem node || |
|
| 228 |
Instance.dsk inst >= Node.fDsk node) && |
|
| 229 |
not (Node.failN1 node) |
|
| 230 |
==> |
|
| 231 |
isFailure (Node.addPri node inst) |
|
| 302 |
prop_Node_addPriFM node inst = Instance.mem inst >= Node.fMem node && |
|
| 303 |
not (Node.failN1 node) |
|
| 304 |
==> |
|
| 305 |
case Node.addPri node inst'' of |
|
| 306 |
Types.OpFail Types.FailMem -> True |
|
| 307 |
_ -> False |
|
| 232 | 308 |
where _types = (node::Node.Node, inst::Instance.Instance) |
| 233 |
|
|
| 309 |
inst' = setInstanceSmallerThanNode node inst |
|
| 310 |
inst'' = inst' { Instance.mem = Instance.mem inst }
|
|
| 311 |
|
|
| 312 |
prop_Node_addPriFD node inst = Instance.dsk inst >= Node.fDsk node && |
|
| 313 |
not (Node.failN1 node) |
|
| 314 |
==> |
|
| 315 |
case Node.addPri node inst'' of |
|
| 316 |
Types.OpFail Types.FailDisk -> True |
|
| 317 |
_ -> False |
|
| 318 |
where _types = (node::Node.Node, inst::Instance.Instance) |
|
| 319 |
inst' = setInstanceSmallerThanNode node inst |
|
| 320 |
inst'' = inst' { Instance.dsk = Instance.dsk inst }
|
|
| 321 |
|
|
| 322 |
prop_Node_addPriFC node inst = Instance.vcpus inst > Node.availCpu node && |
|
| 323 |
not (Node.failN1 node) |
|
| 324 |
==> |
|
| 325 |
case Node.addPri node inst'' of |
|
| 326 |
Types.OpFail Types.FailCPU -> True |
|
| 327 |
_ -> False |
|
| 328 |
where _types = (node::Node.Node, inst::Instance.Instance) |
|
| 329 |
inst' = setInstanceSmallerThanNode node inst |
|
| 330 |
inst'' = inst' { Instance.vcpus = Instance.vcpus inst }
|
|
| 234 | 331 |
|
| 235 | 332 |
-- | Check that an instance add with too high memory or disk will be rejected |
| 236 | 333 |
prop_Node_addSec node inst pdx = |
| ... | ... | |
| 240 | 337 |
==> isFailure (Node.addSec node inst pdx) |
| 241 | 338 |
where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int) |
| 242 | 339 |
|
| 340 |
newtype SmallRatio = SmallRatio Double deriving Show |
|
| 341 |
instance Arbitrary SmallRatio where |
|
| 342 |
arbitrary = do |
|
| 343 |
v <- choose (0, 1) |
|
| 344 |
return $ SmallRatio v |
|
| 345 |
|
|
| 346 |
-- | Check mdsk setting |
|
| 347 |
prop_Node_setMdsk node mx = |
|
| 348 |
Node.loDsk node' >= 0 && |
|
| 349 |
fromIntegral (Node.loDsk node') <= Node.tDsk node && |
|
| 350 |
Node.availDisk node' >= 0 && |
|
| 351 |
Node.availDisk node' <= Node.fDsk node' && |
|
| 352 |
fromIntegral (Node.availDisk node') <= Node.tDsk node' |
|
| 353 |
where _types = (node::Node.Node, mx::SmallRatio) |
|
| 354 |
node' = Node.setMdsk node mx' |
|
| 355 |
SmallRatio mx' = mx |
|
| 356 |
|
|
| 357 |
-- Check tag maps |
|
| 358 |
prop_Node_tagMaps_idempotent tags = |
|
| 359 |
Node.delTags (Node.addTags m tags) tags == m |
|
| 360 |
where _types = (tags::[String]) |
|
| 361 |
m = Data.Map.empty |
|
| 362 |
|
|
| 363 |
prop_Node_tagMaps_reject tags = |
|
| 364 |
not (null tags) ==> |
|
| 365 |
any (\t -> Node.rejectAddTags m [t]) tags |
|
| 366 |
where _types = (tags::[String]) |
|
| 367 |
m = Node.addTags (Data.Map.empty) tags |
|
| 368 |
|
|
| 243 | 369 |
testNode = |
| 244 |
[ run prop_Node_addPri |
|
| 370 |
[ run prop_Node_addPriFM |
|
| 371 |
, run prop_Node_addPriFD |
|
| 372 |
, run prop_Node_addPriFC |
|
| 245 | 373 |
, run prop_Node_addSec |
| 374 |
, run prop_Node_setMdsk |
|
| 375 |
, run prop_Node_tagMaps_idempotent |
|
| 376 |
, run prop_Node_tagMaps_reject |
|
| 246 | 377 |
] |
| 247 | 378 |
|
| 248 | 379 |
|
| ... | ... | |
| 260 | 391 |
-- this should be much lower than the default score in CLI.hs |
| 261 | 392 |
in score <= 1e-15 |
| 262 | 393 |
|
| 394 |
-- | Check that cluster stats are sane |
|
| 395 |
prop_CStats_sane node count = |
|
| 396 |
(not (Node.offline node) && not (Node.failN1 node) && (count > 0) && |
|
| 397 |
(Node.tDsk node > 0) && (Node.tMem node > 0)) ==> |
|
| 398 |
let fn = Node.buildPeers node Container.empty |
|
| 399 |
nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)] |
|
| 400 |
nl = Container.fromAssocList nlst |
|
| 401 |
cstats = Cluster.totalResources nl |
|
| 402 |
in Cluster.csAdsk cstats >= 0 && |
|
| 403 |
Cluster.csAdsk cstats <= Cluster.csFdsk cstats |
|
| 404 |
|
|
| 263 | 405 |
testCluster = |
| 264 | 406 |
[ run prop_Score_Zero |
| 407 |
, run prop_CStats_sane |
|
| 265 | 408 |
] |
Also available in: Unified diff