Revision f4d1bb75 test/hs/Test/Ganeti/HTools/Cluster.hs

b/test/hs/Test/Ganeti/HTools/Cluster.hs
148 148
                printTestCase "Solution score differs from actual node list:"
149 149
                  (Cluster.compCV xnl ==? cv)
150 150

  
151
-- | Check that multiple instances can allocated correctly, without
152
-- rebalances needed.
153
prop_IterateAlloc_sane :: Instance.Instance -> Property
154
prop_IterateAlloc_sane inst =
155
  forAll (choose (5, 10)) $ \count ->
156
  forAll genOnlineNode $ \node ->
157
  forAll (choose (2, 5)) $ \limit ->
158
  let (nl, il, inst') = makeSmallEmptyCluster node count inst
159
      reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
160
      allocnodes = Cluster.genAllocNodes defGroupList nl reqnodes True
161
  in case allocnodes >>= \allocnodes' ->
162
     Cluster.iterateAlloc nl il (Just limit) inst' allocnodes' [] [] of
163
       Bad msg -> failTest msg
164
       Ok (_, xnl, xil, _, _) ->
165
         let old_score = Cluster.compCV xnl
166
             tbl = Cluster.Table xnl xil old_score []
167
         in case Cluster.tryBalance tbl True True False 0 1e-4 of
168
              Nothing -> passTest
169
              Just (Cluster.Table ynl _ new_score plcs) ->
170
                -- note that with a "min_gain" of zero, sometime
171
                -- rounding errors can trigger a rebalance that
172
                -- improves the score by e.g. 2e-14; in order to
173
                -- prevent such no-real-change moves from happening,
174
                -- we check for a min-gain of 1e-9
175
                -- FIXME: correct rebalancing to not do no-ops
176
                printTestCase
177
                  ("Cluster can be balanced after allocation\n" ++
178
                   " old cluster (score " ++ show old_score ++
179
                   "):\n" ++ Cluster.printNodes xnl [] ++
180
                   " new cluster (score " ++ show new_score ++
181
                   "):\n" ++ Cluster.printNodes ynl [] ++
182
                   "placements:\n" ++ show plcs ++ "\nscore delta: " ++
183
                   show (old_score - new_score))
184
                  (old_score - new_score < 1e-9)
185

  
186 151
-- | Checks that on a 2-5 node cluster, we can allocate a random
187 152
-- instance spec via tiered allocation (whatever the original instance
188 153
-- spec), on either one or two nodes. Furthermore, we test that

Also available in: Unified diff