Revision bc782180
| b/htools/Ganeti/HTools/QC.hs | ||
|---|---|---|
| 38 | 38 |
|
| 39 | 39 |
import Test.QuickCheck |
| 40 | 40 |
import Test.QuickCheck.Batch |
| 41 |
import Data.List (findIndex, intercalate, nub) |
|
| 41 |
import Data.List (findIndex, intercalate, nub, isPrefixOf)
|
|
| 42 | 42 |
import Data.Maybe |
| 43 | 43 |
import Control.Monad |
| 44 | 44 |
import qualified Text.JSON as J |
| ... | ... | |
| 453 | 453 |
|
| 454 | 454 |
-- Instance text loader tests |
| 455 | 455 |
|
| 456 |
prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx = |
|
| 456 |
prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx autobal =
|
|
| 457 | 457 |
not (null pnode) && pdx >= 0 && sdx >= 0 ==> |
| 458 | 458 |
let vcpus_s = show vcpus |
| 459 | 459 |
dsk_s = show dsk |
| ... | ... | |
| 466 | 466 |
else [(pnode, pdx), (snode, rsdx)] |
| 467 | 467 |
nl = Data.Map.fromList ndx |
| 468 | 468 |
tags = "" |
| 469 |
sbal = if autobal then "Y" else "N" |
|
| 469 | 470 |
inst = Text.loadInst nl |
| 470 |
[name, mem_s, dsk_s, vcpus_s, status, pnode, snode, tags]::
|
|
| 471 |
Maybe (String, Instance.Instance) |
|
| 471 |
[name, mem_s, dsk_s, vcpus_s, status, |
|
| 472 |
sbal, pnode, snode, tags]:: Maybe (String, Instance.Instance)
|
|
| 472 | 473 |
fail1 = Text.loadInst nl |
| 473 |
[name, mem_s, dsk_s, vcpus_s, status, pnode, pnode, tags]::
|
|
| 474 |
Maybe (String, Instance.Instance) |
|
| 474 |
[name, mem_s, dsk_s, vcpus_s, status, |
|
| 475 |
sbal, pnode, pnode, tags]:: Maybe (String, Instance.Instance)
|
|
| 475 | 476 |
_types = ( name::String, mem::Int, dsk::Int |
| 476 | 477 |
, vcpus::Int, status::String |
| 477 | 478 |
, pnode::String, snode::String |
| 478 |
, pdx::Types.Ndx, sdx::Types.Ndx) |
|
| 479 |
, pdx::Types.Ndx, sdx::Types.Ndx |
|
| 480 |
, autobal::Bool) |
|
| 479 | 481 |
in |
| 480 | 482 |
case inst of |
| 481 | 483 |
Nothing -> False |
| ... | ... | |
| 487 | 489 |
Instance.sNode i == (if null snode |
| 488 | 490 |
then Node.noSecondary |
| 489 | 491 |
else rsdx) && |
| 492 |
Instance.auto_balance i == autobal && |
|
| 490 | 493 |
isNothing fail1) |
| 491 | 494 |
|
| 492 | 495 |
prop_Text_Load_InstanceFail ktn fields = |
| 493 |
length fields /= 8 ==> isNothing $ Text.loadInst nl fields |
|
| 496 |
length fields /= 9 ==> |
|
| 497 |
case Text.loadInst nl fields of |
|
| 498 |
Right _ -> False |
|
| 499 |
Left msg -> isPrefixOf "Invalid/incomplete instance data: '" msg |
|
| 494 | 500 |
where nl = Data.Map.fromList ktn |
| 495 | 501 |
|
| 496 | 502 |
prop_Text_Load_Node name tm nm fm td fd tc fo = |
| b/htools/Ganeti/HTools/Text.hs | ||
|---|---|---|
| 86 | 86 |
then "" |
| 87 | 87 |
else Container.nameOf nl sidx) |
| 88 | 88 |
in |
| 89 |
printf "%s|%d|%d|%d|%s|%s|%s|%s" |
|
| 89 |
printf "%s|%d|%d|%d|%s|%s|%s|%s|%s"
|
|
| 90 | 90 |
iname (Instance.mem inst) (Instance.dsk inst) |
| 91 | 91 |
(Instance.vcpus inst) (Instance.runSt inst) |
| 92 |
(if Instance.auto_balance inst then "Y" else "N") |
|
| 92 | 93 |
pnode snode (intercalate "," (Instance.tags inst)) |
| 93 | 94 |
|
| 94 | 95 |
-- | Generate instance file data from instance objects |
| ... | ... | |
| 134 | 135 |
-- | Load an instance from a field list. |
| 135 | 136 |
loadInst :: (Monad m) => |
| 136 | 137 |
NameAssoc -> [String] -> m (String, Instance.Instance) |
| 137 |
loadInst ktn [name, mem, dsk, vcpus, status, pnode, snode, tags] = do |
|
| 138 |
loadInst ktn [name, mem, dsk, vcpus, status, auto_bal, pnode, snode, tags] = do
|
|
| 138 | 139 |
pidx <- lookupNode ktn name pnode |
| 139 | 140 |
sidx <- (if null snode then return Node.noSecondary |
| 140 | 141 |
else lookupNode ktn name snode) |
| 141 | 142 |
vmem <- tryRead name mem |
| 142 | 143 |
vdsk <- tryRead name dsk |
| 143 | 144 |
vvcpus <- tryRead name vcpus |
| 145 |
auto_balance <- case auto_bal of |
|
| 146 |
"Y" -> return True |
|
| 147 |
"N" -> return False |
|
| 148 |
_ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++ |
|
| 149 |
"' for instance " ++ name |
|
| 144 | 150 |
when (sidx == pidx) $ fail $ "Instance " ++ name ++ |
| 145 | 151 |
" has same primary and secondary node - " ++ pnode |
| 146 | 152 |
let vtags = sepSplit ',' tags |
| 147 | 153 |
newinst = Instance.create name vmem vdsk vvcpus status vtags |
| 148 |
True pidx sidx
|
|
| 154 |
auto_balance pidx sidx
|
|
| 149 | 155 |
return (name, newinst) |
| 150 | 156 |
loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'" |
| 151 | 157 |
|
Also available in: Unified diff