diff --git a/htest/Test/Ganeti/BasicTypes.hs b/htest/Test/Ganeti/BasicTypes.hs
index af90b0e86d4dc68f9d12a1bba163cebdaff8b116..1eab1259cfa5f61272d79327b206cea97bb572fe 100644
--- a/htest/Test/Ganeti/BasicTypes.hs
+++ b/htest/Test/Ganeti/BasicTypes.hs
@@ -114,10 +114,12 @@ prop_monad_laws :: Int -> Result Int
-> Fun Int (Result Int)
-> Property
prop_monad_laws a m (Fun _ k) (Fun _ h) =
- printTestCase "return a >>= k == k a" ((return a >>= k) ==? k a) .&&.
- printTestCase "m >>= return == m" ((m >>= return) ==? m) .&&.
- printTestCase "m >>= (\\x -> k x >>= h) == (m >>= k) >>= h)"
+ conjoin
+ [ printTestCase "return a >>= k == k a" ((return a >>= k) ==? k a)
+ , printTestCase "m >>= return == m" ((m >>= return) ==? m)
+ , printTestCase "m >>= (\\x -> k x >>= h) == (m >>= k) >>= h)"
((m >>= (\x -> k x >>= h)) ==? ((m >>= k) >>= h))
+ ]
-- | Tests the monad plus laws ( mzero >>= f = mzero, v >> mzero = mzero).
prop_monadplus_mzero :: Result Int -> Fun Int (Result Int) -> Property
diff --git a/htest/Test/Ganeti/HTools/Cluster.hs b/htest/Test/Ganeti/HTools/Cluster.hs
index 6e79294058e0038491cc760f7c2a81ab9305d89d..cd61df9c7b952b7c44e24fc3d5096e8050970245 100644
--- a/htest/Test/Ganeti/HTools/Cluster.hs
+++ b/htest/Test/Ganeti/HTools/Cluster.hs
@@ -266,14 +266,15 @@ check_EvacMode grp inst result =
let moved = Cluster.esMoved es
failed = Cluster.esFailed es
opcodes = not . null $ Cluster.esOpCodes es
- in failmsg ("'failed' not empty: " ++ show failed) (null failed) .&&.
- failmsg "'opcodes' is null" opcodes .&&.
- case moved of
- [(idx', gdx, _)] -> failmsg "invalid instance moved" (idx == idx')
- .&&.
- failmsg "wrong target group"
- (gdx == Group.idx grp)
- v -> failmsg ("invalid solution: " ++ show v) False
+ in conjoin
+ [ failmsg ("'failed' not empty: " ++ show failed) (null failed)
+ , failmsg "'opcodes' is null" opcodes
+ , case moved of
+ [(idx', gdx, _)] ->
+ failmsg "invalid instance moved" (idx == idx') .&&.
+ failmsg "wrong target group" (gdx == Group.idx grp)
+ v -> failmsg ("invalid solution: " ++ show v) False
+ ]
where failmsg :: String -> Bool -> Property
failmsg msg = printTestCase ("Failed to evacuate: " ++ msg)
idx = Instance.idx inst
diff --git a/htest/Test/Ganeti/HTools/Container.hs b/htest/Test/Ganeti/HTools/Container.hs
index 9394facbc0c7111d0f6a7764097502ac07256809..4df06a735aaefa07c9fb0a0d9506b51234f4257e 100644
--- a/htest/Test/Ganeti/HTools/Container.hs
+++ b/htest/Test/Ganeti/HTools/Container.hs
@@ -74,10 +74,12 @@ prop_findByName =
$ zip names nodes
nl' = Container.fromList nodes'
target = snd (nodes' !! fidx)
- in Container.findByName nl' (Node.name target) ==? Just target .&&.
- Container.findByName nl' (Node.alias target) ==? Just target .&&.
- printTestCase "Found non-existing name"
- (isNothing (Container.findByName nl' othername))
+ in conjoin
+ [ Container.findByName nl' (Node.name target) ==? Just target
+ , Container.findByName nl' (Node.alias target) ==? Just target
+ , printTestCase "Found non-existing name"
+ (isNothing (Container.findByName nl' othername))
+ ]
testSuite "HTools/Container"
[ 'prop_addTwo
diff --git a/htest/Test/Ganeti/HTools/Simu.hs b/htest/Test/Ganeti/HTools/Simu.hs
index 9ea572ac4145199ac00ff500b1014294e51a4782..35348d3cabf01171467a34bd36ff4c131ae570ec 100644
--- a/htest/Test/Ganeti/HTools/Simu.hs
+++ b/htest/Test/Ganeti/HTools/Simu.hs
@@ -82,16 +82,16 @@ prop_Load =
nidx = map Node.idx nodes
mdc_out = map (\n -> (Node.tMem n, Node.tDsk n, Node.tCpu n,
Node.fMem n, Node.fDsk n)) nodes
- in
- Container.size gl ==? ngroups .&&.
- Container.size nl ==? totnodes .&&.
- Container.size il ==? 0 .&&.
- length tags ==? 0 .&&.
- ipol ==? Types.defIPolicy .&&.
- nidx ==? [1..totnodes] .&&.
- mdc_in ==? mdc_out .&&.
- map Group.iPolicy (Container.elems gl) ==?
- replicate ngroups Types.defIPolicy
+ in conjoin [ Container.size gl ==? ngroups
+ , Container.size nl ==? totnodes
+ , Container.size il ==? 0
+ , length tags ==? 0
+ , ipol ==? Types.defIPolicy
+ , nidx ==? [1..totnodes]
+ , mdc_in ==? mdc_out
+ , map Group.iPolicy (Container.elems gl) ==?
+ replicate ngroups Types.defIPolicy
+ ]
testSuite "HTools/Simu"
[ 'prop_Load
diff --git a/htest/Test/Ganeti/HTools/Text.hs b/htest/Test/Ganeti/HTools/Text.hs
index 1237f7ec348a3bb93e1939e40367cffbd2ae6e3b..4ca63cf8455dbec3481e0e09d5393f0ab3441b21 100644
--- a/htest/Test/Ganeti/HTools/Text.hs
+++ b/htest/Test/Ganeti/HTools/Text.hs
@@ -194,11 +194,12 @@ prop_CreateSerialise =
in case Text.parseData saved >>= Loader.mergeData [] [] [] [] of
Bad msg -> failTest $ "Failed to load/merge: " ++ msg
Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) ->
- ctags ==? ctags2 .&&.
- Types.defIPolicy ==? cpol2 .&&.
- il' ==? il2 .&&.
- defGroupList ==? gl2 .&&.
- nl' ==? nl2
+ conjoin [ ctags ==? ctags2
+ , Types.defIPolicy ==? cpol2
+ , il' ==? il2
+ , defGroupList ==? gl2
+ , nl' ==? nl2
+ ]
testSuite "HTools/Text"
[ 'prop_Load_Instance
diff --git a/htest/Test/Ganeti/Objects.hs b/htest/Test/Ganeti/Objects.hs
index d723e1243203d646f46646fe5812dbd60d77f9eb..c269950fe469395dda3f86954e092ebcbf3eca10 100644
--- a/htest/Test/Ganeti/Objects.hs
+++ b/htest/Test/Ganeti/Objects.hs
@@ -199,12 +199,13 @@ prop_fillDict defaults custom =
d_keys = map fst defaults
c_map = Map.fromList custom
c_keys = map fst custom
- in printTestCase "Empty custom filling"
- (fillDict d_map Map.empty [] == d_map) .&&.
- printTestCase "Empty defaults filling"
- (fillDict Map.empty c_map [] == c_map) .&&.
- printTestCase "Delete all keys"
- (fillDict d_map c_map (d_keys++c_keys) == Map.empty)
+ in conjoin [ printTestCase "Empty custom filling"
+ (fillDict d_map Map.empty [] == d_map)
+ , printTestCase "Empty defaults filling"
+ (fillDict Map.empty c_map [] == c_map)
+ , printTestCase "Delete all keys"
+ (fillDict d_map c_map (d_keys++c_keys) == Map.empty)
+ ]
-- | Test that the serialisation of 'DiskLogicalId', which is
-- implemented manually, is idempotent. Since we don't have a
diff --git a/htest/Test/Ganeti/Query/Query.hs b/htest/Test/Ganeti/Query/Query.hs
index 2090cd0b49dd2eef0b40da24dd1663ffc3a08b1c..f9ffafc0e8051dbb21bc82d5dbe68d3993949bcc 100644
--- a/htest/Test/Ganeti/Query/Query.hs
+++ b/htest/Test/Ganeti/Query/Query.hs
@@ -68,13 +68,15 @@ prop_queryNode_noUnknown =
run (query cluster False (Query QRNode [field] EmptyFilter)) >>= resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRNode [field])
- stop $ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
- (hasUnknownFields fdefs) .&&.
- printTestCase ("Got unknown result status via query (" ++
- show fdata ++ ")")
- (all (all ((/= RSUnknown) . rentryStatus)) fdata) .&&.
- printTestCase ("Got unknown fields via query fields (" ++ show fdefs'
- ++ ")") (hasUnknownFields fdefs')
+ stop $ conjoin
+ [ printTestCase ("Got unknown fields via query (" ++
+ show fdefs ++ ")") (hasUnknownFields fdefs)
+ , printTestCase ("Got unknown result status via query (" ++
+ show fdata ++ ")")
+ (all (all ((/= RSUnknown) . rentryStatus)) fdata)
+ , printTestCase ("Got unknown fields via query fields (" ++
+ show fdefs'++ ")") (hasUnknownFields fdefs')
+ ]
-- | Tests that an unknown field is returned as such.
prop_queryNode_Unknown :: Property
@@ -86,16 +88,18 @@ prop_queryNode_Unknown =
run (query cluster False (Query QRNode [field] EmptyFilter)) >>= resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRNode [field])
- stop $ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
- (not $ hasUnknownFields fdefs) .&&.
- printTestCase ("Got /= ResultUnknown result status via query (" ++
- show fdata ++ ")")
- (all (all ((== RSUnknown) . rentryStatus)) fdata) .&&.
- printTestCase ("Got a Just in a result value (" ++
- show fdata ++ ")")
- (all (all (isNothing . rentryValue)) fdata) .&&.
- printTestCase ("Got known fields via query fields (" ++ show fdefs'
- ++ ")") (not $ hasUnknownFields fdefs')
+ stop $ conjoin
+ [ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
+ (not $ hasUnknownFields fdefs)
+ , printTestCase ("Got /= ResultUnknown result status via query (" ++
+ show fdata ++ ")")
+ (all (all ((== RSUnknown) . rentryStatus)) fdata)
+ , printTestCase ("Got a Just in a result value (" ++
+ show fdata ++ ")")
+ (all (all (isNothing . rentryValue)) fdata)
+ , printTestCase ("Got known fields via query fields (" ++ show fdefs'
+ ++ ")") (not $ hasUnknownFields fdefs')
+ ]
-- | Checks that a result type is conforming to a field definition.
checkResultType :: FieldDefinition -> ResultEntry -> Property
@@ -128,14 +132,16 @@ prop_queryNode_types =
forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cfg False (Query QRNode [field] EmptyFilter)) >>= resultProp
- stop $ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
- (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) .&&.
- printTestCase "Wrong field definitions length"
- (length fdefs ==? 1) .&&.
- printTestCase "Wrong field result rows length"
- (all ((== 1) . length) fdata) .&&.
- printTestCase "Wrong number of result rows"
+ stop $ conjoin
+ [ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
+ (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata)
+ , printTestCase "Wrong field definitions length"
+ (length fdefs ==? 1)
+ , printTestCase "Wrong field result rows length"
+ (all ((== 1) . length) fdata)
+ , printTestCase "Wrong number of result rows"
(length fdata ==? numnodes)
+ ]
-- | Test that queryFields with empty fields list returns all node fields.
case_queryNode_allfields :: Assertion
@@ -155,16 +161,19 @@ prop_queryGroup_noUnknown =
forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do
QueryResult fdefs fdata <-
- run (query cluster False (Query QRGroup [field] EmptyFilter)) >>= resultProp
+ run (query cluster False (Query QRGroup [field] EmptyFilter)) >>=
+ resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRGroup [field])
- stop $ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
- (hasUnknownFields fdefs) .&&.
- printTestCase ("Got unknown result status via query (" ++
- show fdata ++ ")")
- (all (all ((/= RSUnknown) . rentryStatus)) fdata) .&&.
- printTestCase ("Got unknown fields via query fields (" ++ show fdefs'
- ++ ")") (hasUnknownFields fdefs')
+ stop $ conjoin
+ [ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
+ (hasUnknownFields fdefs)
+ , printTestCase ("Got unknown result status via query (" ++
+ show fdata ++ ")")
+ (all (all ((/= RSUnknown) . rentryStatus)) fdata)
+ , printTestCase ("Got unknown fields via query fields (" ++ show fdefs'
+ ++ ")") (hasUnknownFields fdefs')
+ ]
prop_queryGroup_Unknown :: Property
prop_queryGroup_Unknown =
@@ -175,16 +184,18 @@ prop_queryGroup_Unknown =
run (query cluster False (Query QRGroup [field] EmptyFilter)) >>= resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRGroup [field])
- stop $ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
- (not $ hasUnknownFields fdefs) .&&.
- printTestCase ("Got /= ResultUnknown result status via query (" ++
- show fdata ++ ")")
- (all (all ((== RSUnknown) . rentryStatus)) fdata) .&&.
- printTestCase ("Got a Just in a result value (" ++
- show fdata ++ ")")
- (all (all (isNothing . rentryValue)) fdata) .&&.
- printTestCase ("Got known fields via query fields (" ++ show fdefs'
- ++ ")") (not $ hasUnknownFields fdefs')
+ stop $ conjoin
+ [ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
+ (not $ hasUnknownFields fdefs)
+ , printTestCase ("Got /= ResultUnknown result status via query (" ++
+ show fdata ++ ")")
+ (all (all ((== RSUnknown) . rentryStatus)) fdata)
+ , printTestCase ("Got a Just in a result value (" ++
+ show fdata ++ ")")
+ (all (all (isNothing . rentryValue)) fdata)
+ , printTestCase ("Got known fields via query fields (" ++ show fdefs'
+ ++ ")") (not $ hasUnknownFields fdefs')
+ ]
prop_queryGroup_types :: Property
prop_queryGroup_types =
@@ -193,12 +204,13 @@ prop_queryGroup_types =
forAll (elements (Map.keys groupFieldsMap)) $ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cfg False (Query QRGroup [field] EmptyFilter)) >>= resultProp
- stop $ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
- (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) .&&.
- printTestCase "Wrong field definitions length"
- (length fdefs ==? 1) .&&.
- printTestCase "Wrong field result rows length"
+ stop $ conjoin
+ [ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
+ (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata)
+ , printTestCase "Wrong field definitions length" (length fdefs ==? 1)
+ , printTestCase "Wrong field result rows length"
(all ((== 1) . length) fdata)
+ ]
case_queryGroup_allfields :: Assertion
case_queryGroup_allfields = do