Revision 9e679143
| b/htest/Test/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 367 | 367 |
(Container.elems nl'')) gni |
| 368 | 368 |
|
| 369 | 369 |
-- | Helper function to check if we can allocate an instance on a |
| 370 |
-- given node list. |
|
| 371 |
canAllocOn :: Node.List -> Int -> Instance.Instance -> Bool |
|
| 370 |
-- given node list. Successful allocation is denoted by 'Nothing', |
|
| 371 |
-- otherwise the 'Just' value will contain the error message. |
|
| 372 |
canAllocOn :: Node.List -> Int -> Instance.Instance -> Maybe String |
|
| 372 | 373 |
canAllocOn nl reqnodes inst = |
| 373 | 374 |
case Cluster.genAllocNodes defGroupList nl reqnodes True >>= |
| 374 | 375 |
Cluster.tryAlloc nl Container.empty inst of |
| 375 |
Types.Bad _ -> False
|
|
| 376 |
Types.Bad msg -> Just $ "Can't allocate: " ++ msg
|
|
| 376 | 377 |
Types.Ok as -> |
| 377 | 378 |
case Cluster.asSolution as of |
| 378 |
Nothing -> False |
|
| 379 |
Just _ -> True |
|
| 379 |
Nothing -> Just $ "No allocation solution; failures: " ++ |
|
| 380 |
show (Cluster.collapseFailures $ Cluster.asFailures as) |
|
| 381 |
Just _ -> Nothing |
|
| 380 | 382 |
|
| 381 | 383 |
-- | Checks that allocation obeys minimum and maximum instance |
| 382 | 384 |
-- policies. The unittest generates a random node, duplicates it /count/ |
| 383 | 385 |
-- times, and generates a random instance that can be allocated on |
| 384 | 386 |
-- this mini-cluster; it then checks that after applying a policy that |
| 385 | 387 |
-- the instance doesn't fits, the allocation fails. |
| 386 |
prop_AllocPolicy :: Node.Node -> Property |
|
| 387 |
prop_AllocPolicy node = |
|
| 388 |
-- rqn is the required nodes (1 or 2) |
|
| 389 |
forAll (choose (1, 2)) $ \rqn -> |
|
| 388 |
prop_AllocPolicy :: Property |
|
| 389 |
prop_AllocPolicy = |
|
| 390 |
forAll genOnlineNode $ \node -> |
|
| 390 | 391 |
forAll (choose (5, 20)) $ \count -> |
| 391 |
forAll (arbitrary `suchThat` canAllocOn (makeSmallCluster node count) rqn) |
|
| 392 |
$ \inst -> |
|
| 392 |
forAll (genInstanceSmallerThanNode node) $ \inst -> |
|
| 393 | 393 |
forAll (arbitrary `suchThat` (isFailure . |
| 394 | 394 |
Instance.instMatchesPolicy inst)) $ \ipol -> |
| 395 |
let node' = Node.setPolicy ipol node |
|
| 395 |
let rqn = Instance.requiredNodes $ Instance.diskTemplate inst |
|
| 396 |
node' = Node.setPolicy ipol node |
|
| 396 | 397 |
nl = makeSmallCluster node' count |
| 397 |
in not $ canAllocOn nl rqn inst |
|
| 398 |
in printTestCase "Allocation check:" |
|
| 399 |
(isNothing (canAllocOn (makeSmallCluster node count) rqn inst)) .&&. |
|
| 400 |
printTestCase "Policy failure check:" (isJust $ canAllocOn nl rqn inst) |
|
| 398 | 401 |
|
| 399 | 402 |
testSuite "HTools/Cluster" |
| 400 | 403 |
[ 'prop_Score_Zero |
Also available in: Unified diff