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 =
|