From 7018af9cf85b5cc82ac32dff404096afc586d0ea Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Mon, 5 Mar 2012 22:55:49 +0200
Subject: [PATCH] Fix relocation test ClusterAllocRelocate
As for the evacuate tests, we require a mirrored disk template, but
otherwise the test should work for both mirror types.
Additionally, we perform a simplification that was left as TODO.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
htools/Ganeti/HTools/QC.hs | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index 09b05bf6c..22a551634 100644
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -1236,14 +1236,16 @@ genClusterAlloc count node inst =
prop_ClusterAllocRelocate =
forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
- forAll (genInstanceSmallerThanNode node) $ \inst ->
+ forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg
Types.Ok (nl, il, inst') ->
case IAlloc.processRelocate defGroupList nl il
- (Instance.idx inst) 1 [Instance.sNode inst'] of
- Types.Ok _ -> printTestCase "??" True -- huh, how to make
- -- this nicer...
+ (Instance.idx inst) 1
+ [(if Instance.diskTemplate inst' == Types.DTDrbd8
+ then Instance.sNode
+ else Instance.pNode) inst'] of
+ Types.Ok _ -> property True
Types.Bad msg -> failTest $ "Failed to relocate: " ++ msg
-- | Helper property checker for the result of a nodeEvac or
--
GitLab