Revision 96bc2003
b/htools/Ganeti/HTools/QC.hs | ||
---|---|---|
139 | 139 |
show x ++ "' /= '" ++ show y ++ "'") (x == y) |
140 | 140 |
infix 3 ==? |
141 | 141 |
|
142 |
-- | Show a message and fail the test. |
|
143 |
failTest :: String -> Property |
|
144 |
failTest msg = printTestCase msg False |
|
145 |
|
|
142 | 146 |
-- | Update an instance to be smaller than a node. |
143 | 147 |
setInstanceSmallerThanNode node inst = |
144 | 148 |
inst { Instance.mem = Node.availMem node `div` 2 |
... | ... | |
709 | 713 |
, snode::String |
710 | 714 |
, autobal::Bool) |
711 | 715 |
in case inst of |
712 |
Types.Bad msg -> printTestCase ("Failed to load instance: " ++ msg) |
|
713 |
False |
|
716 |
Types.Bad msg -> failTest $ "Failed to load instance: " ++ msg |
|
714 | 717 |
Types.Ok (_, i) -> printTestCase "Mismatch in some field while\ |
715 | 718 |
\ loading the instance" $ |
716 | 719 |
Instance.name i == name && |
... | ... | |
726 | 729 |
prop_Text_Load_InstanceFail ktn fields = |
727 | 730 |
length fields /= 10 ==> |
728 | 731 |
case Text.loadInst nl fields of |
729 |
Types.Ok _ -> printTestCase "Managed to load instance from invalid\ |
|
730 |
\ data" False |
|
732 |
Types.Ok _ -> failTest "Managed to load instance from invalid data" |
|
731 | 733 |
Types.Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $ |
732 | 734 |
"Invalid/incomplete instance data: '" `isPrefixOf` msg |
733 | 735 |
where nl = Data.Map.fromList ktn |
... | ... | |
776 | 778 |
prop_Text_ISpecIdempotent ispec = |
777 | 779 |
case Text.loadISpec "dummy" . Utils.sepSplit ',' . |
778 | 780 |
Text.serializeISpec $ ispec of |
779 |
Types.Bad msg -> printTestCase ("Failed to load ispec: " ++ msg) False
|
|
781 |
Types.Bad msg -> failTest $ "Failed to load ispec: " ++ msg
|
|
780 | 782 |
Types.Ok ispec' -> ispec ==? ispec' |
781 | 783 |
|
782 | 784 |
prop_Text_IPolicyIdempotent ipol = |
783 | 785 |
case Text.loadIPolicy . Utils.sepSplit '|' $ |
784 | 786 |
Text.serializeIPolicy owner ipol of |
785 |
Types.Bad msg -> printTestCase ("Failed to load ispec: " ++ msg) False
|
|
787 |
Types.Bad msg -> failTest $ "Failed to load ispec: " ++ msg
|
|
786 | 788 |
Types.Ok res -> (owner, ipol) ==? res |
787 | 789 |
where owner = "dummy" |
788 | 790 |
|
... | ... | |
805 | 807 |
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= \allocn -> |
806 | 808 |
Cluster.iterateAlloc nl Container.empty (Just maxiter) inst' allocn [] [] |
807 | 809 |
of |
808 |
Types.Bad msg -> printTestCase ("Failed to allocate: " ++ msg) False
|
|
810 |
Types.Bad msg -> failTest $ "Failed to allocate: " ++ msg
|
|
809 | 811 |
Types.Ok (_, _, _, [], _) -> printTestCase |
810 | 812 |
"Failed to allocate: no allocations" False |
811 | 813 |
Types.Ok (_, nl', il', _, _) -> |
... | ... | |
813 | 815 |
Types.defIPolicy |
814 | 816 |
saved = Text.serializeCluster cdata |
815 | 817 |
in case Text.parseData saved >>= Loader.mergeData [] [] [] [] of |
816 |
Types.Bad msg -> printTestCase ("Failed to load/merge: " ++ |
|
817 |
msg) False |
|
818 |
Types.Bad msg -> failTest $ "Failed to load/merge: " ++ msg |
|
818 | 819 |
Types.Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) -> |
819 | 820 |
ctags ==? ctags2 .&&. |
820 | 821 |
Types.defIPolicy ==? cpol2 .&&. |
... | ... | |
943 | 944 |
-- test as any |
944 | 945 |
inst_idx `elem` Node.sList a_ab && |
945 | 946 |
inst_idx `notElem` Node.sList d_ab |
946 |
x -> printTestCase ("Failed to add/remove instances: " ++ show x) False
|
|
947 |
x -> failTest $ "Failed to add/remove instances: " ++ show x
|
|
947 | 948 |
|
948 | 949 |
-- | Check mdsk setting. |
949 | 950 |
prop_Node_setMdsk node mx = |
... | ... | |
1092 | 1093 |
i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu |
1093 | 1094 |
in case allocnodes >>= \allocnodes' -> |
1094 | 1095 |
Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of |
1095 |
Types.Bad _ -> printTestCase "Failed to allocate" False
|
|
1096 |
Types.Ok (_, _, _, [], _) -> printTestCase "Failed to allocate" False
|
|
1096 |
Types.Bad msg -> failTest $ "Failed to allocate: " ++ msg
|
|
1097 |
Types.Ok (_, _, _, [], _) -> failTest "Failed to allocate: no instances"
|
|
1097 | 1098 |
Types.Ok (_, xnl, il', _, _) -> |
1098 | 1099 |
let ynl = Container.add (Node.idx hnode) hnode xnl |
1099 | 1100 |
cv = Cluster.compCV ynl |
... | ... | |
1172 | 1173 |
-- | Check that opcode serialization is idempotent. |
1173 | 1174 |
prop_OpCodes_serialization op = |
1174 | 1175 |
case J.readJSON (J.showJSON op) of |
1175 |
J.Error e -> printTestCase ("Cannot deserialise: " ++ e) False
|
|
1176 |
J.Error e -> failTest $ "Cannot deserialise: " ++ e
|
|
1176 | 1177 |
J.Ok op' -> op ==? op' |
1177 | 1178 |
where _types = op::OpCodes.OpCode |
1178 | 1179 |
|
... | ... | |
1184 | 1185 |
-- | Check that (queued) job\/opcode status serialization is idempotent. |
1185 | 1186 |
prop_OpStatus_serialization os = |
1186 | 1187 |
case J.readJSON (J.showJSON os) of |
1187 |
J.Error e -> printTestCase ("Cannot deserialise: " ++ e) False
|
|
1188 |
J.Error e -> failTest $ "Cannot deserialise: " ++ e
|
|
1188 | 1189 |
J.Ok os' -> os ==? os' |
1189 | 1190 |
where _types = os::Jobs.OpStatus |
1190 | 1191 |
|
1191 | 1192 |
prop_JobStatus_serialization js = |
1192 | 1193 |
case J.readJSON (J.showJSON js) of |
1193 |
J.Error e -> printTestCase ("Cannot deserialise: " ++ e) False
|
|
1194 |
J.Error e -> failTest $ "Cannot deserialise: " ++ e
|
|
1194 | 1195 |
J.Ok js' -> js ==? js' |
1195 | 1196 |
where _types = js::Jobs.JobStatus |
1196 | 1197 |
|
... | ... | |
1257 | 1258 |
prop_Types_AllocPolicy_serialisation apol = |
1258 | 1259 |
case J.readJSON (J.showJSON apol) of |
1259 | 1260 |
J.Ok p -> p ==? apol |
1260 |
J.Error s -> printTestCase ("failed to deserialise: " ++ s) False
|
|
1261 |
J.Error s -> failTest $ "Failed to deserialise: " ++ s
|
|
1261 | 1262 |
where _types = apol::Types.AllocPolicy |
1262 | 1263 |
|
1263 | 1264 |
prop_Types_DiskTemplate_serialisation dt = |
1264 | 1265 |
case J.readJSON (J.showJSON dt) of |
1265 | 1266 |
J.Ok p -> p ==? dt |
1266 |
J.Error s -> printTestCase ("failed to deserialise: " ++ s) |
|
1267 |
False |
|
1267 |
J.Error s -> failTest $ "Failed to deserialise: " ++ s |
|
1268 | 1268 |
where _types = dt::Types.DiskTemplate |
1269 | 1269 |
|
1270 | 1270 |
prop_Types_ISpec_serialisation ispec = |
1271 | 1271 |
case J.readJSON (J.showJSON ispec) of |
1272 | 1272 |
J.Ok p -> p ==? ispec |
1273 |
J.Error s -> printTestCase ("failed to deserialise: " ++ s) |
|
1274 |
False |
|
1273 |
J.Error s -> failTest $ "Failed to deserialise: " ++ s |
|
1275 | 1274 |
where _types = ispec::Types.ISpec |
1276 | 1275 |
|
1277 | 1276 |
prop_Types_IPolicy_serialisation ipol = |
1278 | 1277 |
case J.readJSON (J.showJSON ipol) of |
1279 | 1278 |
J.Ok p -> p ==? ipol |
1280 |
J.Error s -> printTestCase ("failed to deserialise: " ++ s) |
|
1281 |
False |
|
1279 |
J.Error s -> failTest $ "Failed to deserialise: " ++ s |
|
1282 | 1280 |
where _types = ipol::Types.IPolicy |
1283 | 1281 |
|
1284 | 1282 |
prop_Types_EvacMode_serialisation em = |
1285 | 1283 |
case J.readJSON (J.showJSON em) of |
1286 | 1284 |
J.Ok p -> p ==? em |
1287 |
J.Error s -> printTestCase ("failed to deserialise: " ++ s) |
|
1288 |
False |
|
1285 |
J.Error s -> failTest $ "Failed to deserialise: " ++ s |
|
1289 | 1286 |
where _types = em::Types.EvacMode |
1290 | 1287 |
|
1291 | 1288 |
prop_Types_opToResult op = |
Also available in: Unified diff