Revision 72bb6b4e htools/Ganeti/HTools/QC.hs
b/htools/Ganeti/HTools/QC.hs | ||
---|---|---|
107 | 107 |
isFailure (Types.OpFail _) = True |
108 | 108 |
isFailure _ = False |
109 | 109 |
|
110 |
-- | Checks for equality with proper annotation. |
|
111 |
(==?) :: (Show a, Eq a) => a -> a -> Property |
|
112 |
(==?) x y = printTestCase |
|
113 |
("Expected equality, but '" ++ |
|
114 |
show x ++ "' /= '" ++ show y ++ "'") (x == y) |
|
115 |
infix 3 ==? |
|
116 |
|
|
110 | 117 |
-- | Update an instance to be smaller than a node. |
111 | 118 |
setInstanceSmallerThanNode node inst = |
112 | 119 |
inst { Instance.mem = Node.availMem node `div` 2 |
... | ... | |
300 | 307 |
prop_Utils_commaJoinSplit = |
301 | 308 |
forAll (arbitrary `suchThat` |
302 | 309 |
(\l -> l /= [""] && all (not . elem ',') l )) $ \lst -> |
303 |
Utils.sepSplit ',' (Utils.commaJoin lst) == lst |
|
310 |
Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst
|
|
304 | 311 |
|
305 | 312 |
-- | Split and join should always be idempotent. |
306 |
prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s |
|
313 |
prop_Utils_commaSplitJoin s = |
|
314 |
Utils.commaJoin (Utils.sepSplit ',' s) ==? s |
|
307 | 315 |
|
308 | 316 |
-- | fromObjWithDefault, we test using the Maybe monad and an integer |
309 | 317 |
-- value. |
... | ... | |
316 | 324 |
where _types = def_value :: Integer |
317 | 325 |
|
318 | 326 |
-- | Test that functional if' behaves like the syntactic sugar if. |
319 |
prop_Utils_if'if :: Bool -> Int -> Int -> Bool |
|
320 |
prop_Utils_if'if cnd a b = Utils.if' cnd a b == if cnd then a else b |
|
327 |
prop_Utils_if'if :: Bool -> Int -> Int -> Gen Prop |
|
328 |
prop_Utils_if'if cnd a b = |
|
329 |
Utils.if' cnd a b ==? if cnd then a else b |
|
321 | 330 |
|
322 | 331 |
-- | Test basic select functionality |
323 |
prop_Utils_select :: Int -- ^ Default result |
|
324 |
-> [Int] -- ^ List of False values |
|
325 |
-> [Int] -- ^ List of True values |
|
326 |
-> Bool -- ^ Test result
|
|
332 |
prop_Utils_select :: Int -- ^ Default result
|
|
333 |
-> [Int] -- ^ List of False values
|
|
334 |
-> [Int] -- ^ List of True values
|
|
335 |
-> Gen Prop -- ^ Test result
|
|
327 | 336 |
prop_Utils_select def lst1 lst2 = |
328 |
Utils.select def cndlist == expectedresult |
|
337 |
Utils.select def cndlist ==? expectedresult
|
|
329 | 338 |
where expectedresult = Utils.if' (null lst2) def (head lst2) |
330 | 339 |
flist = map (\e -> (False, e)) lst1 |
331 | 340 |
tlist = map (\e -> (True, e)) lst2 |
332 | 341 |
cndlist = flist ++ tlist |
333 | 342 |
|
334 | 343 |
-- | Test basic select functionality with undefined default |
335 |
prop_Utils_select_undefd :: [Int] -- ^ List of False values |
|
344 |
prop_Utils_select_undefd :: [Int] -- ^ List of False values
|
|
336 | 345 |
-> NonEmptyList Int -- ^ List of True values |
337 |
-> Bool -- ^ Test result
|
|
346 |
-> Gen Prop -- ^ Test result
|
|
338 | 347 |
prop_Utils_select_undefd lst1 (NonEmpty lst2) = |
339 |
Utils.select undefined cndlist == head lst2 |
|
348 |
Utils.select undefined cndlist ==? head lst2
|
|
340 | 349 |
where flist = map (\e -> (False, e)) lst1 |
341 | 350 |
tlist = map (\e -> (True, e)) lst2 |
342 | 351 |
cndlist = flist ++ tlist |
343 | 352 |
|
344 | 353 |
-- | Test basic select functionality with undefined list values |
345 |
prop_Utils_select_undefv :: [Int] -- ^ List of False values |
|
354 |
prop_Utils_select_undefv :: [Int] -- ^ List of False values
|
|
346 | 355 |
-> NonEmptyList Int -- ^ List of True values |
347 |
-> Bool -- ^ Test result
|
|
356 |
-> Gen Prop -- ^ Test result
|
|
348 | 357 |
prop_Utils_select_undefv lst1 (NonEmpty lst2) = |
349 |
Utils.select undefined cndlist == head lst2 |
|
358 |
Utils.select undefined cndlist ==? head lst2
|
|
350 | 359 |
where flist = map (\e -> (False, e)) lst1 |
351 | 360 |
tlist = map (\e -> (True, e)) lst2 |
352 | 361 |
cndlist = flist ++ tlist ++ [undefined] |
... | ... | |
380 | 389 |
|
381 | 390 |
-- | Make sure add is idempotent. |
382 | 391 |
prop_PeerMap_addIdempotent pmap key em = |
383 |
fn puniq == fn (fn puniq) |
|
392 |
fn puniq ==? fn (fn puniq)
|
|
384 | 393 |
where _types = (pmap::PeerMap.PeerMap, |
385 | 394 |
key::PeerMap.Key, em::PeerMap.Elem) |
386 | 395 |
fn = PeerMap.add key em |
... | ... | |
388 | 397 |
|
389 | 398 |
-- | Make sure remove is idempotent. |
390 | 399 |
prop_PeerMap_removeIdempotent pmap key = |
391 |
fn puniq == fn (fn puniq) |
|
400 |
fn puniq ==? fn (fn puniq)
|
|
392 | 401 |
where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key) |
393 | 402 |
fn = PeerMap.remove key |
394 | 403 |
puniq = PeerMap.accumArray const pmap |
395 | 404 |
|
396 | 405 |
-- | Make sure a missing item returns 0. |
397 | 406 |
prop_PeerMap_findMissing pmap key = |
398 |
PeerMap.find key (PeerMap.remove key puniq) == 0 |
|
407 |
PeerMap.find key (PeerMap.remove key puniq) ==? 0
|
|
399 | 408 |
where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key) |
400 | 409 |
puniq = PeerMap.accumArray const pmap |
401 | 410 |
|
402 | 411 |
-- | Make sure an added item is found. |
403 | 412 |
prop_PeerMap_addFind pmap key em = |
404 |
PeerMap.find key (PeerMap.add key em puniq) == em |
|
413 |
PeerMap.find key (PeerMap.add key em puniq) ==? em
|
|
405 | 414 |
where _types = (pmap::PeerMap.PeerMap, |
406 | 415 |
key::PeerMap.Key, em::PeerMap.Elem) |
407 | 416 |
puniq = PeerMap.accumArray const pmap |
408 | 417 |
|
409 | 418 |
-- | Manual check that maxElem returns the maximum indeed, or 0 for null. |
410 | 419 |
prop_PeerMap_maxElem pmap = |
411 |
PeerMap.maxElem puniq == if null puniq then 0 |
|
412 |
else (maximum . snd . unzip) puniq |
|
420 |
PeerMap.maxElem puniq ==? if null puniq then 0
|
|
421 |
else (maximum . snd . unzip) puniq
|
|
413 | 422 |
where _types = pmap::PeerMap.PeerMap |
414 | 423 |
puniq = PeerMap.accumArray const pmap |
415 | 424 |
|
... | ... | |
435 | 444 |
prop_Container_nameOf node = |
436 | 445 |
let nl = makeSmallCluster node 1 |
437 | 446 |
fnode = head (Container.elems nl) |
438 |
in Container.nameOf nl (Node.idx fnode) == Node.name fnode |
|
447 |
in Container.nameOf nl (Node.idx fnode) ==? Node.name fnode
|
|
439 | 448 |
|
440 | 449 |
-- | We test that in a cluster, given a random node, we can find it by |
441 | 450 |
-- its name and alias, as long as all names and aliases are unique, |
... | ... | |
470 | 479 |
-- Simple instance tests, we only have setter/getters |
471 | 480 |
|
472 | 481 |
prop_Instance_creat inst = |
473 |
Instance.name inst == Instance.alias inst |
|
482 |
Instance.name inst ==? Instance.alias inst
|
|
474 | 483 |
|
475 | 484 |
prop_Instance_setIdx inst idx = |
476 |
Instance.idx (Instance.setIdx inst idx) == idx |
|
485 |
Instance.idx (Instance.setIdx inst idx) ==? idx
|
|
477 | 486 |
where _types = (inst::Instance.Instance, idx::Types.Idx) |
478 | 487 |
|
479 | 488 |
prop_Instance_setName inst name = |
... | ... | |
489 | 498 |
newinst = Instance.setAlias inst name |
490 | 499 |
|
491 | 500 |
prop_Instance_setPri inst pdx = |
492 |
Instance.pNode (Instance.setPri inst pdx) == pdx |
|
501 |
Instance.pNode (Instance.setPri inst pdx) ==? pdx
|
|
493 | 502 |
where _types = (inst::Instance.Instance, pdx::Types.Ndx) |
494 | 503 |
|
495 | 504 |
prop_Instance_setSec inst sdx = |
496 |
Instance.sNode (Instance.setSec inst sdx) == sdx |
|
505 |
Instance.sNode (Instance.setSec inst sdx) ==? sdx
|
|
497 | 506 |
where _types = (inst::Instance.Instance, sdx::Types.Ndx) |
498 | 507 |
|
499 | 508 |
prop_Instance_setBoth inst pdx sdx = |
... | ... | |
549 | 558 |
in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk |
550 | 559 |
|
551 | 560 |
prop_Instance_setMovable inst m = |
552 |
Instance.movable inst' == m |
|
561 |
Instance.movable inst' ==? m
|
|
553 | 562 |
where inst' = Instance.setMovable inst m |
554 | 563 |
|
555 | 564 |
testSuite "Instance" |
... | ... | |
681 | 690 |
newnode = Node.setAlias node name |
682 | 691 |
|
683 | 692 |
prop_Node_setOffline node status = |
684 |
Node.offline newnode == status |
|
693 |
Node.offline newnode ==? status
|
|
685 | 694 |
where newnode = Node.setOffline node status |
686 | 695 |
|
687 | 696 |
prop_Node_setXmem node xm = |
688 |
Node.xMem newnode == xm |
|
697 |
Node.xMem newnode ==? xm
|
|
689 | 698 |
where newnode = Node.setXmem node xm |
690 | 699 |
|
691 | 700 |
prop_Node_setMcpu node mc = |
692 |
Node.mCpu newnode == mc |
|
701 |
Node.mCpu newnode ==? mc
|
|
693 | 702 |
where newnode = Node.setMcpu node mc |
694 | 703 |
|
695 | 704 |
-- | Check that an instance add with too high memory or disk will be |
... | ... | |
778 | 787 |
|
779 | 788 |
-- Check tag maps |
780 | 789 |
prop_Node_tagMaps_idempotent tags = |
781 |
Node.delTags (Node.addTags m tags) tags == m |
|
790 |
Node.delTags (Node.addTags m tags) tags ==? m
|
|
782 | 791 |
where m = Data.Map.empty |
783 | 792 |
|
784 | 793 |
prop_Node_tagMaps_reject tags = |
785 | 794 |
not (null tags) ==> |
786 |
any (\t -> Node.rejectAddTags m [t]) tags
|
|
795 |
all (\t -> Node.rejectAddTags m [t]) tags
|
|
787 | 796 |
where m = Node.addTags Data.Map.empty tags |
788 | 797 |
|
789 | 798 |
prop_Node_showField node = |
... | ... | |
972 | 981 |
-- | Check that opcode serialization is idempotent. |
973 | 982 |
prop_OpCodes_serialization op = |
974 | 983 |
case J.readJSON (J.showJSON op) of |
975 |
J.Error _ -> False
|
|
976 |
J.Ok op' -> op == op' |
|
984 |
J.Error e -> printTestCase ("Cannot deserialise: " ++ e) False
|
|
985 |
J.Ok op' -> op ==? op'
|
|
977 | 986 |
where _types = op::OpCodes.OpCode |
978 | 987 |
|
979 | 988 |
testSuite "OpCodes" |
... | ... | |
984 | 993 |
-- | Check that (queued) job\/opcode status serialization is idempotent. |
985 | 994 |
prop_OpStatus_serialization os = |
986 | 995 |
case J.readJSON (J.showJSON os) of |
987 |
J.Error _ -> False
|
|
988 |
J.Ok os' -> os == os' |
|
996 |
J.Error e -> printTestCase ("Cannot deserialise: " ++ e) False
|
|
997 |
J.Ok os' -> os ==? os'
|
|
989 | 998 |
where _types = os::Jobs.OpStatus |
990 | 999 |
|
991 | 1000 |
prop_JobStatus_serialization js = |
992 | 1001 |
case J.readJSON (J.showJSON js) of |
993 |
J.Error _ -> False
|
|
994 |
J.Ok js' -> js == js' |
|
1002 |
J.Error e -> printTestCase ("Cannot deserialise: " ++ e) False
|
|
1003 |
J.Ok js' -> js ==? js'
|
|
995 | 1004 |
where _types = js::Jobs.JobStatus |
996 | 1005 |
|
997 | 1006 |
testSuite "Jobs" |
... | ... | |
1002 | 1011 |
-- ** Loader tests |
1003 | 1012 |
|
1004 | 1013 |
prop_Loader_lookupNode ktn inst node = |
1005 |
Loader.lookupNode nl inst node == Data.Map.lookup node nl |
|
1014 |
Loader.lookupNode nl inst node ==? Data.Map.lookup node nl
|
|
1006 | 1015 |
where nl = Data.Map.fromList ktn |
1007 | 1016 |
|
1008 | 1017 |
prop_Loader_lookupInstance kti inst = |
1009 |
Loader.lookupInstance il inst == Data.Map.lookup inst il |
|
1018 |
Loader.lookupInstance il inst ==? Data.Map.lookup inst il
|
|
1010 | 1019 |
where il = Data.Map.fromList kti |
1011 | 1020 |
|
1012 | 1021 |
prop_Loader_assignIndices nodes = |
Also available in: Unified diff