commit fb24310595b42ac0c69d58cd3b94a1872f9d574e
Author: Iustin Pop <iustin@google.com>
Date:   Fri Sep 7 02:19:46 2012 +0900

    Improve the `CanTieredAlloc' test
    
    Currently, this test is very slow. Upon investigation, this is due to
    how `tieredAlloc' works:
    
    - tries to allocate one instance
    - if failed, shrink the instance by the "most failed" resource
    - restart
    
    In this algorithm, if the "most failed" resource is e.g. memory, and
    the maximum available memory is much smaller than the current
    template, it means we will have to shrink and try to allocate many
    many times until we finally get with the to-be-allocated instance
    memory size to a reasonable value. In the real world, this is not the
    case, but when testing with arbitrary memory/node values, it can be
    that we execute the shrink hundreds of thousands of times per test.
    
    So we "improve" the test by directly generating an instance just
    slightly bigger than the node, so that we don't have to shrink too
    many times. This requires a new export from test/…/Instance.hs.
    
    Additionally, we allow up to 5 instances to be tiered-allocated, and
    we cleanup the test checks, making the conditions much, much more
    readable (IMHO).
    
    Signed-off-by: Iustin Pop <iustin@google.com>
    Reviewed-by: Guido Trotter <ultrotter@google.com>

diff --git a/htest/Test/Ganeti/HTools/Cluster.hs b/htest/Test/Ganeti/HTools/Cluster.hs
index 37a2142..c10b30c 100644
--- a/htest/Test/Ganeti/HTools/Cluster.hs
+++ b/htest/Test/Ganeti/HTools/Cluster.hs
@@ -36,7 +36,8 @@ import Data.Maybe
 import Test.Ganeti.TestHelper
 import Test.Ganeti.TestCommon
 import Test.Ganeti.TestHTools
-import Test.Ganeti.HTools.Instance (genInstanceSmallerThanNode)
+import Test.Ganeti.HTools.Instance ( genInstanceSmallerThanNode
+                                   , genInstanceSmallerThan )
 import Test.Ganeti.HTools.Node (genOnlineNode, genNode)
 
 import qualified Ganeti.HTools.Cluster as Cluster
@@ -185,34 +186,37 @@ prop_IterateAlloc_sane inst =
 -- instance spec via tiered allocation (whatever the original instance
 -- spec), on either one or two nodes. Furthermore, we test that
 -- computed allocation statistics are correct.
-prop_CanTieredAlloc :: Instance.Instance -> Property
-prop_CanTieredAlloc inst =
+prop_CanTieredAlloc :: Property
+prop_CanTieredAlloc =
   forAll (choose (2, 5)) $ \count ->
   forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
+  forAll (genInstanceSmallerThan
+            (Node.availMem  node + Types.unitMem * 2)
+            (Node.availDisk node + Types.unitDsk * 3)
+            (Node.availCpu  node + Types.unitCpu * 4)) $ \inst ->
   let nl = makeSmallCluster node count
       il = Container.empty
       rqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
       allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
   in case allocnodes >>= \allocnodes' ->
-    Cluster.tieredAlloc nl il (Just 1) inst allocnodes' [] [] of
+    Cluster.tieredAlloc nl il (Just 5) inst allocnodes' [] [] of
        Types.Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg
        Types.Ok (_, nl', il', ixes, cstats) ->
          let (ai_alloc, ai_pool, ai_unav) =
                Cluster.computeAllocationDelta
                 (Cluster.totalResources nl)
                 (Cluster.totalResources nl')
-             all_nodes = Container.elems nl
-         in property (not (null ixes)) .&&.
-            IntMap.size il' ==? length ixes .&&.
-            length ixes ==? length cstats .&&.
-            sum (map Types.allocInfoVCpus [ai_alloc, ai_pool, ai_unav]) ==?
-              sum (map Node.hiCpu all_nodes) .&&.
-            sum (map Types.allocInfoNCpus [ai_alloc, ai_pool, ai_unav]) ==?
-              sum (map Node.tCpu all_nodes) .&&.
-            sum (map Types.allocInfoMem [ai_alloc, ai_pool, ai_unav]) ==?
-              truncate (sum (map Node.tMem all_nodes)) .&&.
-            sum (map Types.allocInfoDisk [ai_alloc, ai_pool, ai_unav]) ==?
-              truncate (sum (map Node.tDsk all_nodes))
+             all_nodes fn = sum $ map fn (Container.elems nl)
+             all_res fn = sum $ map fn [ai_alloc, ai_pool, ai_unav]
+         in conjoin
+            [ printTestCase "No instances allocated" $ not (null ixes)
+            , IntMap.size il' ==? length ixes
+            , length ixes     ==? length cstats
+            , all_res Types.allocInfoVCpus ==? all_nodes Node.hiCpu
+            , all_res Types.allocInfoNCpus ==? all_nodes Node.tCpu
+            , all_res Types.allocInfoMem   ==? truncate (all_nodes Node.tMem)
+            , all_res Types.allocInfoDisk  ==? truncate (all_nodes Node.tDsk)
+            ]
 
 -- | Helper function to create a cluster with the given range of nodes
 -- and allocate an instance on it.
