Revision 23fe06c2 htools/Ganeti/HTools/QC.hs
| b/htools/Ganeti/HTools/QC.hs | ||
|---|---|---|
| 1 |
{-# LANGUAGE TemplateHaskell #-}
|
|
| 2 |
|
|
| 1 | 3 |
{-| Unittests for ganeti-htools.
|
| 2 | 4 |
|
| 3 | 5 |
-} |
| ... | ... | |
| 71 | 73 |
import qualified Ganeti.HTools.Program.Hscan |
| 72 | 74 |
import qualified Ganeti.HTools.Program.Hspace |
| 73 | 75 |
|
| 74 |
run :: Testable prop => prop -> Args -> IO Result |
|
| 75 |
run = flip quickCheckWithResult |
|
| 76 |
import Ganeti.HTools.QCHelper (testSuite) |
|
| 76 | 77 |
|
| 77 | 78 |
-- * Constants |
| 78 | 79 |
|
| ... | ... | |
| 364 | 365 |
where _types = n::Int |
| 365 | 366 |
|
| 366 | 367 |
-- | Test list for the Utils module. |
| 367 |
testUtils =
|
|
| 368 |
[ run prop_Utils_commaJoinSplit
|
|
| 369 |
, run prop_Utils_commaSplitJoin
|
|
| 370 |
, run prop_Utils_fromObjWithDefault
|
|
| 371 |
, run prop_Utils_if'if
|
|
| 372 |
, run prop_Utils_select
|
|
| 373 |
, run prop_Utils_select_undefd
|
|
| 374 |
, run prop_Utils_select_undefv
|
|
| 375 |
, run prop_Utils_parseUnit
|
|
| 376 |
] |
|
| 368 |
testSuite "Utils"
|
|
| 369 |
[ 'prop_Utils_commaJoinSplit
|
|
| 370 |
, 'prop_Utils_commaSplitJoin
|
|
| 371 |
, 'prop_Utils_fromObjWithDefault
|
|
| 372 |
, 'prop_Utils_if'if
|
|
| 373 |
, 'prop_Utils_select
|
|
| 374 |
, 'prop_Utils_select_undefd
|
|
| 375 |
, 'prop_Utils_select_undefv
|
|
| 376 |
, 'prop_Utils_parseUnit
|
|
| 377 |
]
|
|
| 377 | 378 |
|
| 378 | 379 |
-- ** PeerMap tests |
| 379 | 380 |
|
| ... | ... | |
| 413 | 414 |
puniq = PeerMap.accumArray const pmap |
| 414 | 415 |
|
| 415 | 416 |
-- | List of tests for the PeerMap module. |
| 416 |
testPeerMap =
|
|
| 417 |
[ run prop_PeerMap_addIdempotent
|
|
| 418 |
, run prop_PeerMap_removeIdempotent
|
|
| 419 |
, run prop_PeerMap_maxElem
|
|
| 420 |
, run prop_PeerMap_addFind
|
|
| 421 |
, run prop_PeerMap_findMissing
|
|
| 422 |
] |
|
| 417 |
testSuite "PeerMap"
|
|
| 418 |
[ 'prop_PeerMap_addIdempotent
|
|
| 419 |
, 'prop_PeerMap_removeIdempotent
|
|
| 420 |
, 'prop_PeerMap_maxElem
|
|
| 421 |
, 'prop_PeerMap_addFind
|
|
| 422 |
, 'prop_PeerMap_findMissing
|
|
| 423 |
]
|
|
| 423 | 424 |
|
| 424 | 425 |
-- ** Container tests |
| 425 | 426 |
|
| ... | ... | |
| 458 | 459 |
Container.findByName nl' (Node.alias target) == Just target && |
| 459 | 460 |
Container.findByName nl' othername == Nothing |
| 460 | 461 |
|
| 461 |
testContainer =
|
|
| 462 |
[ run prop_Container_addTwo
|
|
| 463 |
, run prop_Container_nameOf
|
|
| 464 |
, run prop_Container_findByName
|
|
| 465 |
] |
|
| 462 |
testSuite "Container"
|
|
| 463 |
[ 'prop_Container_addTwo
|
|
| 464 |
, 'prop_Container_nameOf
|
|
| 465 |
, 'prop_Container_findByName
|
|
| 466 |
]
|
|
| 466 | 467 |
|
| 467 | 468 |
-- ** Instance tests |
| 468 | 469 |
|
| ... | ... | |
| 551 | 552 |
Instance.movable inst' == m |
| 552 | 553 |
where inst' = Instance.setMovable inst m |
| 553 | 554 |
|
| 554 |
testInstance =
|
|
| 555 |
[ run prop_Instance_creat
|
|
| 556 |
, run prop_Instance_setIdx
|
|
| 557 |
, run prop_Instance_setName
|
|
| 558 |
, run prop_Instance_setAlias
|
|
| 559 |
, run prop_Instance_setPri
|
|
| 560 |
, run prop_Instance_setSec
|
|
| 561 |
, run prop_Instance_setBoth
|
|
| 562 |
, run prop_Instance_runStatus_True
|
|
| 563 |
, run prop_Instance_runStatus_False
|
|
| 564 |
, run prop_Instance_shrinkMG
|
|
| 565 |
, run prop_Instance_shrinkMF
|
|
| 566 |
, run prop_Instance_shrinkCG
|
|
| 567 |
, run prop_Instance_shrinkCF
|
|
| 568 |
, run prop_Instance_shrinkDG
|
|
| 569 |
, run prop_Instance_shrinkDF
|
|
| 570 |
, run prop_Instance_setMovable
|
|
| 571 |
] |
|
| 555 |
testSuite "Instance"
|
|
| 556 |
[ 'prop_Instance_creat
|
|
| 557 |
, 'prop_Instance_setIdx
|
|
| 558 |
, 'prop_Instance_setName
|
|
| 559 |
, 'prop_Instance_setAlias
|
|
| 560 |
, 'prop_Instance_setPri
|
|
| 561 |
, 'prop_Instance_setSec
|
|
| 562 |
, 'prop_Instance_setBoth
|
|
| 563 |
, 'prop_Instance_runStatus_True
|
|
| 564 |
, 'prop_Instance_runStatus_False
|
|
| 565 |
, 'prop_Instance_shrinkMG
|
|
| 566 |
, 'prop_Instance_shrinkMF
|
|
| 567 |
, 'prop_Instance_shrinkCG
|
|
| 568 |
, 'prop_Instance_shrinkCF
|
|
| 569 |
, 'prop_Instance_shrinkDG
|
|
| 570 |
, 'prop_Instance_shrinkDF
|
|
| 571 |
, 'prop_Instance_setMovable
|
|
| 572 |
]
|
|
| 572 | 573 |
|
| 573 | 574 |
-- ** Text backend tests |
| 574 | 575 |
|
| ... | ... | |
| 663 | 664 |
-- override failN1 to what loadNode returns by default |
| 664 | 665 |
where n = node { Node.failN1 = True, Node.offline = False }
|
| 665 | 666 |
|
| 666 |
testText =
|
|
| 667 |
[ run prop_Text_Load_Instance
|
|
| 668 |
, run prop_Text_Load_InstanceFail
|
|
| 669 |
, run prop_Text_Load_Node
|
|
| 670 |
, run prop_Text_Load_NodeFail
|
|
| 671 |
, run prop_Text_NodeLSIdempotent
|
|
| 672 |
] |
|
| 667 |
testSuite "Text"
|
|
| 668 |
[ 'prop_Text_Load_Instance
|
|
| 669 |
, 'prop_Text_Load_InstanceFail
|
|
| 670 |
, 'prop_Text_Load_Node
|
|
| 671 |
, 'prop_Text_Load_NodeFail
|
|
| 672 |
, 'prop_Text_NodeLSIdempotent
|
|
| 673 |
]
|
|
| 673 | 674 |
|
| 674 | 675 |
-- ** Node tests |
| 675 | 676 |
|
| ... | ... | |
| 790 | 791 |
fst (Node.showHeader field) /= Types.unknownField && |
| 791 | 792 |
Node.showField node field /= Types.unknownField |
| 792 | 793 |
|
| 793 |
|
|
| 794 | 794 |
prop_Node_computeGroups nodes = |
| 795 | 795 |
let ng = Node.computeGroups nodes |
| 796 | 796 |
onlyuuid = map fst ng |
| ... | ... | |
| 799 | 799 |
length (nub onlyuuid) == length onlyuuid && |
| 800 | 800 |
(null nodes || not (null ng)) |
| 801 | 801 |
|
| 802 |
testNode = |
|
| 803 |
[ run prop_Node_setAlias |
|
| 804 |
, run prop_Node_setOffline |
|
| 805 |
, run prop_Node_setMcpu |
|
| 806 |
, run prop_Node_setXmem |
|
| 807 |
, run prop_Node_addPriFM |
|
| 808 |
, run prop_Node_addPriFD |
|
| 809 |
, run prop_Node_addPriFC |
|
| 810 |
, run prop_Node_addSec |
|
| 811 |
, run prop_Node_rMem |
|
| 812 |
, run prop_Node_setMdsk |
|
| 813 |
, run prop_Node_tagMaps_idempotent |
|
| 814 |
, run prop_Node_tagMaps_reject |
|
| 815 |
, run prop_Node_showField |
|
| 816 |
, run prop_Node_computeGroups |
|
| 817 |
] |
|
| 818 |
|
|
| 802 |
testSuite "Node" |
|
| 803 |
[ 'prop_Node_setAlias |
|
| 804 |
, 'prop_Node_setOffline |
|
| 805 |
, 'prop_Node_setMcpu |
|
| 806 |
, 'prop_Node_setXmem |
|
| 807 |
, 'prop_Node_addPriFM |
|
| 808 |
, 'prop_Node_addPriFD |
|
| 809 |
, 'prop_Node_addPriFC |
|
| 810 |
, 'prop_Node_addSec |
|
| 811 |
, 'prop_Node_rMem |
|
| 812 |
, 'prop_Node_setMdsk |
|
| 813 |
, 'prop_Node_tagMaps_idempotent |
|
| 814 |
, 'prop_Node_tagMaps_reject |
|
| 815 |
, 'prop_Node_showField |
|
| 816 |
, 'prop_Node_computeGroups |
|
| 817 |
] |
|
| 819 | 818 |
|
| 820 | 819 |
-- ** Cluster tests |
| 821 | 820 |
|
| ... | ... | |
| 957 | 956 |
all (\(guuid, (nl'', _)) -> all ((== guuid) . Node.group) |
| 958 | 957 |
(Container.elems nl'')) gni |
| 959 | 958 |
|
| 960 |
testCluster =
|
|
| 961 |
[ run prop_Score_Zero
|
|
| 962 |
, run prop_CStats_sane
|
|
| 963 |
, run prop_ClusterAlloc_sane
|
|
| 964 |
, run prop_ClusterCanTieredAlloc
|
|
| 965 |
, run prop_ClusterAllocEvac
|
|
| 966 |
, run prop_ClusterAllocBalance
|
|
| 967 |
, run prop_ClusterCheckConsistency
|
|
| 968 |
, run prop_ClusterSplitCluster
|
|
| 969 |
] |
|
| 959 |
testSuite "Cluster"
|
|
| 960 |
[ 'prop_Score_Zero
|
|
| 961 |
, 'prop_CStats_sane
|
|
| 962 |
, 'prop_ClusterAlloc_sane
|
|
| 963 |
, 'prop_ClusterCanTieredAlloc
|
|
| 964 |
, 'prop_ClusterAllocEvac
|
|
| 965 |
, 'prop_ClusterAllocBalance
|
|
| 966 |
, 'prop_ClusterCheckConsistency
|
|
| 967 |
, 'prop_ClusterSplitCluster
|
|
| 968 |
]
|
|
| 970 | 969 |
|
| 971 | 970 |
-- ** OpCodes tests |
| 972 | 971 |
|
| ... | ... | |
| 977 | 976 |
J.Ok op' -> op == op' |
| 978 | 977 |
where _types = op::OpCodes.OpCode |
| 979 | 978 |
|
| 980 |
testOpCodes = |
|
| 981 |
[ run prop_OpCodes_serialization |
|
| 982 |
] |
|
| 979 |
testSuite "OpCodes" |
|
| 980 |
[ 'prop_OpCodes_serialization ] |
|
| 983 | 981 |
|
| 984 | 982 |
-- ** Jobs tests |
| 985 | 983 |
|
| ... | ... | |
| 996 | 994 |
J.Ok js' -> js == js' |
| 997 | 995 |
where _types = js::Jobs.JobStatus |
| 998 | 996 |
|
| 999 |
testJobs =
|
|
| 1000 |
[ run prop_OpStatus_serialization
|
|
| 1001 |
, run prop_JobStatus_serialization
|
|
| 1002 |
] |
|
| 997 |
testSuite "Jobs"
|
|
| 998 |
[ 'prop_OpStatus_serialization
|
|
| 999 |
, 'prop_JobStatus_serialization
|
|
| 1000 |
]
|
|
| 1003 | 1001 |
|
| 1004 | 1002 |
-- ** Loader tests |
| 1005 | 1003 |
|
| ... | ... | |
| 1044 | 1042 |
Loader.compareNameComponent (s1 ++ "." ++ s2) s1 == |
| 1045 | 1043 |
Loader.LookupResult Loader.PartialMatch s1 |
| 1046 | 1044 |
|
| 1047 |
testLoader =
|
|
| 1048 |
[ run prop_Loader_lookupNode
|
|
| 1049 |
, run prop_Loader_lookupInstance
|
|
| 1050 |
, run prop_Loader_assignIndices
|
|
| 1051 |
, run prop_Loader_mergeData
|
|
| 1052 |
, run prop_Loader_compareNameComponent_equal
|
|
| 1053 |
, run prop_Loader_compareNameComponent_prefix
|
|
| 1054 |
] |
|
| 1045 |
testSuite "Loader"
|
|
| 1046 |
[ 'prop_Loader_lookupNode
|
|
| 1047 |
, 'prop_Loader_lookupInstance
|
|
| 1048 |
, 'prop_Loader_assignIndices
|
|
| 1049 |
, 'prop_Loader_mergeData
|
|
| 1050 |
, 'prop_Loader_compareNameComponent_equal
|
|
| 1051 |
, 'prop_Loader_compareNameComponent_prefix
|
|
| 1052 |
]
|
|
| 1055 | 1053 |
|
| 1056 | 1054 |
-- ** Types tests |
| 1057 | 1055 |
|
| ... | ... | |
| 1088 | 1086 |
where r = Types.eitherToResult ei |
| 1089 | 1087 |
_types = ei::Either String Int |
| 1090 | 1088 |
|
| 1091 |
testTypes = |
|
| 1092 |
[ run prop_Types_AllocPolicy_serialisation |
|
| 1093 |
, run prop_Types_DiskTemplate_serialisation |
|
| 1094 |
, run prop_Types_opToResult |
|
| 1095 |
, run prop_Types_eitherToResult |
|
| 1096 |
] |
|
| 1089 |
testSuite "Types" |
|
| 1090 |
[ 'prop_Types_AllocPolicy_serialisation |
|
| 1091 |
, 'prop_Types_DiskTemplate_serialisation |
|
| 1092 |
, 'prop_Types_opToResult |
|
| 1093 |
, 'prop_Types_eitherToResult |
|
| 1094 |
] |
|
Also available in: Unified diff