From 20bc53603bf22a5242c70f12b0ea209e353cd87d Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Thu, 30 Aug 2012 01:48:41 +0200
Subject: [PATCH] Simplify property and test case names
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
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: Iustin Pop <iustin@google.com>
Reviewed-by: RenΓ© Nussbaumer <rn@google.com>
---
htest/Test/Ganeti/Confd/Utils.hs | 26 +++---
htest/Test/Ganeti/HTools/CLI.hs | 30 +++----
htest/Test/Ganeti/HTools/Cluster.hs | 66 ++++++++--------
htest/Test/Ganeti/HTools/Container.hs | 20 ++---
htest/Test/Ganeti/HTools/Instance.hs | 84 ++++++++++----------
htest/Test/Ganeti/HTools/Loader.hs | 36 ++++-----
htest/Test/Ganeti/HTools/Node.hs | 110 +++++++++++++-------------
htest/Test/Ganeti/HTools/PeerMap.hs | 32 ++++----
htest/Test/Ganeti/HTools/Simu.hs | 6 +-
htest/Test/Ganeti/HTools/Text.hs | 60 +++++++-------
htest/Test/Ganeti/HTools/Types.hs | 42 +++++-----
htest/Test/Ganeti/HTools/Utils.hs | 62 +++++++--------
htest/Test/Ganeti/JSON.hs | 12 +--
htest/Test/Ganeti/Jobs.hs | 12 +--
htest/Test/Ganeti/Luxi.hs | 12 +--
htest/Test/Ganeti/Objects.hs | 6 +-
htest/Test/Ganeti/OpCodes.hs | 18 ++---
htest/Test/Ganeti/Query/Language.hs | 12 +--
htest/Test/Ganeti/Rpc.hs | 18 ++---
htest/Test/Ganeti/Ssconf.hs | 6 +-
htest/Test/Ganeti/TestHelper.hs | 26 +++---
21 files changed, 352 insertions(+), 344 deletions(-)
diff --git a/htest/Test/Ganeti/Confd/Utils.hs b/htest/Test/Ganeti/Confd/Utils.hs
index bc6fa8388..49713899c 100644
--- a/htest/Test/Ganeti/Confd/Utils.hs
+++ b/htest/Test/Ganeti/Confd/Utils.hs
@@ -64,13 +64,13 @@ instance Arbitrary Confd.ConfdRequest where
-- | Test that signing messages and checking signatures is correct. It
-- also tests, indirectly the serialisation of messages so we don't
-- need a separate test for that.
-prop_ConfdUtils_req_sign :: Hash.HashKey -- ^ The hash key
- -> NonNegative Integer -- ^ The base timestamp
- -> Positive Integer -- ^ Delta for out of window
- -> Bool -- ^ Whether delta should be + or -
- -> Confd.ConfdRequest
- -> Property
-prop_ConfdUtils_req_sign key (NonNegative timestamp) (Positive bad_delta)
+prop_req_sign :: Hash.HashKey -- ^ The hash key
+ -> NonNegative Integer -- ^ The base timestamp
+ -> Positive Integer -- ^ Delta for out of window
+ -> Bool -- ^ Whether delta should be + or -
+ -> Confd.ConfdRequest
+ -> Property
+prop_req_sign key (NonNegative timestamp) (Positive bad_delta)
pm crq =
forAll (choose (0, fromIntegral C.confdMaxClockSkew)) $ \ good_delta ->
let encoded = J.encode crq
@@ -89,10 +89,10 @@ prop_ConfdUtils_req_sign key (NonNegative timestamp) (Positive bad_delta)
-- | Tests that signing with a different key fails detects failure
-- correctly.
-prop_ConfdUtils_bad_key :: String -- ^ Salt
- -> Confd.ConfdRequest -- ^ Request
- -> Property
-prop_ConfdUtils_bad_key salt crq =
+prop_bad_key :: String -- ^ Salt
+ -> Confd.ConfdRequest -- ^ Request
+ -> Property
+prop_bad_key salt crq =
-- fixme: we hardcode here the expected length of a sha1 key, as
-- otherwise we could have two short keys that differ only in the
-- final zero elements count, and those will be expanded to be the
@@ -106,6 +106,6 @@ prop_ConfdUtils_bad_key salt crq =
Confd.Utils.parseRequest key_verify encoded
testSuite "ConfdUtils"
- [ 'prop_ConfdUtils_req_sign
- , 'prop_ConfdUtils_bad_key
+ [ 'prop_req_sign
+ , 'prop_bad_key
]
diff --git a/htest/Test/Ganeti/HTools/CLI.hs b/htest/Test/Ganeti/HTools/CLI.hs
index a926ca338..d357a61eb 100644
--- a/htest/Test/Ganeti/HTools/CLI.hs
+++ b/htest/Test/Ganeti/HTools/CLI.hs
@@ -43,14 +43,14 @@ import qualified Ganeti.HTools.Program as Program
import qualified Ganeti.HTools.Types as Types
-- | Test correct parsing.
-prop_CLI_parseISpec :: String -> Int -> Int -> Int -> Property
-prop_CLI_parseISpec descr dsk mem cpu =
+prop_parseISpec :: String -> Int -> Int -> Int -> Property
+prop_parseISpec descr dsk mem cpu =
let str = printf "%d,%d,%d" dsk mem cpu::String
in CLI.parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk)
-- | Test parsing failure due to wrong section count.
-prop_CLI_parseISpecFail :: String -> Property
-prop_CLI_parseISpecFail descr =
+prop_parseISpecFail :: String -> Property
+prop_parseISpecFail descr =
forAll (choose (0,100) `suchThat` ((/=) 3)) $ \nelems ->
forAll (replicateM nelems arbitrary) $ \values ->
let str = intercalate "," $ map show (values::[Int])
@@ -59,8 +59,8 @@ prop_CLI_parseISpecFail descr =
_ -> property True
-- | Test parseYesNo.
-prop_CLI_parseYesNo :: Bool -> Bool -> [Char] -> Property
-prop_CLI_parseYesNo def testval val =
+prop_parseYesNo :: Bool -> Bool -> [Char] -> Property
+prop_parseYesNo def testval val =
forAll (elements [val, "yes", "no"]) $ \actual_val ->
if testval
then CLI.parseYesNo def Nothing ==? Types.Ok def
@@ -84,8 +84,8 @@ checkStringArg val (opt, fn) =
Right (options, _) -> fn options ==? Just val
-- | Test a few string arguments.
-prop_CLI_StringArg :: [Char] -> Property
-prop_CLI_StringArg argument =
+prop_StringArg :: [Char] -> Property
+prop_StringArg argument =
let args = [ (CLI.oDataFile, CLI.optDataFile)
, (CLI.oDynuFile, CLI.optDynuFile)
, (CLI.oSaveCluster, CLI.optSaveCluster)
@@ -109,17 +109,17 @@ checkEarlyExit name options param =
-- | Test that all binaries support some common options. There is
-- nothing actually random about this test...
-prop_CLI_stdopts :: Property
-prop_CLI_stdopts =
+prop_stdopts :: Property
+prop_stdopts =
let params = ["-h", "--help", "-V", "--version"]
opts = map (\(name, (_, o)) -> (name, o)) Program.personalities
-- apply checkEarlyExit across the cartesian product of params and opts
in conjoin [checkEarlyExit n o p | p <- params, (n, o) <- opts]
testSuite "CLI"
- [ 'prop_CLI_parseISpec
- , 'prop_CLI_parseISpecFail
- , 'prop_CLI_parseYesNo
- , 'prop_CLI_StringArg
- , 'prop_CLI_stdopts
+ [ 'prop_parseISpec
+ , 'prop_parseISpecFail
+ , 'prop_parseYesNo
+ , 'prop_StringArg
+ , 'prop_stdopts
]
diff --git a/htest/Test/Ganeti/HTools/Cluster.hs b/htest/Test/Ganeti/HTools/Cluster.hs
index 5dbf3d9bf..349bf518c 100644
--- a/htest/Test/Ganeti/HTools/Cluster.hs
+++ b/htest/Test/Ganeti/HTools/Cluster.hs
@@ -98,8 +98,8 @@ evacModeOptions Types.MirrorExternal = [Types.ChangePrimary, Types.ChangeAll]
-- | Check that the cluster score is close to zero for a homogeneous
-- cluster.
-prop_Cluster_Score_Zero :: Node.Node -> Property
-prop_Cluster_Score_Zero node =
+prop_Score_Zero :: Node.Node -> Property
+prop_Score_Zero node =
forAll (choose (1, 1024)) $ \count ->
(not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
(Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
@@ -111,8 +111,8 @@ prop_Cluster_Score_Zero node =
in score <= 1e-12
-- | Check that cluster stats are sane.
-prop_Cluster_CStats_sane :: Property
-prop_Cluster_CStats_sane =
+prop_CStats_sane :: Property
+prop_CStats_sane =
forAll (choose (1, 1024)) $ \count ->
forAll genOnlineNode $ \node ->
let fn = Node.buildPeers node Container.empty
@@ -124,8 +124,8 @@ prop_Cluster_CStats_sane =
-- | Check that one instance is allocated correctly, without
-- rebalances needed.
-prop_Cluster_Alloc_sane :: Instance.Instance -> Property
-prop_Cluster_Alloc_sane inst =
+prop_Alloc_sane :: Instance.Instance -> Property
+prop_Alloc_sane inst =
forAll (choose (5, 20)) $ \count ->
forAll genOnlineNode $ \node ->
let (nl, il, inst') = makeSmallEmptyCluster node count inst
@@ -145,8 +145,8 @@ prop_Cluster_Alloc_sane inst =
-- instance spec via tiered allocation (whatever the original instance
-- spec), on either one or two nodes. Furthermore, we test that
-- computed allocation statistics are correct.
-prop_Cluster_CanTieredAlloc :: Instance.Instance -> Property
-prop_Cluster_CanTieredAlloc inst =
+prop_CanTieredAlloc :: Instance.Instance -> Property
+prop_CanTieredAlloc inst =
forAll (choose (2, 5)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
let nl = makeSmallCluster node count
@@ -193,8 +193,8 @@ genClusterAlloc count node inst =
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
-- we can also relocate it.
-prop_Cluster_AllocRelocate :: Property
-prop_Cluster_AllocRelocate =
+prop_AllocRelocate :: Property
+prop_AllocRelocate =
forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
@@ -235,8 +235,8 @@ check_EvacMode grp inst result =
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
-- we can also node-evacuate it.
-prop_Cluster_AllocEvacuate :: Property
-prop_Cluster_AllocEvacuate =
+prop_AllocEvacuate :: Property
+prop_AllocEvacuate =
forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
@@ -252,8 +252,8 @@ prop_Cluster_AllocEvacuate =
-- | 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
-- its group.
-prop_Cluster_AllocChangeGroup :: Property
-prop_Cluster_AllocChangeGroup =
+prop_AllocChangeGroup :: Property
+prop_AllocChangeGroup =
forAll (choose (4, 8)) $ \count ->
forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
@@ -274,8 +274,8 @@ prop_Cluster_AllocChangeGroup =
-- | Check that allocating multiple instances on a cluster, then
-- adding an empty node, results in a valid rebalance.
-prop_Cluster_AllocBalance :: Property
-prop_Cluster_AllocBalance =
+prop_AllocBalance :: Property
+prop_AllocBalance =
forAll (genNode (Just 5) (Just 128)) $ \node ->
forAll (choose (3, 5)) $ \count ->
not (Node.offline node) && not (Node.failN1 node) ==>
@@ -296,8 +296,8 @@ prop_Cluster_AllocBalance =
canBalance tbl True True False
-- | Checks consistency.
-prop_Cluster_CheckConsistency :: Node.Node -> Instance.Instance -> Bool
-prop_Cluster_CheckConsistency node inst =
+prop_CheckConsistency :: Node.Node -> Instance.Instance -> Bool
+prop_CheckConsistency node inst =
let nl = makeSmallCluster node 3
[node1, node2, node3] = Container.elems nl
node3' = node3 { Node.group = 1 }
@@ -311,8 +311,8 @@ prop_Cluster_CheckConsistency node inst =
(not . null $ ccheck [(0, inst3)])
-- | For now, we only test that we don't lose instances during the split.
-prop_Cluster_SplitCluster :: Node.Node -> Instance.Instance -> Property
-prop_Cluster_SplitCluster node inst =
+prop_SplitCluster :: Node.Node -> Instance.Instance -> Property
+prop_SplitCluster node inst =
forAll (choose (0, 100)) $ \icnt ->
let nl = makeSmallCluster node 2
(nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1)
@@ -339,8 +339,8 @@ canAllocOn nl reqnodes inst =
-- times, and generates a random instance that can be allocated on
-- this mini-cluster; it then checks that after applying a policy that
-- the instance doesn't fits, the allocation fails.
-prop_Cluster_AllocPolicy :: Node.Node -> Property
-prop_Cluster_AllocPolicy node =
+prop_AllocPolicy :: Node.Node -> Property
+prop_AllocPolicy node =
-- rqn is the required nodes (1 or 2)
forAll (choose (1, 2)) $ \rqn ->
forAll (choose (5, 20)) $ \count ->
@@ -353,15 +353,15 @@ prop_Cluster_AllocPolicy node =
in not $ canAllocOn nl rqn inst
testSuite "Cluster"
- [ 'prop_Cluster_Score_Zero
- , 'prop_Cluster_CStats_sane
- , 'prop_Cluster_Alloc_sane
- , 'prop_Cluster_CanTieredAlloc
- , 'prop_Cluster_AllocRelocate
- , 'prop_Cluster_AllocEvacuate
- , 'prop_Cluster_AllocChangeGroup
- , 'prop_Cluster_AllocBalance
- , 'prop_Cluster_CheckConsistency
- , 'prop_Cluster_SplitCluster
- , 'prop_Cluster_AllocPolicy
+ [ 'prop_Score_Zero
+ , 'prop_CStats_sane
+ , 'prop_Alloc_sane
+ , 'prop_CanTieredAlloc
+ , 'prop_AllocRelocate
+ , 'prop_AllocEvacuate
+ , 'prop_AllocChangeGroup
+ , 'prop_AllocBalance
+ , 'prop_CheckConsistency
+ , 'prop_SplitCluster
+ , 'prop_AllocPolicy
]
diff --git a/htest/Test/Ganeti/HTools/Container.hs b/htest/Test/Ganeti/HTools/Container.hs
index 64c02d583..d03a13e61 100644
--- a/htest/Test/Ganeti/HTools/Container.hs
+++ b/htest/Test/Ganeti/HTools/Container.hs
@@ -41,16 +41,16 @@ import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Node as Node
-- we silence the following due to hlint bug fixed in later versions
-{-# ANN prop_Container_addTwo "HLint: ignore Avoid lambda" #-}
-prop_Container_addTwo :: [Container.Key] -> Int -> Int -> Bool
-prop_Container_addTwo cdata i1 i2 =
+{-# ANN prop_addTwo "HLint: ignore Avoid lambda" #-}
+prop_addTwo :: [Container.Key] -> Int -> Int -> Bool
+prop_addTwo cdata i1 i2 =
fn i1 i2 cont == fn i2 i1 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
fn x1 x2 = Container.addTwo x1 x1 x2 x2
-prop_Container_nameOf :: Node.Node -> Property
-prop_Container_nameOf node =
+prop_nameOf :: Node.Node -> Property
+prop_nameOf node =
let nl = makeSmallCluster node 1
fnode = head (Container.elems nl)
in Container.nameOf nl (Node.idx fnode) ==? Node.name fnode
@@ -58,8 +58,8 @@ prop_Container_nameOf node =
-- | 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,
-- and that we fail to find a non-existing name.
-prop_Container_findByName :: Property
-prop_Container_findByName =
+prop_findByName :: Property
+prop_findByName =
forAll (genNode (Just 1) Nothing) $ \node ->
forAll (choose (1, 20)) $ \ cnt ->
forAll (choose (0, cnt - 1)) $ \ fidx ->
@@ -80,7 +80,7 @@ prop_Container_findByName =
(isNothing (Container.findByName nl' othername))
testSuite "Container"
- [ 'prop_Container_addTwo
- , 'prop_Container_nameOf
- , 'prop_Container_findByName
+ [ 'prop_addTwo
+ , 'prop_nameOf
+ , 'prop_findByName
]
diff --git a/htest/Test/Ganeti/HTools/Instance.hs b/htest/Test/Ganeti/HTools/Instance.hs
index 071117e5f..b31a16f14 100644
--- a/htest/Test/Ganeti/HTools/Instance.hs
+++ b/htest/Test/Ganeti/HTools/Instance.hs
@@ -72,98 +72,98 @@ instance Arbitrary Instance.Instance where
-- Simple instance tests, we only have setter/getters
-prop_Instance_creat :: Instance.Instance -> Property
-prop_Instance_creat inst =
+prop_creat :: Instance.Instance -> Property
+prop_creat inst =
Instance.name inst ==? Instance.alias inst
-prop_Instance_setIdx :: Instance.Instance -> Types.Idx -> Property
-prop_Instance_setIdx inst idx =
+prop_setIdx :: Instance.Instance -> Types.Idx -> Property
+prop_setIdx inst idx =
Instance.idx (Instance.setIdx inst idx) ==? idx
-prop_Instance_setName :: Instance.Instance -> String -> Bool
-prop_Instance_setName inst name =
+prop_setName :: Instance.Instance -> String -> Bool
+prop_setName inst name =
Instance.name newinst == name &&
Instance.alias newinst == name
where newinst = Instance.setName inst name
-prop_Instance_setAlias :: Instance.Instance -> String -> Bool
-prop_Instance_setAlias inst name =
+prop_setAlias :: Instance.Instance -> String -> Bool
+prop_setAlias inst name =
Instance.name newinst == Instance.name inst &&
Instance.alias newinst == name
where newinst = Instance.setAlias inst name
-prop_Instance_setPri :: Instance.Instance -> Types.Ndx -> Property
-prop_Instance_setPri inst pdx =
+prop_setPri :: Instance.Instance -> Types.Ndx -> Property
+prop_setPri inst pdx =
Instance.pNode (Instance.setPri inst pdx) ==? pdx
-prop_Instance_setSec :: Instance.Instance -> Types.Ndx -> Property
-prop_Instance_setSec inst sdx =
+prop_setSec :: Instance.Instance -> Types.Ndx -> Property
+prop_setSec inst sdx =
Instance.sNode (Instance.setSec inst sdx) ==? sdx
-prop_Instance_setBoth :: Instance.Instance -> Types.Ndx -> Types.Ndx -> Bool
-prop_Instance_setBoth inst pdx sdx =
+prop_setBoth :: Instance.Instance -> Types.Ndx -> Types.Ndx -> Bool
+prop_setBoth inst pdx sdx =
Instance.pNode si == pdx && Instance.sNode si == sdx
where si = Instance.setBoth inst pdx sdx
-prop_Instance_shrinkMG :: Instance.Instance -> Property
-prop_Instance_shrinkMG inst =
+prop_shrinkMG :: Instance.Instance -> Property
+prop_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
-prop_Instance_shrinkMF :: Instance.Instance -> Property
-prop_Instance_shrinkMF inst =
+prop_shrinkMF :: Instance.Instance -> Property
+prop_shrinkMF inst =
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 :: Instance.Instance -> Property
-prop_Instance_shrinkCG inst =
+prop_shrinkCG :: Instance.Instance -> Property
+prop_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
-prop_Instance_shrinkCF :: Instance.Instance -> Property
-prop_Instance_shrinkCF inst =
+prop_shrinkCF :: Instance.Instance -> Property
+prop_shrinkCF inst =
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 :: Instance.Instance -> Property
-prop_Instance_shrinkDG inst =
+prop_shrinkDG :: Instance.Instance -> Property
+prop_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
-prop_Instance_shrinkDF :: Instance.Instance -> Property
-prop_Instance_shrinkDF inst =
+prop_shrinkDF :: Instance.Instance -> Property
+prop_shrinkDF inst =
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 :: Instance.Instance -> Bool -> Property
-prop_Instance_setMovable inst m =
+prop_setMovable :: Instance.Instance -> Bool -> Property
+prop_setMovable 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_creat
+ , 'prop_setIdx
+ , 'prop_setName
+ , 'prop_setAlias
+ , 'prop_setPri
+ , 'prop_setSec
+ , 'prop_setBoth
+ , 'prop_shrinkMG
+ , 'prop_shrinkMF
+ , 'prop_shrinkCG
+ , 'prop_shrinkCF
+ , 'prop_shrinkDG
+ , 'prop_shrinkDF
+ , 'prop_setMovable
]
diff --git a/htest/Test/Ganeti/HTools/Loader.hs b/htest/Test/Ganeti/HTools/Loader.hs
index 2699ed01e..653744c37 100644
--- a/htest/Test/Ganeti/HTools/Loader.hs
+++ b/htest/Test/Ganeti/HTools/Loader.hs
@@ -44,18 +44,18 @@ import qualified Ganeti.HTools.Loader as Loader
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Types as Types
-prop_Loader_lookupNode :: [(String, Int)] -> String -> String -> Property
-prop_Loader_lookupNode ktn inst node =
+prop_lookupNode :: [(String, Int)] -> String -> String -> Property
+prop_lookupNode ktn inst node =
Loader.lookupNode nl inst node ==? Map.lookup node nl
where nl = Map.fromList ktn
-prop_Loader_lookupInstance :: [(String, Int)] -> String -> Property
-prop_Loader_lookupInstance kti inst =
+prop_lookupInstance :: [(String, Int)] -> String -> Property
+prop_lookupInstance kti inst =
Loader.lookupInstance il inst ==? Map.lookup inst il
where il = Map.fromList kti
-prop_Loader_assignIndices :: Property
-prop_Loader_assignIndices =
+prop_assignIndices :: Property
+prop_assignIndices =
-- generate nodes with unique names
forAll (arbitrary `suchThat`
(\nodes ->
@@ -71,8 +71,8 @@ prop_Loader_assignIndices =
-- | Checks that the number of primary instances recorded on the nodes
-- is zero.
-prop_Loader_mergeData :: [Node.Node] -> Bool
-prop_Loader_mergeData ns =
+prop_mergeData :: [Node.Node] -> Bool
+prop_mergeData ns =
let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns
in case Loader.mergeData [] [] [] []
(Loader.emptyCluster {Loader.cdNodes = na}) of
@@ -84,22 +84,22 @@ prop_Loader_mergeData ns =
null instances
-- | Check that compareNameComponent on equal strings works.
-prop_Loader_compareNameComponent_equal :: String -> Bool
-prop_Loader_compareNameComponent_equal s =
+prop_compareNameComponent_equal :: String -> Bool
+prop_compareNameComponent_equal s =
BasicTypes.compareNameComponent s s ==
BasicTypes.LookupResult BasicTypes.ExactMatch s
-- | Check that compareNameComponent on prefix strings works.
-prop_Loader_compareNameComponent_prefix :: NonEmptyList Char -> String -> Bool
-prop_Loader_compareNameComponent_prefix (NonEmpty s1) s2 =
+prop_compareNameComponent_prefix :: NonEmptyList Char -> String -> Bool
+prop_compareNameComponent_prefix (NonEmpty s1) s2 =
BasicTypes.compareNameComponent (s1 ++ "." ++ s2) s1 ==
BasicTypes.LookupResult BasicTypes.PartialMatch s1
testSuite "Loader"
- [ 'prop_Loader_lookupNode
- , 'prop_Loader_lookupInstance
- , 'prop_Loader_assignIndices
- , 'prop_Loader_mergeData
- , 'prop_Loader_compareNameComponent_equal
- , 'prop_Loader_compareNameComponent_prefix
+ [ 'prop_lookupNode
+ , 'prop_lookupInstance
+ , 'prop_assignIndices
+ , 'prop_mergeData
+ , 'prop_compareNameComponent_equal
+ , 'prop_compareNameComponent_prefix
]
diff --git a/htest/Test/Ganeti/HTools/Node.hs b/htest/Test/Ganeti/HTools/Node.hs
index 71397fa79..1e44cf22c 100644
--- a/htest/Test/Ganeti/HTools/Node.hs
+++ b/htest/Test/Ganeti/HTools/Node.hs
@@ -98,31 +98,31 @@ instance Arbitrary Node.Node where
-- * Test cases
-prop_Node_setAlias :: Node.Node -> String -> Bool
-prop_Node_setAlias node name =
+prop_setAlias :: Node.Node -> String -> Bool
+prop_setAlias node name =
Node.name newnode == Node.name node &&
Node.alias newnode == name
where newnode = Node.setAlias node name
-prop_Node_setOffline :: Node.Node -> Bool -> Property
-prop_Node_setOffline node status =
+prop_setOffline :: Node.Node -> Bool -> Property
+prop_setOffline node status =
Node.offline newnode ==? status
where newnode = Node.setOffline node status
-prop_Node_setXmem :: Node.Node -> Int -> Property
-prop_Node_setXmem node xm =
+prop_setXmem :: Node.Node -> Int -> Property
+prop_setXmem node xm =
Node.xMem newnode ==? xm
where newnode = Node.setXmem node xm
-prop_Node_setMcpu :: Node.Node -> Double -> Property
-prop_Node_setMcpu node mc =
+prop_setMcpu :: Node.Node -> Double -> Property
+prop_setMcpu node mc =
Types.iPolicyVcpuRatio (Node.iPolicy newnode) ==? mc
where newnode = Node.setMcpu node mc
-- | Check that an instance add with too high memory or disk will be
-- rejected.
-prop_Node_addPriFM :: Node.Node -> Instance.Instance -> Property
-prop_Node_addPriFM node inst =
+prop_addPriFM :: Node.Node -> Instance.Instance -> Property
+prop_addPriFM node inst =
Instance.mem inst >= Node.fMem node && not (Node.failN1 node) &&
not (Instance.isOffline inst) ==>
case Node.addPri node inst'' of
@@ -133,8 +133,8 @@ prop_Node_addPriFM node inst =
-- | Check that adding a primary instance with too much disk fails
-- with type FailDisk.
-prop_Node_addPriFD :: Node.Node -> Instance.Instance -> Property
-prop_Node_addPriFD node inst =
+prop_addPriFD :: Node.Node -> Instance.Instance -> Property
+prop_addPriFD node inst =
forAll (elements Instance.localStorageTemplates) $ \dt ->
Instance.dsk inst >= Node.fDsk node && not (Node.failN1 node) ==>
let inst' = setInstanceSmallerThanNode node inst
@@ -146,8 +146,8 @@ prop_Node_addPriFD node inst =
-- | Check that adding a primary instance with too many VCPUs fails
-- with type FailCPU.
-prop_Node_addPriFC :: Property
-prop_Node_addPriFC =
+prop_addPriFC :: Property
+prop_addPriFC =
forAll (choose (1, maxCpu)) $ \extra ->
forAll genOnlineNode $ \node ->
forAll (arbitrary `suchThat` Instance.notOffline) $ \inst ->
@@ -159,8 +159,8 @@ prop_Node_addPriFC =
-- | Check that an instance add with too high memory or disk will be
-- rejected.
-prop_Node_addSec :: Node.Node -> Instance.Instance -> Int -> Property
-prop_Node_addSec node inst pdx =
+prop_addSec :: Node.Node -> Instance.Instance -> Int -> Property
+prop_addSec node inst pdx =
((Instance.mem inst >= (Node.fMem node - Node.rMem node) &&
not (Instance.isOffline inst)) ||
Instance.dsk inst >= Node.fDsk node) &&
@@ -169,8 +169,8 @@ prop_Node_addSec node inst pdx =
-- | Check that an offline instance with reasonable disk size but
-- extra mem/cpu can always be added.
-prop_Node_addOfflinePri :: NonNegative Int -> NonNegative Int -> Property
-prop_Node_addOfflinePri (NonNegative extra_mem) (NonNegative extra_cpu) =
+prop_addOfflinePri :: NonNegative Int -> NonNegative Int -> Property
+prop_addOfflinePri (NonNegative extra_mem) (NonNegative extra_cpu) =
forAll genOnlineNode $ \node ->
forAll (genInstanceSmallerThanNode node) $ \inst ->
let inst' = inst { Instance.runSt = Types.AdminOffline
@@ -182,9 +182,9 @@ prop_Node_addOfflinePri (NonNegative extra_mem) (NonNegative extra_cpu) =
-- | Check that an offline instance with reasonable disk size but
-- extra mem/cpu can always be added.
-prop_Node_addOfflineSec :: NonNegative Int -> NonNegative Int
- -> Types.Ndx -> Property
-prop_Node_addOfflineSec (NonNegative extra_mem) (NonNegative extra_cpu) pdx =
+prop_addOfflineSec :: NonNegative Int -> NonNegative Int
+ -> Types.Ndx -> Property
+prop_addOfflineSec (NonNegative extra_mem) (NonNegative extra_cpu) pdx =
forAll genOnlineNode $ \node ->
forAll (genInstanceSmallerThanNode node) $ \inst ->
let inst' = inst { Instance.runSt = Types.AdminOffline
@@ -196,8 +196,8 @@ prop_Node_addOfflineSec (NonNegative extra_mem) (NonNegative extra_cpu) pdx =
v -> failTest $ "Expected OpGood/OpGood, but got: " ++ show v
-- | Checks for memory reservation changes.
-prop_Node_rMem :: Instance.Instance -> Property
-prop_Node_rMem inst =
+prop_rMem :: Instance.Instance -> Property
+prop_rMem inst =
not (Instance.isOffline inst) ==>
forAll (genOnlineNode `suchThat` ((> Types.unitMem) . Node.fMem)) $ \node ->
-- ab = auto_balance, nb = non-auto_balance
@@ -230,8 +230,8 @@ prop_Node_rMem inst =
x -> failTest $ "Failed to add/remove instances: " ++ show x
-- | Check mdsk setting.
-prop_Node_setMdsk :: Node.Node -> SmallRatio -> Bool
-prop_Node_setMdsk node mx =
+prop_setMdsk :: Node.Node -> SmallRatio -> Bool
+prop_setMdsk node mx =
Node.loDsk node' >= 0 &&
fromIntegral (Node.loDsk node') <= Node.tDsk node &&
Node.availDisk node' >= 0 &&
@@ -242,26 +242,26 @@ prop_Node_setMdsk node mx =
SmallRatio mx' = mx
-- Check tag maps
-prop_Node_tagMaps_idempotent :: Property
-prop_Node_tagMaps_idempotent =
+prop_tagMaps_idempotent :: Property
+prop_tagMaps_idempotent =
forAll genTags $ \tags ->
Node.delTags (Node.addTags m tags) tags ==? m
where m = Map.empty
-prop_Node_tagMaps_reject :: Property
-prop_Node_tagMaps_reject =
+prop_tagMaps_reject :: Property
+prop_tagMaps_reject =
forAll (genTags `suchThat` (not . null)) $ \tags ->
let m = Node.addTags Map.empty tags
in all (\t -> Node.rejectAddTags m [t]) tags
-prop_Node_showField :: Node.Node -> Property
-prop_Node_showField node =
+prop_showField :: Node.Node -> Property
+prop_showField node =
forAll (elements Node.defaultFields) $ \ field ->
fst (Node.showHeader field) /= Types.unknownField &&
Node.showField node field /= Types.unknownField
-prop_Node_computeGroups :: [Node.Node] -> Bool
-prop_Node_computeGroups nodes =
+prop_computeGroups :: [Node.Node] -> Bool
+prop_computeGroups nodes =
let ng = Node.computeGroups nodes
onlyuuid = map fst ng
in length nodes == sum (map (length . snd) ng) &&
@@ -270,16 +270,16 @@ prop_Node_computeGroups nodes =
(null nodes || not (null ng))
-- Check idempotence of add/remove operations
-prop_Node_addPri_idempotent :: Property
-prop_Node_addPri_idempotent =
+prop_addPri_idempotent :: Property
+prop_addPri_idempotent =
forAll genOnlineNode $ \node ->
forAll (genInstanceSmallerThanNode node) $ \inst ->
case Node.addPri node inst of
Types.OpGood node' -> Node.removePri node' inst ==? node
_ -> failTest "Can't add instance"
-prop_Node_addSec_idempotent :: Property
-prop_Node_addSec_idempotent =
+prop_addSec_idempotent :: Property
+prop_addSec_idempotent =
forAll genOnlineNode $ \node ->
forAll (genInstanceSmallerThanNode node) $ \inst ->
let pdx = Node.idx node + 1
@@ -290,22 +290,22 @@ prop_Node_addSec_idempotent =
_ -> failTest "Can't add instance"
testSuite "Node"
- [ 'prop_Node_setAlias
- , 'prop_Node_setOffline
- , 'prop_Node_setMcpu
- , 'prop_Node_setXmem
- , 'prop_Node_addPriFM
- , 'prop_Node_addPriFD
- , 'prop_Node_addPriFC
- , 'prop_Node_addSec
- , 'prop_Node_addOfflinePri
- , 'prop_Node_addOfflineSec
- , 'prop_Node_rMem
- , 'prop_Node_setMdsk
- , 'prop_Node_tagMaps_idempotent
- , 'prop_Node_tagMaps_reject
- , 'prop_Node_showField
- , 'prop_Node_computeGroups
- , 'prop_Node_addPri_idempotent
- , 'prop_Node_addSec_idempotent
+ [ 'prop_setAlias
+ , 'prop_setOffline
+ , 'prop_setMcpu
+ , 'prop_setXmem
+ , 'prop_addPriFM
+ , 'prop_addPriFD
+ , 'prop_addPriFC
+ , 'prop_addSec
+ , 'prop_addOfflinePri
+ , 'prop_addOfflineSec
+ , 'prop_rMem
+ , 'prop_setMdsk
+ , 'prop_tagMaps_idempotent
+ , 'prop_tagMaps_reject
+ , 'prop_showField
+ , 'prop_computeGroups
+ , 'prop_addPri_idempotent
+ , 'prop_addSec_idempotent
]
diff --git a/htest/Test/Ganeti/HTools/PeerMap.hs b/htest/Test/Ganeti/HTools/PeerMap.hs
index f15864a4f..2b6f34f0d 100644
--- a/htest/Test/Ganeti/HTools/PeerMap.hs
+++ b/htest/Test/Ganeti/HTools/PeerMap.hs
@@ -36,45 +36,45 @@ import Test.Ganeti.TestCommon
import qualified Ganeti.HTools.PeerMap as PeerMap
-- | Make sure add is idempotent.
-prop_PeerMap_addIdempotent :: PeerMap.PeerMap
- -> PeerMap.Key -> PeerMap.Elem -> Property
-prop_PeerMap_addIdempotent pmap key em =
+prop_addIdempotent :: PeerMap.PeerMap
+ -> PeerMap.Key -> PeerMap.Elem -> Property
+prop_addIdempotent pmap key em =
fn puniq ==? fn (fn puniq)
where fn = PeerMap.add key em
puniq = PeerMap.accumArray const pmap
-- | Make sure remove is idempotent.
-prop_PeerMap_removeIdempotent :: PeerMap.PeerMap -> PeerMap.Key -> Property
-prop_PeerMap_removeIdempotent pmap key =
+prop_removeIdempotent :: PeerMap.PeerMap -> PeerMap.Key -> Property
+prop_removeIdempotent pmap key =
fn puniq ==? fn (fn puniq)
where fn = PeerMap.remove key
puniq = PeerMap.accumArray const pmap
-- | Make sure a missing item returns 0.
-prop_PeerMap_findMissing :: PeerMap.PeerMap -> PeerMap.Key -> Property
-prop_PeerMap_findMissing pmap key =
+prop_findMissing :: PeerMap.PeerMap -> PeerMap.Key -> Property
+prop_findMissing pmap key =
PeerMap.find key (PeerMap.remove key puniq) ==? 0
where puniq = PeerMap.accumArray const pmap
-- | Make sure an added item is found.
-prop_PeerMap_addFind :: PeerMap.PeerMap
+prop_addFind :: PeerMap.PeerMap
-> PeerMap.Key -> PeerMap.Elem -> Property
-prop_PeerMap_addFind pmap key em =
+prop_addFind pmap key em =
PeerMap.find key (PeerMap.add key em puniq) ==? em
where puniq = PeerMap.accumArray const pmap
-- | Manual check that maxElem returns the maximum indeed, or 0 for null.
-prop_PeerMap_maxElem :: PeerMap.PeerMap -> Property
-prop_PeerMap_maxElem pmap =
+prop_maxElem :: PeerMap.PeerMap -> Property
+prop_maxElem pmap =
PeerMap.maxElem puniq ==? if null puniq then 0
else (maximum . snd . unzip) puniq
where 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_addIdempotent
+ , 'prop_removeIdempotent
+ , 'prop_maxElem
+ , 'prop_addFind
+ , 'prop_findMissing
]
diff --git a/htest/Test/Ganeti/HTools/Simu.hs b/htest/Test/Ganeti/HTools/Simu.hs
index fcab7697d..2960717e1 100644
--- a/htest/Test/Ganeti/HTools/Simu.hs
+++ b/htest/Test/Ganeti/HTools/Simu.hs
@@ -62,8 +62,8 @@ genSimuSpec = do
-- | Checks that given a set of corrects specs, we can load them
-- successfully, and that at high-level the values look right.
-prop_Simu_Load :: Property
-prop_Simu_Load =
+prop_Load :: Property
+prop_Load =
forAll (choose (0, 10)) $ \ngroups ->
forAll (replicateM ngroups genSimuSpec) $ \specs ->
let strspecs = map (\(p, n, d, m, c) -> printf "%s,%d,%d,%d,%d"
@@ -93,5 +93,5 @@ prop_Simu_Load =
replicate ngroups Types.defIPolicy
testSuite "Simu"
- [ 'prop_Simu_Load
+ [ 'prop_Load
]
diff --git a/htest/Test/Ganeti/HTools/Text.hs b/htest/Test/Ganeti/HTools/Text.hs
index 1fe768b51..d5ef29046 100644
--- a/htest/Test/Ganeti/HTools/Text.hs
+++ b/htest/Test/Ganeti/HTools/Text.hs
@@ -52,13 +52,13 @@ import qualified Ganeti.HTools.Utils as Utils
-- * Instance text loader tests
-prop_Text_Load_Instance :: String -> Int -> Int -> Int -> Types.InstanceStatus
- -> NonEmptyList Char -> [Char]
- -> NonNegative Int -> NonNegative Int -> Bool
- -> Types.DiskTemplate -> Int -> Property
-prop_Text_Load_Instance name mem dsk vcpus status
- (NonEmpty pnode) snode
- (NonNegative pdx) (NonNegative sdx) autobal dt su =
+prop_Load_Instance :: String -> Int -> Int -> Int -> Types.InstanceStatus
+ -> NonEmptyList Char -> [Char]
+ -> NonNegative Int -> NonNegative Int -> Bool
+ -> Types.DiskTemplate -> Int -> Property
+prop_Load_Instance name mem dsk vcpus status
+ (NonEmpty pnode) snode
+ (NonNegative pdx) (NonNegative sdx) autobal dt su =
pnode /= snode && pdx /= sdx ==>
let vcpus_s = show vcpus
dsk_s = show dsk
@@ -93,8 +93,8 @@ prop_Text_Load_Instance name mem dsk vcpus status
Instance.spindleUse i == su &&
Types.isBad fail1
-prop_Text_Load_InstanceFail :: [(String, Int)] -> [String] -> Property
-prop_Text_Load_InstanceFail ktn fields =
+prop_Load_InstanceFail :: [(String, Int)] -> [String] -> Property
+prop_Load_InstanceFail ktn fields =
length fields /= 10 && length fields /= 11 ==>
case Text.loadInst nl fields of
Types.Ok _ -> failTest "Managed to load instance from invalid data"
@@ -102,9 +102,9 @@ prop_Text_Load_InstanceFail ktn fields =
"Invalid/incomplete instance data: '" `isPrefixOf` msg
where nl = Map.fromList ktn
-prop_Text_Load_Node :: String -> Int -> Int -> Int -> Int -> Int
- -> Int -> Bool -> Bool
-prop_Text_Load_Node name tm nm fm td fd tc fo =
+prop_Load_Node :: String -> Int -> Int -> Int -> Int -> Int
+ -> Int -> Bool -> Bool
+prop_Load_Node name tm nm fm td fd tc fo =
let conv v = if v < 0
then "?"
else show v
@@ -134,12 +134,12 @@ prop_Text_Load_Node name tm nm fm td fd tc fo =
Node.fDsk node == fd &&
Node.tCpu node == fromIntegral tc
-prop_Text_Load_NodeFail :: [String] -> Property
-prop_Text_Load_NodeFail fields =
+prop_Load_NodeFail :: [String] -> Property
+prop_Load_NodeFail fields =
length fields /= 8 ==> isNothing $ Text.loadNode Map.empty fields
-prop_Text_NodeLSIdempotent :: Property
-prop_Text_NodeLSIdempotent =
+prop_NodeLSIdempotent :: Property
+prop_NodeLSIdempotent =
forAll (genNode (Just 1) Nothing) $ \node ->
-- override failN1 to what loadNode returns by default
let n = Node.setPolicy Types.defIPolicy $
@@ -149,15 +149,15 @@ prop_Text_NodeLSIdempotent =
Utils.sepSplit '|' . Text.serializeNode defGroupList) n ==?
Just (Node.name n, n)
-prop_Text_ISpecIdempotent :: Types.ISpec -> Property
-prop_Text_ISpecIdempotent ispec =
+prop_ISpecIdempotent :: Types.ISpec -> Property
+prop_ISpecIdempotent ispec =
case Text.loadISpec "dummy" . Utils.sepSplit ',' .
Text.serializeISpec $ ispec of
Types.Bad msg -> failTest $ "Failed to load ispec: " ++ msg
Types.Ok ispec' -> ispec ==? ispec'
-prop_Text_IPolicyIdempotent :: Types.IPolicy -> Property
-prop_Text_IPolicyIdempotent ipol =
+prop_IPolicyIdempotent :: Types.IPolicy -> Property
+prop_IPolicyIdempotent ipol =
case Text.loadIPolicy . Utils.sepSplit '|' $
Text.serializeIPolicy owner ipol of
Types.Bad msg -> failTest $ "Failed to load ispec: " ++ msg
@@ -171,8 +171,8 @@ prop_Text_IPolicyIdempotent ipol =
-- allocations, not for the business logic). As such, it's a quite
-- complex and slow test, and that's the reason we restrict it to
-- small cluster sizes.
-prop_Text_CreateSerialise :: Property
-prop_Text_CreateSerialise =
+prop_CreateSerialise :: Property
+prop_CreateSerialise =
forAll genTags $ \ctags ->
forAll (choose (1, 20)) $ \maxiter ->
forAll (choose (2, 10)) $ \count ->
@@ -200,12 +200,12 @@ prop_Text_CreateSerialise =
nl' ==? nl2
testSuite "Text"
- [ 'prop_Text_Load_Instance
- , 'prop_Text_Load_InstanceFail
- , 'prop_Text_Load_Node
- , 'prop_Text_Load_NodeFail
- , 'prop_Text_NodeLSIdempotent
- , 'prop_Text_ISpecIdempotent
- , 'prop_Text_IPolicyIdempotent
- , 'prop_Text_CreateSerialise
+ [ 'prop_Load_Instance
+ , 'prop_Load_InstanceFail
+ , 'prop_Load_Node
+ , 'prop_Load_NodeFail
+ , 'prop_NodeLSIdempotent
+ , 'prop_ISpecIdempotent
+ , 'prop_IPolicyIdempotent
+ , 'prop_CreateSerialise
]
diff --git a/htest/Test/Ganeti/HTools/Types.hs b/htest/Test/Ganeti/HTools/Types.hs
index 12a64cfc7..5eeaae2b1 100644
--- a/htest/Test/Ganeti/HTools/Types.hs
+++ b/htest/Test/Ganeti/HTools/Types.hs
@@ -127,38 +127,38 @@ instance Arbitrary Types.IPolicy where
-- * Test cases
-prop_Types_AllocPolicy_serialisation :: Types.AllocPolicy -> Property
-prop_Types_AllocPolicy_serialisation apol =
+prop_AllocPolicy_serialisation :: Types.AllocPolicy -> Property
+prop_AllocPolicy_serialisation apol =
case J.readJSON (J.showJSON apol) of
J.Ok p -> p ==? apol
J.Error s -> failTest $ "Failed to deserialise: " ++ s
-prop_Types_DiskTemplate_serialisation :: Types.DiskTemplate -> Property
-prop_Types_DiskTemplate_serialisation dt =
+prop_DiskTemplate_serialisation :: Types.DiskTemplate -> Property
+prop_DiskTemplate_serialisation dt =
case J.readJSON (J.showJSON dt) of
J.Ok p -> p ==? dt
J.Error s -> failTest $ "Failed to deserialise: " ++ s
-prop_Types_ISpec_serialisation :: Types.ISpec -> Property
-prop_Types_ISpec_serialisation ispec =
+prop_ISpec_serialisation :: Types.ISpec -> Property
+prop_ISpec_serialisation ispec =
case J.readJSON (J.showJSON ispec) of
J.Ok p -> p ==? ispec
J.Error s -> failTest $ "Failed to deserialise: " ++ s
-prop_Types_IPolicy_serialisation :: Types.IPolicy -> Property
-prop_Types_IPolicy_serialisation ipol =
+prop_IPolicy_serialisation :: Types.IPolicy -> Property
+prop_IPolicy_serialisation ipol =
case J.readJSON (J.showJSON ipol) of
J.Ok p -> p ==? ipol
J.Error s -> failTest $ "Failed to deserialise: " ++ s
-prop_Types_EvacMode_serialisation :: Types.EvacMode -> Property
-prop_Types_EvacMode_serialisation em =
+prop_EvacMode_serialisation :: Types.EvacMode -> Property
+prop_EvacMode_serialisation em =
case J.readJSON (J.showJSON em) of
J.Ok p -> p ==? em
J.Error s -> failTest $ "Failed to deserialise: " ++ s
-prop_Types_opToResult :: Types.OpResult Int -> Bool
-prop_Types_opToResult op =
+prop_opToResult :: Types.OpResult Int -> Bool
+prop_opToResult op =
case op of
Types.OpFail _ -> Types.isBad r
Types.OpGood v -> case r of
@@ -166,8 +166,8 @@ prop_Types_opToResult op =
Types.Ok v' -> v == v'
where r = Types.opToResult op
-prop_Types_eitherToResult :: Either String Int -> Bool
-prop_Types_eitherToResult ei =
+prop_eitherToResult :: Either String Int -> Bool
+prop_eitherToResult ei =
case ei of
Left _ -> Types.isBad r
Right v -> case r of
@@ -176,11 +176,11 @@ prop_Types_eitherToResult ei =
where r = Types.eitherToResult ei
testSuite "Types"
- [ 'prop_Types_AllocPolicy_serialisation
- , 'prop_Types_DiskTemplate_serialisation
- , 'prop_Types_ISpec_serialisation
- , 'prop_Types_IPolicy_serialisation
- , 'prop_Types_EvacMode_serialisation
- , 'prop_Types_opToResult
- , 'prop_Types_eitherToResult
+ [ 'prop_AllocPolicy_serialisation
+ , 'prop_DiskTemplate_serialisation
+ , 'prop_ISpec_serialisation
+ , 'prop_IPolicy_serialisation
+ , 'prop_EvacMode_serialisation
+ , 'prop_opToResult
+ , 'prop_eitherToResult
]
diff --git a/htest/Test/Ganeti/HTools/Utils.hs b/htest/Test/Ganeti/HTools/Utils.hs
index 538d8263a..eba69d198 100644
--- a/htest/Test/Ganeti/HTools/Utils.hs
+++ b/htest/Test/Ganeti/HTools/Utils.hs
@@ -47,21 +47,21 @@ genNonCommaString = do
-- | 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 :: Property
-prop_Utils_commaJoinSplit =
+prop_commaJoinSplit :: Property
+prop_commaJoinSplit =
forAll (choose (0, 20)) $ \llen ->
forAll (vectorOf llen genNonCommaString `suchThat` ((/=) [""])) $ \lst ->
Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst
-- | Split and join should always be idempotent.
-prop_Utils_commaSplitJoin :: [Char] -> Property
-prop_Utils_commaSplitJoin s =
+prop_commaSplitJoin :: [Char] -> Property
+prop_commaSplitJoin s =
Utils.commaJoin (Utils.sepSplit ',' s) ==? s
-- | fromObjWithDefault, we test using the Maybe monad and an integer
-- value.
-prop_Utils_fromObjWithDefault :: Integer -> String -> Bool
-prop_Utils_fromObjWithDefault def_value random_key =
+prop_fromObjWithDefault :: Integer -> String -> Bool
+prop_fromObjWithDefault def_value random_key =
-- a missing key will be returned with the default
JSON.fromObjWithDefault [] random_key def_value == Just def_value &&
-- a found key will be returned as is, not with default
@@ -69,42 +69,42 @@ prop_Utils_fromObjWithDefault def_value random_key =
random_key (def_value+1) == Just def_value
-- | 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 =
+prop_if'if :: Bool -> Int -> Int -> Gen Prop
+prop_if'if cnd a b =
Utils.if' cnd a b ==? if cnd then a else b
-- | Test basic select functionality
-prop_Utils_select :: Int -- ^ Default result
- -> [Int] -- ^ List of False values
- -> [Int] -- ^ List of True values
- -> Gen Prop -- ^ Test result
-prop_Utils_select def lst1 lst2 =
+prop_select :: Int -- ^ Default result
+ -> [Int] -- ^ List of False values
+ -> [Int] -- ^ List of True values
+ -> Gen Prop -- ^ Test result
+prop_select def lst1 lst2 =
Utils.select def (flist ++ tlist) ==? expectedresult
where expectedresult = Utils.if' (null lst2) def (head lst2)
flist = zip (repeat False) lst1
tlist = zip (repeat True) lst2
-- | Test basic select functionality with undefined default
-prop_Utils_select_undefd :: [Int] -- ^ List of False values
- -> NonEmptyList Int -- ^ List of True values
- -> Gen Prop -- ^ Test result
-prop_Utils_select_undefd lst1 (NonEmpty lst2) =
+prop_select_undefd :: [Int] -- ^ List of False values
+ -> NonEmptyList Int -- ^ List of True values
+ -> Gen Prop -- ^ Test result
+prop_select_undefd lst1 (NonEmpty lst2) =
Utils.select undefined (flist ++ tlist) ==? head lst2
where flist = zip (repeat False) lst1
tlist = zip (repeat True) lst2
-- | Test basic select functionality with undefined list values
-prop_Utils_select_undefv :: [Int] -- ^ List of False values
- -> NonEmptyList Int -- ^ List of True values
- -> Gen Prop -- ^ Test result
-prop_Utils_select_undefv lst1 (NonEmpty lst2) =
+prop_select_undefv :: [Int] -- ^ List of False values
+ -> NonEmptyList Int -- ^ List of True values
+ -> Gen Prop -- ^ Test result
+prop_select_undefv lst1 (NonEmpty lst2) =
Utils.select undefined cndlist ==? head lst2
where flist = zip (repeat False) lst1
tlist = zip (repeat True) lst2
cndlist = flist ++ tlist ++ [undefined]
-prop_Utils_parseUnit :: NonNegative Int -> Property
-prop_Utils_parseUnit (NonNegative n) =
+prop_parseUnit :: NonNegative Int -> Property
+prop_parseUnit (NonNegative n) =
Utils.parseUnit (show n) ==? Types.Ok n .&&.
Utils.parseUnit (show n ++ "m") ==? Types.Ok n .&&.
Utils.parseUnit (show n ++ "M") ==? Types.Ok (truncate n_mb::Int) .&&.
@@ -121,12 +121,12 @@ prop_Utils_parseUnit (NonNegative n) =
-- | 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_commaJoinSplit
+ , 'prop_commaSplitJoin
+ , 'prop_fromObjWithDefault
+ , 'prop_if'if
+ , 'prop_select
+ , 'prop_select_undefd
+ , 'prop_select_undefv
+ , 'prop_parseUnit
]
diff --git a/htest/Test/Ganeti/JSON.hs b/htest/Test/Ganeti/JSON.hs
index 6a42fd7bd..0ad22ff73 100644
--- a/htest/Test/Ganeti/JSON.hs
+++ b/htest/Test/Ganeti/JSON.hs
@@ -38,15 +38,15 @@ import Test.Ganeti.TestCommon
import qualified Ganeti.BasicTypes as BasicTypes
import qualified Ganeti.JSON as JSON
-prop_JSON_toArray :: [Int] -> Property
-prop_JSON_toArray intarr =
+prop_toArray :: [Int] -> Property
+prop_toArray intarr =
let arr = map J.showJSON intarr in
case JSON.toArray (J.JSArray arr) of
BasicTypes.Ok arr' -> arr ==? arr'
BasicTypes.Bad err -> failTest $ "Failed to parse array: " ++ err
-prop_JSON_toArrayFail :: Int -> String -> Bool -> Property
-prop_JSON_toArrayFail i s b =
+prop_toArrayFail :: Int -> String -> Bool -> Property
+prop_toArrayFail i s b =
-- poor man's instance Arbitrary JSValue
forAll (elements [J.showJSON i, J.showJSON s, J.showJSON b]) $ \item ->
case JSON.toArray item of
@@ -54,6 +54,6 @@ prop_JSON_toArrayFail i s b =
BasicTypes.Ok result -> failTest $ "Unexpected parse, got " ++ show result
testSuite "JSON"
- [ 'prop_JSON_toArray
- , 'prop_JSON_toArrayFail
+ [ 'prop_toArray
+ , 'prop_toArrayFail
]
diff --git a/htest/Test/Ganeti/Jobs.hs b/htest/Test/Ganeti/Jobs.hs
index f2ada1039..3471c9524 100644
--- a/htest/Test/Ganeti/Jobs.hs
+++ b/htest/Test/Ganeti/Jobs.hs
@@ -48,19 +48,19 @@ instance Arbitrary Jobs.JobStatus where
-- * Test cases
-- | Check that (queued) job\/opcode status serialization is idempotent.
-prop_Jobs_OpStatus_serialization :: Jobs.OpStatus -> Property
-prop_Jobs_OpStatus_serialization os =
+prop_OpStatus_serialization :: Jobs.OpStatus -> Property
+prop_OpStatus_serialization os =
case J.readJSON (J.showJSON os) of
J.Error e -> failTest $ "Cannot deserialise: " ++ e
J.Ok os' -> os ==? os'
-prop_Jobs_JobStatus_serialization :: Jobs.JobStatus -> Property
-prop_Jobs_JobStatus_serialization js =
+prop_JobStatus_serialization :: Jobs.JobStatus -> Property
+prop_JobStatus_serialization js =
case J.readJSON (J.showJSON js) of
J.Error e -> failTest $ "Cannot deserialise: " ++ e
J.Ok js' -> js ==? js'
testSuite "Jobs"
- [ 'prop_Jobs_OpStatus_serialization
- , 'prop_Jobs_JobStatus_serialization
+ [ 'prop_OpStatus_serialization
+ , 'prop_JobStatus_serialization
]
diff --git a/htest/Test/Ganeti/Luxi.hs b/htest/Test/Ganeti/Luxi.hs
index b40cf3451..e36889fe7 100644
--- a/htest/Test/Ganeti/Luxi.hs
+++ b/htest/Test/Ganeti/Luxi.hs
@@ -86,8 +86,8 @@ instance Arbitrary Luxi.LuxiOp where
Luxi.ReqSetWatcherPause -> Luxi.SetWatcherPause <$> arbitrary
-- | Simple check that encoding/decoding of LuxiOp works.
-prop_Luxi_CallEncoding :: Luxi.LuxiOp -> Property
-prop_Luxi_CallEncoding op =
+prop_CallEncoding :: Luxi.LuxiOp -> Property
+prop_CallEncoding op =
(Luxi.validateCall (Luxi.buildCall op) >>= Luxi.decodeCall) ==? Ok op
-- | Helper to a get a temporary file name.
@@ -115,8 +115,8 @@ luxiClientPong c =
-- | Monadic check that, given a server socket, we can connect via a
-- client to it, and that we can send a list of arbitrary messages and
-- get back what we sent.
-prop_Luxi_ClientServer :: [[DNSChar]] -> Property
-prop_Luxi_ClientServer dnschars = monadicIO $ do
+prop_ClientServer :: [[DNSChar]] -> Property
+prop_ClientServer dnschars = monadicIO $ do
let msgs = map (map dnsGetChar) dnschars
fpath <- run $ getTempFileName
-- we need to create the server first, otherwise (if we do it in the
@@ -137,6 +137,6 @@ prop_Luxi_ClientServer dnschars = monadicIO $ do
stop $ replies ==? msgs
testSuite "Luxi"
- [ 'prop_Luxi_CallEncoding
- , 'prop_Luxi_ClientServer
+ [ 'prop_CallEncoding
+ , 'prop_ClientServer
]
diff --git a/htest/Test/Ganeti/Objects.hs b/htest/Test/Ganeti/Objects.hs
index 7baaf70aa..5463aef20 100644
--- a/htest/Test/Ganeti/Objects.hs
+++ b/htest/Test/Ganeti/Objects.hs
@@ -55,8 +55,8 @@ instance Arbitrary Objects.Node where
<*> (Set.fromList <$> genTags)
-- | Tests that fillDict behaves correctly
-prop_Objects_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property
-prop_Objects_fillDict defaults custom =
+prop_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property
+prop_fillDict defaults custom =
let d_map = Map.fromList defaults
d_keys = map fst defaults
c_map = Map.fromList custom
@@ -69,5 +69,5 @@ prop_Objects_fillDict defaults custom =
(Objects.fillDict d_map c_map (d_keys++c_keys) == Map.empty)
testSuite "Objects"
- [ 'prop_Objects_fillDict
+ [ 'prop_fillDict
]
diff --git a/htest/Test/Ganeti/OpCodes.hs b/htest/Test/Ganeti/OpCodes.hs
index f4878d3bf..d184d2104 100644
--- a/htest/Test/Ganeti/OpCodes.hs
+++ b/htest/Test/Ganeti/OpCodes.hs
@@ -73,15 +73,15 @@ instance Arbitrary OpCodes.OpCode where
-- * Test cases
-- | Check that opcode serialization is idempotent.
-prop_OpCodes_serialization :: OpCodes.OpCode -> Property
-prop_OpCodes_serialization op =
+prop_serialization :: OpCodes.OpCode -> Property
+prop_serialization op =
case J.readJSON (J.showJSON op) of
J.Error e -> failTest $ "Cannot deserialise: " ++ e
J.Ok op' -> op ==? op'
-- | Check that Python and Haskell defined the same opcode list.
-case_OpCodes_AllDefined :: HUnit.Assertion
-case_OpCodes_AllDefined = do
+case_AllDefined :: HUnit.Assertion
+case_AllDefined = do
py_stdout <- runPython "from ganeti import opcodes\n\
\print '\\n'.join(opcodes.OP_MAPPING.keys())" "" >>=
checkPythonResult
@@ -111,8 +111,8 @@ case_OpCodes_AllDefined = do
-- a better way to do this, for example by having a
-- separately-launched Python process (if not running the tests would
-- be skipped).
-case_OpCodes_py_compat :: HUnit.Assertion
-case_OpCodes_py_compat = do
+case_py_compat :: HUnit.Assertion
+case_py_compat = do
let num_opcodes = length OpCodes.allOpIDs * 500
sample_opcodes <- sample' (vectorOf num_opcodes
(arbitrary::Gen OpCodes.OpCode))
@@ -143,7 +143,7 @@ case_OpCodes_py_compat = do
) $ zip opcodes decoded
testSuite "OpCodes"
- [ 'prop_OpCodes_serialization
- , 'case_OpCodes_AllDefined
- , 'case_OpCodes_py_compat
+ [ 'prop_serialization
+ , 'case_AllDefined
+ , 'case_py_compat
]
diff --git a/htest/Test/Ganeti/Query/Language.hs b/htest/Test/Ganeti/Query/Language.hs
index 8c33e24a0..e2be6796c 100644
--- a/htest/Test/Ganeti/Query/Language.hs
+++ b/htest/Test/Ganeti/Query/Language.hs
@@ -81,18 +81,18 @@ instance Arbitrary Qlang.FilterRegex where
-- | Tests that serialisation/deserialisation of filters is
-- idempotent.
-prop_Qlang_Serialisation :: Property
-prop_Qlang_Serialisation =
+prop_Serialisation :: Property
+prop_Serialisation =
forAll genFilter $ \flt ->
J.readJSON (J.showJSON flt) ==? J.Ok flt
-prop_Qlang_FilterRegex_instances :: Qlang.FilterRegex -> Property
-prop_Qlang_FilterRegex_instances rex =
+prop_FilterRegex_instances :: Qlang.FilterRegex -> Property
+prop_FilterRegex_instances rex =
printTestCase "failed JSON encoding"
(J.readJSON (J.showJSON rex) ==? J.Ok rex) .&&.
printTestCase "failed read/show instances" (read (show rex) ==? rex)
testSuite "Qlang"
- [ 'prop_Qlang_Serialisation
- , 'prop_Qlang_FilterRegex_instances
+ [ 'prop_Serialisation
+ , 'prop_FilterRegex_instances
]
diff --git a/htest/Test/Ganeti/Rpc.hs b/htest/Test/Ganeti/Rpc.hs
index 618ea9cf4..34e8e6142 100644
--- a/htest/Test/Ganeti/Rpc.hs
+++ b/htest/Test/Ganeti/Rpc.hs
@@ -53,26 +53,26 @@ instance Arbitrary Rpc.RpcCallNodeInfo where
-- offline nodes, we get a OfflineNodeError response.
-- FIXME: We need a way of generalizing this, running it for
-- every call manually will soon get problematic
-prop_Rpc_noffl_request_allinstinfo :: Rpc.RpcCallAllInstancesInfo -> Property
-prop_Rpc_noffl_request_allinstinfo call =
+prop_noffl_request_allinstinfo :: Rpc.RpcCallAllInstancesInfo -> Property
+prop_noffl_request_allinstinfo call =
forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
res <- run $ Rpc.executeRpcCall [node] call
stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
-prop_Rpc_noffl_request_instlist :: Rpc.RpcCallInstanceList -> Property
-prop_Rpc_noffl_request_instlist call =
+prop_noffl_request_instlist :: Rpc.RpcCallInstanceList -> Property
+prop_noffl_request_instlist call =
forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
res <- run $ Rpc.executeRpcCall [node] call
stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
-prop_Rpc_noffl_request_nodeinfo :: Rpc.RpcCallNodeInfo -> Property
-prop_Rpc_noffl_request_nodeinfo call =
+prop_noffl_request_nodeinfo :: Rpc.RpcCallNodeInfo -> Property
+prop_noffl_request_nodeinfo call =
forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
res <- run $ Rpc.executeRpcCall [node] call
stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
testSuite "Rpc"
- [ 'prop_Rpc_noffl_request_allinstinfo
- , 'prop_Rpc_noffl_request_instlist
- , 'prop_Rpc_noffl_request_nodeinfo
+ [ 'prop_noffl_request_allinstinfo
+ , 'prop_noffl_request_instlist
+ , 'prop_noffl_request_nodeinfo
]
diff --git a/htest/Test/Ganeti/Ssconf.hs b/htest/Test/Ganeti/Ssconf.hs
index 8139e2dd8..0b8695026 100644
--- a/htest/Test/Ganeti/Ssconf.hs
+++ b/htest/Test/Ganeti/Ssconf.hs
@@ -41,11 +41,11 @@ import qualified Ganeti.Ssconf as Ssconf
instance Arbitrary Ssconf.SSKey where
arbitrary = elements [minBound..maxBound]
-prop_Ssconf_filename :: Ssconf.SSKey -> Property
-prop_Ssconf_filename key =
+prop_filename :: Ssconf.SSKey -> Property
+prop_filename key =
printTestCase "Key doesn't start with correct prefix" $
Ssconf.sSFilePrefix `isPrefixOf` Ssconf.keyToFilename (Just "") key
testSuite "Ssconf"
- [ 'prop_Ssconf_filename
+ [ 'prop_filename
]
diff --git a/htest/Test/Ganeti/TestHelper.hs b/htest/Test/Ganeti/TestHelper.hs
index ad0aaa2d2..6b524c8a2 100644
--- a/htest/Test/Ganeti/TestHelper.hs
+++ b/htest/Test/Ganeti/TestHelper.hs
@@ -38,35 +38,43 @@ import Test.HUnit (Assertion)
import Test.QuickCheck
import Language.Haskell.TH
+-- | Test property prefix.
+propPrefix :: String
+propPrefix = "prop_"
+
+-- | Test case prefix.
+casePrefix :: String
+casePrefix = "case_"
+
-- | Tries to drop a prefix from a string.
simplifyName :: String -> String -> String
simplifyName pfx string = fromMaybe string (stripPrefix pfx string)
-- | Builds a test from a QuickCheck property.
-runQC :: Testable prop => String -> String -> prop -> Test
-runQC pfx name = testProperty (simplifyName ("prop_" ++ pfx ++ "_") name)
+runProp :: Testable prop => String -> prop -> Test
+runProp = testProperty . simplifyName propPrefix
-- | Builds a test for a HUnit test case.
-runHUnit :: String -> String -> Assertion -> Test
-runHUnit pfx name = testCase (simplifyName ("case_" ++ pfx ++ "_") name)
+runCase :: String -> Assertion -> Test
+runCase = testCase . simplifyName casePrefix
-- | Runs the correct test provider for a given test, based on its
-- name (not very nice, but...).
-run :: String -> Name -> Q Exp
-run tsname name =
+run :: Name -> Q Exp
+run name =
let str = nameBase name
nameE = varE name
strE = litE (StringL str)
in case () of
- _ | "prop_" `isPrefixOf` str -> [| runQC tsname $strE $nameE |]
- | "case_" `isPrefixOf` str -> [| runHUnit tsname $strE $nameE |]
+ _ | propPrefix `isPrefixOf` str -> [| runProp $strE $nameE |]
+ | casePrefix `isPrefixOf` str -> [| runCase $strE $nameE |]
| otherwise -> fail $ "Unsupported test function name '" ++ str ++ "'"
-- | Builds a test suite.
testSuite :: String -> [Name] -> Q [Dec]
testSuite tsname tdef = do
let fullname = mkName $ "test" ++ tsname
- tests <- mapM (run tsname) tdef
+ tests <- mapM run tdef
sigtype <- [t| (String, [Test]) |]
return [ SigD fullname sigtype
, ValD (VarP fullname) (NormalB (TupE [LitE (StringL tsname),
--
GitLab