From 5ef78537289a5247a8c89318445189867f8cf11e Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Tue, 30 Nov 2010 12:20:07 +0000
Subject: [PATCH] Rework Container.hs and improve test coverage
Since some of the functions we export from Container.hs are 1:1
identical to IntMap, we can just export the originals and remove the
wrappers. This reduces the code we need to unittest.
Furthermore, we add two simple unittest for the two non-trivial
functions that we do have in Container.hs.
And finally, we remove the 'remove' function, since it's not used, and
thus bring code coverage very close to 100%.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Balazs Lecz <leczb@google.com>
---
Ganeti/HTools/Container.hs | 35 +++++++++--------------------------
Ganeti/HTools/QC.hs | 32 +++++++++++++++++++++++++++++++-
2 files changed, 40 insertions(+), 27 deletions(-)
diff --git a/Ganeti/HTools/Container.hs b/Ganeti/HTools/Container.hs
index 335c5b965..d24bb793b 100644
--- a/Ganeti/HTools/Container.hs
+++ b/Ganeti/HTools/Container.hs
@@ -32,20 +32,23 @@ module Ganeti.HTools.Container
Container
, Key
-- * Creation
- , empty
+ , IntMap.empty
+ , IntMap.singleton
, fromAssocList
-- * Query
- , size
+ , IntMap.size
+ , IntMap.null
, find
+ , IntMap.findMax
-- * Update
, add
, addTwo
- , remove
, IntMap.map
, IntMap.mapAccum
+ , IntMap.filter
-- * Conversion
- , elems
- , keys
+ , IntMap.elems
+ , IntMap.keys
-- * Element functions
, nameOf
, findByName
@@ -58,14 +61,6 @@ import qualified Ganeti.HTools.Types as T
type Key = IntMap.Key
type Container = IntMap.IntMap
--- | Create an empty container.
-empty :: Container a
-empty = IntMap.empty
-
--- | Returns the number of elements in the map.
-size :: Container a -> Int
-size = IntMap.size
-
-- | Locate a key in the map (must exist).
find :: Key -> Container a -> a
find k = (IntMap.! k)
@@ -74,18 +69,6 @@ find k = (IntMap.! k)
add :: Key -> a -> Container a -> Container a
add = IntMap.insert
--- | Remove an element from the map.
-remove :: Key -> Container a -> Container a
-remove = IntMap.delete
-
--- | Return the list of values in the map.
-elems :: Container a -> [a]
-elems = IntMap.elems
-
--- | Return the list of keys in the map.
-keys :: Container a -> [Key]
-keys = IntMap.keys
-
-- | Create a map from an association list.
fromAssocList :: [(Key, a)] -> Container a
fromAssocList = IntMap.fromList
@@ -102,7 +85,7 @@ nameOf c k = T.nameOf $ find k c
findByName :: (T.Element a, Monad m) =>
Container a -> String -> m a
findByName c n =
- let all_elems = elems c
+ let all_elems = IntMap.elems c
result = filter ((n `elem`) . T.allNames) all_elems
in case result of
[item] -> return item
diff --git a/Ganeti/HTools/QC.hs b/Ganeti/HTools/QC.hs
index 818827d5c..f10f6c4dc 100644
--- a/Ganeti/HTools/QC.hs
+++ b/Ganeti/HTools/QC.hs
@@ -281,8 +281,38 @@ prop_Container_addTwo cdata i1 i2 =
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 =
+ let nl = makeSmallCluster node 1
+ fnode = head (Container.elems nl)
+ in Container.nameOf nl (Node.idx fnode) == Node.name fnode
+
+-- 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 node othername =
+ forAll (choose (1, 20)) $ \ cnt ->
+ forAll (choose (0, cnt - 1)) $ \ fidx ->
+ forAll (vector cnt) $ \ names ->
+ (length . nub) (map fst names ++ map snd names) ==
+ length names * 2 &&
+ not (othername `elem` (map fst names ++ map snd names)) ==>
+ let nl = makeSmallCluster node cnt
+ nodes = Container.elems nl
+ nodes' = map (\((name, alias), nn) -> (Node.idx nn,
+ nn { Node.name = name,
+ Node.alias = alias }))
+ $ zip names nodes
+ nl' = Container.fromAssocList nodes'
+ target = snd (nodes' !! fidx)
+ in Container.findByName nl' (Node.name target) == Just target &&
+ Container.findByName nl' (Node.alias target) == Just target &&
+ Container.findByName nl' othername == Nothing
+
testContainer =
- [ run prop_Container_addTwo ]
+ [ run prop_Container_addTwo
+ , run prop_Container_nameOf
+ , run prop_Container_findByName
+ ]
-- Simple instance tests, we only have setter/getters
--
GitLab