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