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>

diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index 09b05bf..22a5516 100644 (file)
--- 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