Commit d5dfae0a authored by Iustin Pop's avatar Iustin Pop
Browse files

htools: re-indent QC.hs


Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarMichael Hanselmann <hansmi@google.com>
parent fd7a7c73
......@@ -26,18 +26,18 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Ganeti.HTools.QC
( testUtils
, testPeerMap
, testContainer
, testInstance
, testNode
, testText
, testOpCodes
, testJobs
, testCluster
, testLoader
, testTypes
) where
( testUtils
, testPeerMap
, testContainer
, testInstance
, testNode
, testText
, testOpCodes
, testJobs
, testCluster
, testLoader
, testTypes
) where
import Test.QuickCheck
import Data.List (findIndex, intercalate, nub, isPrefixOf)
......@@ -91,8 +91,7 @@ maxCpu = 1024
defGroup :: Group.Group
defGroup = flip Group.setIdx 0 $
Group.create "default" Utils.defaultGroupID
Types.AllocPreferred
Group.create "default" Utils.defaultGroupID Types.AllocPreferred
defGroupList :: Group.List
defGroupList = Container.fromList [(Group.idx defGroup, defGroup)]
......@@ -116,23 +115,23 @@ infix 3 ==?
-- | Update an instance to be smaller than a node.
setInstanceSmallerThanNode node inst =
inst { Instance.mem = Node.availMem node `div` 2
, Instance.dsk = Node.availDisk node `div` 2
, Instance.vcpus = Node.availCpu node `div` 2
}
inst { Instance.mem = Node.availMem node `div` 2
, Instance.dsk = Node.availDisk node `div` 2
, Instance.vcpus = Node.availCpu node `div` 2
}
-- | Create an instance given its spec.
createInstance mem dsk vcpus =
Instance.create "inst-unnamed" mem dsk vcpus Types.Running [] True (-1) (-1)
Types.DTDrbd8
Instance.create "inst-unnamed" mem dsk vcpus Types.Running [] True (-1) (-1)
Types.DTDrbd8
-- | Create a small cluster by repeating a node spec.
makeSmallCluster :: Node.Node -> Int -> Node.List
makeSmallCluster node count =
let fn = Node.buildPeers node Container.empty
namelst = map (\n -> (Node.name n, n)) (replicate count fn)
(_, nlst) = Loader.assignIndices namelst
in nlst
let fn = Node.buildPeers node Container.empty
namelst = map (\n -> (Node.name n, n)) (replicate count fn)
(_, nlst) = Loader.assignIndices namelst
in nlst
-- | Checks if a node is "big" enough.
isNodeBig :: Node.Node -> Int -> Bool
......@@ -152,8 +151,8 @@ assignInstance nl il inst pdx sdx =
let pnode = Container.find pdx nl
snode = Container.find sdx nl
maxiidx = if Container.null il
then 0
else fst (Container.findMax il) + 1
then 0
else fst (Container.findMax il) + 1
inst' = inst { Instance.idx = maxiidx,
Instance.pNode = pdx, Instance.sNode = sdx }
pnode' = Node.setPri pnode inst'
......@@ -168,9 +167,9 @@ assignInstance nl il inst pdx sdx =
newtype DNSChar = DNSChar { dnsGetChar::Char }
instance Arbitrary DNSChar where
arbitrary = do
x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
return (DNSChar x)
arbitrary = do
x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
return (DNSChar x)
getName :: Gen String
getName = do
......@@ -178,7 +177,6 @@ getName = do
dn <- vector n::Gen [DNSChar]
return (map dnsGetChar dn)
getFQDN :: Gen String
getFQDN = do
felem <- getName
......@@ -192,16 +190,16 @@ instance Arbitrary Types.InstanceStatus where
-- let's generate a random instance
instance Arbitrary Instance.Instance where
arbitrary = do
name <- getFQDN
mem <- choose (0, maxMem)
dsk <- choose (0, maxDsk)
run_st <- arbitrary
pn <- arbitrary
sn <- arbitrary
vcpus <- choose (0, maxCpu)
return $ Instance.create name mem dsk vcpus run_st [] True pn sn
Types.DTDrbd8
arbitrary = do
name <- getFQDN
mem <- choose (0, maxMem)
dsk <- choose (0, maxDsk)
run_st <- arbitrary
pn <- arbitrary
sn <- arbitrary
vcpus <- choose (0, maxCpu)
return $ Instance.create name mem dsk vcpus run_st [] True pn sn
Types.DTDrbd8
-- | Generas an arbitrary node based on sizing information.
genNode :: Maybe Int -- ^ Minimum node size in terms of units
......@@ -210,17 +208,17 @@ genNode :: Maybe Int -- ^ Minimum node size in terms of units
-> Gen Node.Node
genNode min_multiplier max_multiplier = do
let (base_mem, base_dsk, base_cpu) =
case min_multiplier of
Just mm -> (mm * Types.unitMem,
mm * Types.unitDsk,
mm * Types.unitCpu)
Nothing -> (0, 0, 0)
case min_multiplier of
Just mm -> (mm * Types.unitMem,
mm * Types.unitDsk,
mm * Types.unitCpu)
Nothing -> (0, 0, 0)
(top_mem, top_dsk, top_cpu) =
case max_multiplier of
Just mm -> (mm * Types.unitMem,
mm * Types.unitDsk,
mm * Types.unitCpu)
Nothing -> (maxMem, maxDsk, maxCpu)
case max_multiplier of
Just mm -> (mm * Types.unitMem,
mm * Types.unitDsk,
mm * Types.unitCpu)
Nothing -> (maxMem, maxDsk, maxCpu)
name <- getFQDN
mem_t <- choose (base_mem, top_mem)
mem_f <- choose (base_mem, mem_t)
......@@ -235,7 +233,7 @@ genNode min_multiplier max_multiplier = do
-- and a random node
instance Arbitrary Node.Node where
arbitrary = genNode Nothing Nothing
arbitrary = genNode Nothing Nothing
-- replace disks
instance Arbitrary OpCodes.ReplaceDisksMode where
......@@ -249,19 +247,18 @@ instance Arbitrary OpCodes.OpCode where
, "OP_INSTANCE_MIGRATE"
]
(case op_id of
"OP_TEST_DELAY" ->
liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary
"OP_INSTANCE_REPLACE_DISKS" ->
liftM5 OpCodes.OpInstanceReplaceDisks arbitrary arbitrary
arbitrary arbitrary arbitrary
"OP_INSTANCE_FAILOVER" ->
liftM3 OpCodes.OpInstanceFailover arbitrary arbitrary
arbitrary
"OP_INSTANCE_MIGRATE" ->
liftM5 OpCodes.OpInstanceMigrate arbitrary arbitrary
arbitrary arbitrary
arbitrary
_ -> fail "Wrong opcode")
"OP_TEST_DELAY" ->
liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary
"OP_INSTANCE_REPLACE_DISKS" ->
liftM5 OpCodes.OpInstanceReplaceDisks arbitrary arbitrary
arbitrary arbitrary arbitrary
"OP_INSTANCE_FAILOVER" ->
liftM3 OpCodes.OpInstanceFailover arbitrary arbitrary
arbitrary
"OP_INSTANCE_MIGRATE" ->
liftM5 OpCodes.OpInstanceMigrate arbitrary arbitrary
arbitrary arbitrary arbitrary
_ -> fail "Wrong opcode")
instance Arbitrary Jobs.OpStatus where
arbitrary = elements [minBound..maxBound]
......@@ -271,9 +268,9 @@ instance Arbitrary Jobs.JobStatus where
newtype SmallRatio = SmallRatio Double deriving Show
instance Arbitrary SmallRatio where
arbitrary = do
v <- choose (0, 1)
return $ SmallRatio v
arbitrary = do
v <- choose (0, 1)
return $ SmallRatio v
instance Arbitrary Types.AllocPolicy where
arbitrary = elements [minBound..maxBound]
......@@ -282,13 +279,13 @@ instance Arbitrary Types.DiskTemplate where
arbitrary = elements [minBound..maxBound]
instance Arbitrary Types.FailMode where
arbitrary = elements [minBound..maxBound]
arbitrary = elements [minBound..maxBound]
instance Arbitrary a => Arbitrary (Types.OpResult a) where
arbitrary = arbitrary >>= \c ->
case c of
False -> liftM Types.OpFail arbitrary
True -> liftM Types.OpGood arbitrary
arbitrary = arbitrary >>= \c ->
case c of
False -> liftM Types.OpFail arbitrary
True -> liftM Types.OpGood arbitrary
-- * Actual tests
......@@ -297,28 +294,28 @@ instance Arbitrary a => Arbitrary (Types.OpResult a) where
-- | If the list is not just an empty element, and if the elements do
-- not contain commas, then join+split should be idempotent.
prop_Utils_commaJoinSplit =
forAll (arbitrary `suchThat`
(\l -> l /= [""] && all (not . elem ',') l )) $ \lst ->
Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst
forAll (arbitrary `suchThat`
(\l -> l /= [""] && all (not . elem ',') l )) $ \lst ->
Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst
-- | Split and join should always be idempotent.
prop_Utils_commaSplitJoin s =
Utils.commaJoin (Utils.sepSplit ',' s) ==? s
Utils.commaJoin (Utils.sepSplit ',' s) ==? s
-- | fromObjWithDefault, we test using the Maybe monad and an integer
-- value.
prop_Utils_fromObjWithDefault def_value random_key =
-- a missing key will be returned with the default
Utils.fromObjWithDefault [] random_key def_value == Just def_value &&
-- a found key will be returned as is, not with default
Utils.fromObjWithDefault [(random_key, J.showJSON def_value)]
random_key (def_value+1) == Just def_value
where _types = def_value :: Integer
-- a missing key will be returned with the default
Utils.fromObjWithDefault [] random_key def_value == Just def_value &&
-- a found key will be returned as is, not with default
Utils.fromObjWithDefault [(random_key, J.showJSON def_value)]
random_key (def_value+1) == Just def_value
where _types = def_value :: Integer
-- | Test that functional if' behaves like the syntactic sugar if.
prop_Utils_if'if :: Bool -> Int -> Int -> Gen Prop
prop_Utils_if'if cnd a b =
Utils.if' cnd a b ==? if cnd then a else b
Utils.if' cnd a b ==? if cnd then a else b
-- | Test basic select functionality
prop_Utils_select :: Int -- ^ Default result
......@@ -353,35 +350,35 @@ prop_Utils_select_undefv lst1 (NonEmpty lst2) =
cndlist = flist ++ tlist ++ [undefined]
prop_Utils_parseUnit (NonNegative n) =
Utils.parseUnit (show n) == Types.Ok n &&
Utils.parseUnit (show n ++ "m") == Types.Ok n &&
(case Utils.parseUnit (show n ++ "M") of
Types.Ok m -> if n > 0
then m < n -- for positive values, X MB is less than X MiB
else m == 0 -- but for 0, 0 MB == 0 MiB
Types.Bad _ -> False) &&
Utils.parseUnit (show n ++ "g") == Types.Ok (n*1024) &&
Utils.parseUnit (show n ++ "t") == Types.Ok (n*1048576) &&
Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int)
Utils.parseUnit (show n) == Types.Ok n &&
Utils.parseUnit (show n ++ "m") == Types.Ok n &&
(case Utils.parseUnit (show n ++ "M") of
Types.Ok m -> if n > 0
then m < n -- for positive values, X MB is < than X MiB
else m == 0 -- but for 0, 0 MB == 0 MiB
Types.Bad _ -> False) &&
Utils.parseUnit (show n ++ "g") == Types.Ok (n*1024) &&
Utils.parseUnit (show n ++ "t") == Types.Ok (n*1048576) &&
Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int)
where _types = n::Int
-- | Test list for the Utils module.
testSuite "Utils"
[ 'prop_Utils_commaJoinSplit
, 'prop_Utils_commaSplitJoin
, 'prop_Utils_fromObjWithDefault
, 'prop_Utils_if'if
, 'prop_Utils_select
, 'prop_Utils_select_undefd
, 'prop_Utils_select_undefv
, 'prop_Utils_parseUnit
]
[ 'prop_Utils_commaJoinSplit
, 'prop_Utils_commaSplitJoin
, 'prop_Utils_fromObjWithDefault
, 'prop_Utils_if'if
, 'prop_Utils_select
, 'prop_Utils_select_undefd
, 'prop_Utils_select_undefv
, 'prop_Utils_parseUnit
]
-- ** PeerMap tests
-- | Make sure add is idempotent.
prop_PeerMap_addIdempotent pmap key em =
fn puniq ==? fn (fn puniq)
fn puniq ==? fn (fn puniq)
where _types = (pmap::PeerMap.PeerMap,
key::PeerMap.Key, em::PeerMap.Elem)
fn = PeerMap.add key em
......@@ -389,45 +386,45 @@ prop_PeerMap_addIdempotent pmap key em =
-- | Make sure remove is idempotent.
prop_PeerMap_removeIdempotent pmap key =
fn puniq ==? fn (fn puniq)
fn puniq ==? fn (fn puniq)
where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
fn = PeerMap.remove key
puniq = PeerMap.accumArray const pmap
-- | Make sure a missing item returns 0.
prop_PeerMap_findMissing pmap key =
PeerMap.find key (PeerMap.remove key puniq) ==? 0
PeerMap.find key (PeerMap.remove key puniq) ==? 0
where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
puniq = PeerMap.accumArray const pmap
-- | Make sure an added item is found.
prop_PeerMap_addFind pmap key em =
PeerMap.find key (PeerMap.add key em puniq) ==? em
PeerMap.find key (PeerMap.add key em puniq) ==? em
where _types = (pmap::PeerMap.PeerMap,
key::PeerMap.Key, em::PeerMap.Elem)
puniq = PeerMap.accumArray const pmap
-- | Manual check that maxElem returns the maximum indeed, or 0 for null.
prop_PeerMap_maxElem pmap =
PeerMap.maxElem puniq ==? if null puniq then 0
PeerMap.maxElem puniq ==? if null puniq then 0
else (maximum . snd . unzip) puniq
where _types = pmap::PeerMap.PeerMap
puniq = PeerMap.accumArray const pmap
-- | List of tests for the PeerMap module.
testSuite "PeerMap"
[ 'prop_PeerMap_addIdempotent
, 'prop_PeerMap_removeIdempotent
, 'prop_PeerMap_maxElem
, 'prop_PeerMap_addFind
, 'prop_PeerMap_findMissing
]
[ 'prop_PeerMap_addIdempotent
, 'prop_PeerMap_removeIdempotent
, 'prop_PeerMap_maxElem
, 'prop_PeerMap_addFind
, 'prop_PeerMap_findMissing
]
-- ** Container tests
prop_Container_addTwo cdata i1 i2 =
fn i1 i2 cont == fn i2 i1 cont &&
fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
fn i1 i2 cont == fn i2 i1 cont &&
fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
where _types = (cdata::[Int],
i1::Int, i2::Int)
cont = foldl (\c x -> Container.add x x c) Container.empty cdata
......@@ -461,103 +458,102 @@ prop_Container_findByName node othername =
Container.findByName nl' othername == Nothing
testSuite "Container"
[ 'prop_Container_addTwo
, 'prop_Container_nameOf
, 'prop_Container_findByName
]
[ 'prop_Container_addTwo
, 'prop_Container_nameOf
, 'prop_Container_findByName
]
-- ** Instance tests
-- Simple instance tests, we only have setter/getters
prop_Instance_creat inst =
Instance.name inst ==? Instance.alias inst
Instance.name inst ==? Instance.alias inst
prop_Instance_setIdx inst idx =
Instance.idx (Instance.setIdx inst idx) ==? idx
Instance.idx (Instance.setIdx inst idx) ==? idx
where _types = (inst::Instance.Instance, idx::Types.Idx)
prop_Instance_setName inst name =
Instance.name newinst == name &&
Instance.alias newinst == name
Instance.name newinst == name &&
Instance.alias newinst == name
where _types = (inst::Instance.Instance, name::String)
newinst = Instance.setName inst name
prop_Instance_setAlias inst name =
Instance.name newinst == Instance.name inst &&
Instance.alias newinst == name
Instance.name newinst == Instance.name inst &&
Instance.alias newinst == name
where _types = (inst::Instance.Instance, name::String)
newinst = Instance.setAlias inst name
prop_Instance_setPri inst pdx =
Instance.pNode (Instance.setPri inst pdx) ==? pdx
Instance.pNode (Instance.setPri inst pdx) ==? pdx
where _types = (inst::Instance.Instance, pdx::Types.Ndx)
prop_Instance_setSec inst sdx =
Instance.sNode (Instance.setSec inst sdx) ==? sdx
Instance.sNode (Instance.setSec inst sdx) ==? sdx
where _types = (inst::Instance.Instance, sdx::Types.Ndx)
prop_Instance_setBoth inst pdx sdx =
Instance.pNode si == pdx && Instance.sNode si == sdx
Instance.pNode si == pdx && Instance.sNode si == sdx
where _types = (inst::Instance.Instance, pdx::Types.Ndx, sdx::Types.Ndx)
si = Instance.setBoth inst pdx sdx
prop_Instance_shrinkMG inst =
Instance.mem inst >= 2 * Types.unitMem ==>
case Instance.shrinkByType inst Types.FailMem of
Types.Ok inst' ->
Instance.mem inst' == Instance.mem inst - Types.unitMem
_ -> False
Instance.mem inst >= 2 * Types.unitMem ==>
case Instance.shrinkByType inst Types.FailMem of
Types.Ok inst' -> Instance.mem inst' == Instance.mem inst - Types.unitMem
_ -> False
prop_Instance_shrinkMF inst =
forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
let inst' = inst { Instance.mem = mem}
in Types.isBad $ Instance.shrinkByType inst' Types.FailMem
prop_Instance_shrinkCG inst =
Instance.vcpus inst >= 2 * Types.unitCpu ==>
case Instance.shrinkByType inst Types.FailCPU of
Types.Ok inst' ->
Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu
_ -> False
Instance.vcpus inst >= 2 * Types.unitCpu ==>
case Instance.shrinkByType inst Types.FailCPU of
Types.Ok inst' ->
Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu
_ -> False
prop_Instance_shrinkCF inst =
forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
let inst' = inst { Instance.vcpus = vcpus }
in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU
prop_Instance_shrinkDG inst =
Instance.dsk inst >= 2 * Types.unitDsk ==>
case Instance.shrinkByType inst Types.FailDisk of
Types.Ok inst' ->
Instance.dsk inst' == Instance.dsk inst - Types.unitDsk
_ -> False
Instance.dsk inst >= 2 * Types.unitDsk ==>
case Instance.shrinkByType inst Types.FailDisk of
Types.Ok inst' ->
Instance.dsk inst' == Instance.dsk inst - Types.unitDsk
_ -> False
prop_Instance_shrinkDF inst =
forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
let inst' = inst { Instance.dsk = dsk }
in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk
prop_Instance_setMovable inst m =
Instance.movable inst' ==? m
Instance.movable inst' ==? m
where inst' = Instance.setMovable inst m
testSuite "Instance"
[ 'prop_Instance_creat
, 'prop_Instance_setIdx
, 'prop_Instance_setName
, 'prop_Instance_setAlias
, 'prop_Instance_setPri
, 'prop_Instance_setSec
, 'prop_Instance_setBoth
, 'prop_Instance_shrinkMG
, 'prop_Instance_shrinkMF
, 'prop_Instance_shrinkCG
, 'prop_Instance_shrinkCF
, 'prop_Instance_shrinkDG
, 'prop_Instance_shrinkDF
, 'prop_Instance_setMovable
]
[ 'prop_Instance_creat
, 'prop_Instance_setIdx
, 'prop_Instance_setName
, 'prop_Instance_setAlias
, 'prop_Instance_setPri
, 'prop_Instance_setSec
, 'prop_Instance_setBoth
, 'prop_Instance_shrinkMG
, 'prop_Instance_shrinkMF
, 'prop_Instance_shrinkCG
, 'prop_Instance_shrinkCF
, 'prop_Instance_shrinkDG
, 'prop_Instance_shrinkDF
, 'prop_Instance_setMovable
]
-- ** Text backend tests
......@@ -566,46 +562,45 @@ testSuite "Instance"
prop_Text_Load_Instance name mem dsk vcpus status
(NonEmpty pnode) snode
(NonNegative pdx) (NonNegative sdx) autobal dt =
pnode /= snode && pdx /= sdx ==>
let vcpus_s = show vcpus
dsk_s = show dsk
mem_s = show mem
status_s = Types.instanceStatusToRaw status
ndx = if null snode
pnode /= snode && pdx /= sdx ==>
let vcpus_s = show vcpus
dsk_s = show dsk
mem_s = show mem
status_s = Types.instanceStatusToRaw status
ndx = if null snode
then [(pnode, pdx)]
else [(pnode, pdx), (snode, sdx)]
nl = Data.Map.fromList ndx
tags = ""
sbal = if autobal then "Y" else "N"
sdt = Types.diskTemplateToRaw dt
inst = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status_s,
sbal, pnode, snode, sdt, tags]
fail1 = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status_s,
sbal, pnode, pnode, tags]
_types = ( name::String, mem::Int, dsk::Int
, vcpus::Int, status::Types.InstanceStatus
, snode::String
, autobal::Bool)
in
case inst of
Types.Bad msg -> printTestCase ("Failed to load instance: " ++ msg)
False
Types.Ok (_, i) -> printTestCase "Mismatch in some field while\
\ loading the instance" $
Instance.name i == name &&
Instance.vcpus i == vcpus &&
Instance.mem i == mem &&
Instance.pNode i == pdx &&
Instance.sNode i == (if null snode
then Node.noSecondary
else sdx) &&
Instance.autoBalance i == autobal &&
Types.isBad fail1
nl = Data.Map.fromList ndx
tags = ""
sbal = if autobal then "Y" else "N"
sdt = Types.diskTemplateToRaw dt
inst = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status_s,
sbal, pnode, snode, sdt, tags]
fail1 = Text.loadInst nl
[name, mem_s, dsk_s, vcpus_s, status_s,
sbal, pnode, pnode, tags]
_types = ( name::String, mem::Int, dsk::Int
, vcpus::Int, status::Types.InstanceStatus
, snode::String
, autobal::Bool)
in case inst of
Types.Bad msg -> printTestCase ("Failed to load instance: " ++ msg)
False
Types.Ok (_, i) -> printTestCase "Mismatch in some field while\
\ loading the instance" $
Instance.name i == name &&
Instance.vcpus i == vcpus &&
Instance.mem i == mem &&
Instance.pNode i == pdx &&
Instance.sNode i == (if null snode
then Node.noSecondary
else sdx) &&