Commit 20bc5360 authored by Iustin Pop's avatar Iustin Pop
Browse files

Simplify property and test case names



Since we now have separate namespaces due to the multi-file split, we
don't need to keep the name of the module in the property names, as we
don't have so many potential conflicts anymore.

We remove the group prefix handling from TestHelper and simply do a
sed over all the test files, removing it from the function names.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarRené Nussbaumer <rn@google.com>
parent 2997cb0a
...@@ -64,13 +64,13 @@ instance Arbitrary Confd.ConfdRequest where ...@@ -64,13 +64,13 @@ instance Arbitrary Confd.ConfdRequest where
-- | Test that signing messages and checking signatures is correct. It -- | Test that signing messages and checking signatures is correct. It
-- also tests, indirectly the serialisation of messages so we don't -- also tests, indirectly the serialisation of messages so we don't
-- need a separate test for that. -- need a separate test for that.
prop_ConfdUtils_req_sign :: Hash.HashKey -- ^ The hash key prop_req_sign :: Hash.HashKey -- ^ The hash key
-> NonNegative Integer -- ^ The base timestamp -> NonNegative Integer -- ^ The base timestamp
-> Positive Integer -- ^ Delta for out of window -> Positive Integer -- ^ Delta for out of window
-> Bool -- ^ Whether delta should be + or - -> Bool -- ^ Whether delta should be + or -
-> Confd.ConfdRequest -> Confd.ConfdRequest
-> Property -> Property
prop_ConfdUtils_req_sign key (NonNegative timestamp) (Positive bad_delta) prop_req_sign key (NonNegative timestamp) (Positive bad_delta)
pm crq = pm crq =
forAll (choose (0, fromIntegral C.confdMaxClockSkew)) $ \ good_delta -> forAll (choose (0, fromIntegral C.confdMaxClockSkew)) $ \ good_delta ->
let encoded = J.encode crq let encoded = J.encode crq
...@@ -89,10 +89,10 @@ prop_ConfdUtils_req_sign key (NonNegative timestamp) (Positive bad_delta) ...@@ -89,10 +89,10 @@ prop_ConfdUtils_req_sign key (NonNegative timestamp) (Positive bad_delta)
-- | Tests that signing with a different key fails detects failure -- | Tests that signing with a different key fails detects failure
-- correctly. -- correctly.
prop_ConfdUtils_bad_key :: String -- ^ Salt prop_bad_key :: String -- ^ Salt
-> Confd.ConfdRequest -- ^ Request -> Confd.ConfdRequest -- ^ Request
-> Property -> Property
prop_ConfdUtils_bad_key salt crq = prop_bad_key salt crq =
-- fixme: we hardcode here the expected length of a sha1 key, as -- fixme: we hardcode here the expected length of a sha1 key, as
-- otherwise we could have two short keys that differ only in the -- otherwise we could have two short keys that differ only in the
-- final zero elements count, and those will be expanded to be the -- final zero elements count, and those will be expanded to be the
...@@ -106,6 +106,6 @@ prop_ConfdUtils_bad_key salt crq = ...@@ -106,6 +106,6 @@ prop_ConfdUtils_bad_key salt crq =
Confd.Utils.parseRequest key_verify encoded Confd.Utils.parseRequest key_verify encoded
testSuite "ConfdUtils" testSuite "ConfdUtils"
[ 'prop_ConfdUtils_req_sign [ 'prop_req_sign
, 'prop_ConfdUtils_bad_key , 'prop_bad_key
] ]
...@@ -43,14 +43,14 @@ import qualified Ganeti.HTools.Program as Program ...@@ -43,14 +43,14 @@ import qualified Ganeti.HTools.Program as Program
import qualified Ganeti.HTools.Types as Types import qualified Ganeti.HTools.Types as Types
-- | Test correct parsing. -- | Test correct parsing.
prop_CLI_parseISpec :: String -> Int -> Int -> Int -> Property prop_parseISpec :: String -> Int -> Int -> Int -> Property
prop_CLI_parseISpec descr dsk mem cpu = prop_parseISpec descr dsk mem cpu =
let str = printf "%d,%d,%d" dsk mem cpu::String let str = printf "%d,%d,%d" dsk mem cpu::String
in CLI.parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk) in CLI.parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk)
-- | Test parsing failure due to wrong section count. -- | Test parsing failure due to wrong section count.
prop_CLI_parseISpecFail :: String -> Property prop_parseISpecFail :: String -> Property
prop_CLI_parseISpecFail descr = prop_parseISpecFail descr =
forAll (choose (0,100) `suchThat` ((/=) 3)) $ \nelems -> forAll (choose (0,100) `suchThat` ((/=) 3)) $ \nelems ->
forAll (replicateM nelems arbitrary) $ \values -> forAll (replicateM nelems arbitrary) $ \values ->
let str = intercalate "," $ map show (values::[Int]) let str = intercalate "," $ map show (values::[Int])
...@@ -59,8 +59,8 @@ prop_CLI_parseISpecFail descr = ...@@ -59,8 +59,8 @@ prop_CLI_parseISpecFail descr =
_ -> property True _ -> property True
-- | Test parseYesNo. -- | Test parseYesNo.
prop_CLI_parseYesNo :: Bool -> Bool -> [Char] -> Property prop_parseYesNo :: Bool -> Bool -> [Char] -> Property
prop_CLI_parseYesNo def testval val = prop_parseYesNo def testval val =
forAll (elements [val, "yes", "no"]) $ \actual_val -> forAll (elements [val, "yes", "no"]) $ \actual_val ->
if testval if testval
then CLI.parseYesNo def Nothing ==? Types.Ok def then CLI.parseYesNo def Nothing ==? Types.Ok def
...@@ -84,8 +84,8 @@ checkStringArg val (opt, fn) = ...@@ -84,8 +84,8 @@ checkStringArg val (opt, fn) =
Right (options, _) -> fn options ==? Just val Right (options, _) -> fn options ==? Just val
-- | Test a few string arguments. -- | Test a few string arguments.
prop_CLI_StringArg :: [Char] -> Property prop_StringArg :: [Char] -> Property
prop_CLI_StringArg argument = prop_StringArg argument =
let args = [ (CLI.oDataFile, CLI.optDataFile) let args = [ (CLI.oDataFile, CLI.optDataFile)
, (CLI.oDynuFile, CLI.optDynuFile) , (CLI.oDynuFile, CLI.optDynuFile)
, (CLI.oSaveCluster, CLI.optSaveCluster) , (CLI.oSaveCluster, CLI.optSaveCluster)
...@@ -109,17 +109,17 @@ checkEarlyExit name options param = ...@@ -109,17 +109,17 @@ checkEarlyExit name options param =
-- | Test that all binaries support some common options. There is -- | Test that all binaries support some common options. There is
-- nothing actually random about this test... -- nothing actually random about this test...
prop_CLI_stdopts :: Property prop_stdopts :: Property
prop_CLI_stdopts = prop_stdopts =
let params = ["-h", "--help", "-V", "--version"] let params = ["-h", "--help", "-V", "--version"]
opts = map (\(name, (_, o)) -> (name, o)) Program.personalities opts = map (\(name, (_, o)) -> (name, o)) Program.personalities
-- apply checkEarlyExit across the cartesian product of params and opts -- apply checkEarlyExit across the cartesian product of params and opts
in conjoin [checkEarlyExit n o p | p <- params, (n, o) <- opts] in conjoin [checkEarlyExit n o p | p <- params, (n, o) <- opts]
testSuite "CLI" testSuite "CLI"
[ 'prop_CLI_parseISpec [ 'prop_parseISpec
, 'prop_CLI_parseISpecFail , 'prop_parseISpecFail
, 'prop_CLI_parseYesNo , 'prop_parseYesNo
, 'prop_CLI_StringArg , 'prop_StringArg
, 'prop_CLI_stdopts , 'prop_stdopts
] ]
...@@ -98,8 +98,8 @@ evacModeOptions Types.MirrorExternal = [Types.ChangePrimary, Types.ChangeAll] ...@@ -98,8 +98,8 @@ evacModeOptions Types.MirrorExternal = [Types.ChangePrimary, Types.ChangeAll]
-- | Check that the cluster score is close to zero for a homogeneous -- | Check that the cluster score is close to zero for a homogeneous
-- cluster. -- cluster.
prop_Cluster_Score_Zero :: Node.Node -> Property prop_Score_Zero :: Node.Node -> Property
prop_Cluster_Score_Zero node = prop_Score_Zero node =
forAll (choose (1, 1024)) $ \count -> forAll (choose (1, 1024)) $ \count ->
(not (Node.offline node) && not (Node.failN1 node) && (count > 0) && (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
(Node.tDsk node > 0) && (Node.tMem node > 0)) ==> (Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
...@@ -111,8 +111,8 @@ prop_Cluster_Score_Zero node = ...@@ -111,8 +111,8 @@ prop_Cluster_Score_Zero node =
in score <= 1e-12 in score <= 1e-12
-- | Check that cluster stats are sane. -- | Check that cluster stats are sane.
prop_Cluster_CStats_sane :: Property prop_CStats_sane :: Property
prop_Cluster_CStats_sane = prop_CStats_sane =
forAll (choose (1, 1024)) $ \count -> forAll (choose (1, 1024)) $ \count ->
forAll genOnlineNode $ \node -> forAll genOnlineNode $ \node ->
let fn = Node.buildPeers node Container.empty let fn = Node.buildPeers node Container.empty
...@@ -124,8 +124,8 @@ prop_Cluster_CStats_sane = ...@@ -124,8 +124,8 @@ prop_Cluster_CStats_sane =
-- | Check that one instance is allocated correctly, without -- | Check that one instance is allocated correctly, without
-- rebalances needed. -- rebalances needed.
prop_Cluster_Alloc_sane :: Instance.Instance -> Property prop_Alloc_sane :: Instance.Instance -> Property
prop_Cluster_Alloc_sane inst = prop_Alloc_sane inst =
forAll (choose (5, 20)) $ \count -> forAll (choose (5, 20)) $ \count ->
forAll genOnlineNode $ \node -> forAll genOnlineNode $ \node ->
let (nl, il, inst') = makeSmallEmptyCluster node count inst let (nl, il, inst') = makeSmallEmptyCluster node count inst
...@@ -145,8 +145,8 @@ prop_Cluster_Alloc_sane inst = ...@@ -145,8 +145,8 @@ prop_Cluster_Alloc_sane inst =
-- instance spec via tiered allocation (whatever the original instance -- instance spec via tiered allocation (whatever the original instance
-- spec), on either one or two nodes. Furthermore, we test that -- spec), on either one or two nodes. Furthermore, we test that
-- computed allocation statistics are correct. -- computed allocation statistics are correct.
prop_Cluster_CanTieredAlloc :: Instance.Instance -> Property prop_CanTieredAlloc :: Instance.Instance -> Property
prop_Cluster_CanTieredAlloc inst = prop_CanTieredAlloc inst =
forAll (choose (2, 5)) $ \count -> forAll (choose (2, 5)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node -> forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
let nl = makeSmallCluster node count let nl = makeSmallCluster node count
...@@ -193,8 +193,8 @@ genClusterAlloc count node inst = ...@@ -193,8 +193,8 @@ genClusterAlloc count node inst =
-- | Checks that on a 4-8 node cluster, once we allocate an instance, -- | Checks that on a 4-8 node cluster, once we allocate an instance,
-- we can also relocate it. -- we can also relocate it.
prop_Cluster_AllocRelocate :: Property prop_AllocRelocate :: Property
prop_Cluster_AllocRelocate = prop_AllocRelocate =
forAll (choose (4, 8)) $ \count -> forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node -> forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
...@@ -235,8 +235,8 @@ check_EvacMode grp inst result = ...@@ -235,8 +235,8 @@ check_EvacMode grp inst result =
-- | Checks that on a 4-8 node cluster, once we allocate an instance, -- | Checks that on a 4-8 node cluster, once we allocate an instance,
-- we can also node-evacuate it. -- we can also node-evacuate it.
prop_Cluster_AllocEvacuate :: Property prop_AllocEvacuate :: Property
prop_Cluster_AllocEvacuate = prop_AllocEvacuate =
forAll (choose (4, 8)) $ \count -> forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node -> forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
...@@ -252,8 +252,8 @@ prop_Cluster_AllocEvacuate = ...@@ -252,8 +252,8 @@ prop_Cluster_AllocEvacuate =
-- | Checks that on a 4-8 node cluster with two node groups, once we -- | Checks that on a 4-8 node cluster with two node groups, once we
-- allocate an instance on the first node group, we can also change -- allocate an instance on the first node group, we can also change
-- its group. -- its group.
prop_Cluster_AllocChangeGroup :: Property prop_AllocChangeGroup :: Property
prop_Cluster_AllocChangeGroup = prop_AllocChangeGroup =
forAll (choose (4, 8)) $ \count -> forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node -> forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
...@@ -274,8 +274,8 @@ prop_Cluster_AllocChangeGroup = ...@@ -274,8 +274,8 @@ prop_Cluster_AllocChangeGroup =
-- | Check that allocating multiple instances on a cluster, then -- | Check that allocating multiple instances on a cluster, then
-- adding an empty node, results in a valid rebalance. -- adding an empty node, results in a valid rebalance.
prop_Cluster_AllocBalance :: Property prop_AllocBalance :: Property
prop_Cluster_AllocBalance = prop_AllocBalance =
forAll (genNode (Just 5) (Just 128)) $ \node -> forAll (genNode (Just 5) (Just 128)) $ \node ->
forAll (choose (3, 5)) $ \count -> forAll (choose (3, 5)) $ \count ->
not (Node.offline node) && not (Node.failN1 node) ==> not (Node.offline node) && not (Node.failN1 node) ==>
...@@ -296,8 +296,8 @@ prop_Cluster_AllocBalance = ...@@ -296,8 +296,8 @@ prop_Cluster_AllocBalance =
canBalance tbl True True False canBalance tbl True True False
-- | Checks consistency. -- | Checks consistency.
prop_Cluster_CheckConsistency :: Node.Node -> Instance.Instance -> Bool prop_CheckConsistency :: Node.Node -> Instance.Instance -> Bool
prop_Cluster_CheckConsistency node inst = prop_CheckConsistency node inst =
let nl = makeSmallCluster node 3 let nl = makeSmallCluster node 3
[node1, node2, node3] = Container.elems nl [node1, node2, node3] = Container.elems nl
node3' = node3 { Node.group = 1 } node3' = node3 { Node.group = 1 }
...@@ -311,8 +311,8 @@ prop_Cluster_CheckConsistency node inst = ...@@ -311,8 +311,8 @@ prop_Cluster_CheckConsistency node inst =
(not . null $ ccheck [(0, inst3)]) (not . null $ ccheck [(0, inst3)])
-- | For now, we only test that we don't lose instances during the split. -- | For now, we only test that we don't lose instances during the split.
prop_Cluster_SplitCluster :: Node.Node -> Instance.Instance -> Property prop_SplitCluster :: Node.Node -> Instance.Instance -> Property
prop_Cluster_SplitCluster node inst = prop_SplitCluster node inst =
forAll (choose (0, 100)) $ \icnt -> forAll (choose (0, 100)) $ \icnt ->
let nl = makeSmallCluster node 2 let nl = makeSmallCluster node 2
(nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1) (nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1)
...@@ -339,8 +339,8 @@ canAllocOn nl reqnodes inst = ...@@ -339,8 +339,8 @@ canAllocOn nl reqnodes inst =
-- times, and generates a random instance that can be allocated on -- times, and generates a random instance that can be allocated on
-- this mini-cluster; it then checks that after applying a policy that -- this mini-cluster; it then checks that after applying a policy that
-- the instance doesn't fits, the allocation fails. -- the instance doesn't fits, the allocation fails.
prop_Cluster_AllocPolicy :: Node.Node -> Property prop_AllocPolicy :: Node.Node -> Property
prop_Cluster_AllocPolicy node = prop_AllocPolicy node =
-- rqn is the required nodes (1 or 2) -- rqn is the required nodes (1 or 2)
forAll (choose (1, 2)) $ \rqn -> forAll (choose (1, 2)) $ \rqn ->
forAll (choose (5, 20)) $ \count -> forAll (choose (5, 20)) $ \count ->
...@@ -353,15 +353,15 @@ prop_Cluster_AllocPolicy node = ...@@ -353,15 +353,15 @@ prop_Cluster_AllocPolicy node =
in not $ canAllocOn nl rqn inst in not $ canAllocOn nl rqn inst
testSuite "Cluster" testSuite "Cluster"
[ 'prop_Cluster_Score_Zero [ 'prop_Score_Zero
, 'prop_Cluster_CStats_sane , 'prop_CStats_sane
, 'prop_Cluster_Alloc_sane , 'prop_Alloc_sane
, 'prop_Cluster_CanTieredAlloc , 'prop_CanTieredAlloc
, 'prop_Cluster_AllocRelocate , 'prop_AllocRelocate
, 'prop_Cluster_AllocEvacuate , 'prop_AllocEvacuate
, 'prop_Cluster_AllocChangeGroup , 'prop_AllocChangeGroup
, 'prop_Cluster_AllocBalance , 'prop_AllocBalance
, 'prop_Cluster_CheckConsistency , 'prop_CheckConsistency
, 'prop_Cluster_SplitCluster , 'prop_SplitCluster
, 'prop_Cluster_AllocPolicy , 'prop_AllocPolicy
] ]
...@@ -41,16 +41,16 @@ import qualified Ganeti.HTools.Container as Container ...@@ -41,16 +41,16 @@ import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Node as Node
-- we silence the following due to hlint bug fixed in later versions -- we silence the following due to hlint bug fixed in later versions
{-# ANN prop_Container_addTwo "HLint: ignore Avoid lambda" #-} {-# ANN prop_addTwo "HLint: ignore Avoid lambda" #-}
prop_Container_addTwo :: [Container.Key] -> Int -> Int -> Bool prop_addTwo :: [Container.Key] -> Int -> Int -> Bool
prop_Container_addTwo cdata i1 i2 = prop_addTwo cdata i1 i2 =
fn i1 i2 cont == fn i2 i1 cont && fn i1 i2 cont == fn i2 i1 cont &&
fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont) fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
where cont = foldl (\c x -> Container.add x x c) Container.empty cdata where cont = foldl (\c x -> Container.add x x c) Container.empty cdata
fn x1 x2 = Container.addTwo x1 x1 x2 x2 fn x1 x2 = Container.addTwo x1 x1 x2 x2
prop_Container_nameOf :: Node.Node -> Property prop_nameOf :: Node.Node -> Property
prop_Container_nameOf node = prop_nameOf node =
let nl = makeSmallCluster node 1 let nl = makeSmallCluster node 1
fnode = head (Container.elems nl) fnode = head (Container.elems nl)
in Container.nameOf nl (Node.idx fnode) ==? Node.name fnode in Container.nameOf nl (Node.idx fnode) ==? Node.name fnode
...@@ -58,8 +58,8 @@ prop_Container_nameOf node = ...@@ -58,8 +58,8 @@ prop_Container_nameOf node =
-- | We test that in a cluster, given a random node, we can find it by -- | We test that in a cluster, given a random node, we can find it by
-- its name and alias, as long as all names and aliases are unique, -- its name and alias, as long as all names and aliases are unique,
-- and that we fail to find a non-existing name. -- and that we fail to find a non-existing name.
prop_Container_findByName :: Property prop_findByName :: Property
prop_Container_findByName = prop_findByName =
forAll (genNode (Just 1) Nothing) $ \node -> forAll (genNode (Just 1) Nothing) $ \node ->
forAll (choose (1, 20)) $ \ cnt -> forAll (choose (1, 20)) $ \ cnt ->
forAll (choose (0, cnt - 1)) $ \ fidx -> forAll (choose (0, cnt - 1)) $ \ fidx ->
...@@ -80,7 +80,7 @@ prop_Container_findByName = ...@@ -80,7 +80,7 @@ prop_Container_findByName =
(isNothing (Container.findByName nl' othername)) (isNothing (Container.findByName nl' othername))
testSuite "Container" testSuite "Container"
[ 'prop_Container_addTwo [ 'prop_addTwo
, 'prop_Container_nameOf , 'prop_nameOf
, 'prop_Container_findByName , 'prop_findByName
] ]
...@@ -72,98 +72,98 @@ instance Arbitrary Instance.Instance where ...@@ -72,98 +72,98 @@ instance Arbitrary Instance.Instance where
-- Simple instance tests, we only have setter/getters -- Simple instance tests, we only have setter/getters
prop_Instance_creat :: Instance.Instance -> Property prop_creat :: Instance.Instance -> Property
prop_Instance_creat inst = prop_creat inst =
Instance.name inst ==? Instance.alias inst Instance.name inst ==? Instance.alias inst
prop_Instance_setIdx :: Instance.Instance -> Types.Idx -> Property prop_setIdx :: Instance.Instance -> Types.Idx -> Property
prop_Instance_setIdx inst idx = prop_setIdx inst idx =
Instance.idx (Instance.setIdx inst idx) ==? idx Instance.idx (Instance.setIdx inst idx) ==? idx
prop_Instance_setName :: Instance.Instance -> String -> Bool prop_setName :: Instance.Instance -> String -> Bool
prop_Instance_setName inst name = prop_setName inst name =
Instance.name newinst == name && Instance.name newinst == name &&
Instance.alias newinst == name Instance.alias newinst == name
where newinst = Instance.setName inst name where newinst = Instance.setName inst name
prop_Instance_setAlias :: Instance.Instance -> String -> Bool prop_setAlias :: Instance.Instance -> String -> Bool
prop_Instance_setAlias inst name = prop_setAlias inst name =
Instance.name newinst == Instance.name inst && Instance.name newinst == Instance.name inst &&
Instance.alias newinst == name Instance.alias newinst == name
where newinst = Instance.setAlias inst name where newinst = Instance.setAlias inst name
prop_Instance_setPri :: Instance.Instance -> Types.Ndx -> Property prop_setPri :: Instance.Instance -> Types.Ndx -> Property
prop_Instance_setPri inst pdx = prop_setPri inst pdx =
Instance.pNode (Instance.setPri inst pdx) ==? pdx Instance.pNode (Instance.setPri inst pdx) ==? pdx
prop_Instance_setSec :: Instance.Instance -> Types.Ndx -> Property prop_setSec :: Instance.Instance -> Types.Ndx -> Property
prop_Instance_setSec inst sdx = prop_setSec inst sdx =
Instance.sNode (Instance.setSec inst sdx) ==? sdx Instance.sNode (Instance.setSec inst sdx) ==? sdx
prop_Instance_setBoth :: Instance.Instance -> Types.Ndx -> Types.Ndx -> Bool prop_setBoth :: Instance.Instance -> Types.Ndx -> Types.Ndx -> Bool
prop_Instance_setBoth inst pdx sdx = prop_setBoth inst pdx sdx =
Instance.pNode si == pdx && Instance.sNode si == sdx Instance.pNode si == pdx && Instance.sNode si == sdx
where si = Instance.setBoth inst pdx sdx where si = Instance.setBoth inst pdx sdx
prop_Instance_shrinkMG :: Instance.Instance -> Property prop_shrinkMG :: Instance.Instance -> Property
prop_Instance_shrinkMG inst = prop_shrinkMG inst =
Instance.mem inst >= 2 * Types.unitMem ==> Instance.mem inst >= 2 * Types.unitMem ==>
case Instance.shrinkByType inst Types.FailMem of case Instance.shrinkByType inst Types.FailMem of
Types.Ok inst' -> Instance.mem inst' == Instance.mem inst - Types.unitMem Types.Ok inst' -> Instance.mem inst' == Instance.mem inst - Types.unitMem
_ -> False _ -> False
prop_Instance_shrinkMF :: Instance.Instance -> Property prop_shrinkMF :: Instance.Instance -> Property
prop_Instance_shrinkMF inst = prop_shrinkMF inst =
forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem -> forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
let inst' = inst { Instance.mem = mem} let inst' = inst { Instance.mem = mem}
in Types.isBad $ Instance.shrinkByType inst' Types.FailMem in Types.isBad $ Instance.shrinkByType inst' Types.FailMem
prop_Instance_shrinkCG :: Instance.Instance -> Property prop_shrinkCG :: Instance.Instance -> Property
prop_Instance_shrinkCG inst = prop_shrinkCG inst =
Instance.vcpus inst >= 2 * Types.unitCpu ==> Instance.vcpus inst >= 2 * Types.unitCpu ==>
case Instance.shrinkByType inst Types.FailCPU of case Instance.shrinkByType inst Types.FailCPU of
Types.Ok inst' -> Types.Ok inst' ->
Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu
_ -> False _ -> False
prop_Instance_shrinkCF :: Instance.Instance -> Property prop_shrinkCF :: Instance.Instance -> Property
prop_Instance_shrinkCF inst = prop_shrinkCF inst =
forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus -> forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
let inst' = inst { Instance.vcpus = vcpus } let inst' = inst { Instance.vcpus = vcpus }
in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU
prop_Instance_shrinkDG :: Instance.Instance -> Property prop_shrinkDG :: Instance.Instance -> Property
prop_Instance_shrinkDG inst = prop_shrinkDG inst =
Instance.dsk inst >= 2 * Types.unitDsk ==> Instance.dsk inst >= 2 * Types.unitDsk ==>
case Instance.shrinkByType inst Types.FailDisk of case Instance.shrinkByType inst Types.FailDisk of
Types.Ok inst' -> Types.Ok inst' ->
Instance.dsk inst' == Instance.dsk inst - Types.unitDsk Instance.dsk inst' == Instance.dsk inst - Types.unitDsk
_ -> False _ -> False
prop_Instance_shrinkDF :: Instance.Instance -> Property prop_shrinkDF :: Instance.Instance -> Property
prop_Instance_shrinkDF inst = prop_shrinkDF inst =
forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk -> forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
let inst' = inst { Instance.dsk = dsk } let inst' = inst { Instance.dsk = dsk }
in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk
prop_Instance_setMovable :: Instance.Instance -> Bool -> Property prop_setMovable :: Instance.Instance -> Bool -> Property
prop_Instance_setMovable inst m = prop_setMovable inst m =
Instance.movable inst' ==? m Instance.movable inst' ==? m
where inst' = Instance.setMovable inst m where inst' = Instance.setMovable inst m
testSuite "Instance" testSuite "Instance"
[ 'prop_Instance_creat [ 'prop_creat
, 'prop_Instance_setIdx , 'prop_setIdx
, 'prop_Instance_setName , 'prop_setName
, 'prop_Instance_setAlias , 'prop_setAlias
, 'prop_Instance_setPri , 'prop_setPri
, 'prop_Instance_setSec , 'prop_setSec
, 'prop_Instance_setBoth , 'prop_setBoth
, 'prop_Instance_shrinkMG , 'prop_shrinkMG
, 'prop_Instance_shrinkMF , 'prop_shrinkMF
, 'prop_Instance_shrinkCG , 'prop_shrinkCG
, 'prop_Instance_shrinkCF , 'prop_shrinkCF
, 'prop_Instance_shrinkDG , 'prop_shrinkDG
, 'prop_Instance_shrinkDF , 'prop_shrinkDF
, 'prop_Instance_setMovable , 'prop_setMovable
] ]
...@@ -44,18 +44,18 @@ import qualified Ganeti.HTools.Loader as Loader ...@@ -44,18 +44,18 @@ import qualified Ganeti.HTools.Loader as Loader
import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Types as Types import qualified Ganeti.HTools.Types as Types
prop_Loader_lookupNode :: [(String, Int)] -> String -> String -> Property prop_lookupNode :: [(String, Int)] -> String -> String -> Property
prop_Loader_lookupNode ktn inst node = prop_lookupNode ktn inst node =