root / test / hs / Test / Ganeti / HTools / Container.hs @ 83846468
History | View | Annotate | Download (3 kB)
1 |
{-# LANGUAGE TemplateHaskell #-} |
---|---|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
3 |
|
4 |
{-| Unittests for ganeti-htools. |
5 |
|
6 |
-} |
7 |
|
8 |
{- |
9 |
|
10 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
11 |
|
12 |
This program is free software; you can redistribute it and/or modify |
13 |
it under the terms of the GNU General Public License as published by |
14 |
the Free Software Foundation; either version 2 of the License, or |
15 |
(at your option) any later version. |
16 |
|
17 |
This program is distributed in the hope that it will be useful, but |
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 |
General Public License for more details. |
21 |
|
22 |
You should have received a copy of the GNU General Public License |
23 |
along with this program; if not, write to the Free Software |
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 |
02110-1301, USA. |
26 |
|
27 |
-} |
28 |
|
29 |
module Test.Ganeti.HTools.Container (testHTools_Container) where |
30 |
|
31 |
import Test.QuickCheck |
32 |
|
33 |
import Data.Maybe |
34 |
|
35 |
import Test.Ganeti.TestHelper |
36 |
import Test.Ganeti.TestCommon |
37 |
import Test.Ganeti.TestHTools |
38 |
import Test.Ganeti.HTools.Node (genNode) |
39 |
|
40 |
import qualified Ganeti.HTools.Container as Container |
41 |
import qualified Ganeti.HTools.Node as Node |
42 |
|
43 |
-- we silence the following due to hlint bug fixed in later versions |
44 |
{-# ANN prop_addTwo "HLint: ignore Avoid lambda" #-} |
45 |
prop_addTwo :: [Container.Key] -> Int -> Int -> Bool |
46 |
prop_addTwo cdata i1 i2 = |
47 |
fn i1 i2 cont == fn i2 i1 cont && |
48 |
fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont) |
49 |
where cont = foldl (\c x -> Container.add x x c) Container.empty cdata |
50 |
fn x1 x2 = Container.addTwo x1 x1 x2 x2 |
51 |
|
52 |
prop_nameOf :: Node.Node -> Property |
53 |
prop_nameOf node = |
54 |
let nl = makeSmallCluster node 1 |
55 |
fnode = head (Container.elems nl) |
56 |
in Container.nameOf nl (Node.idx fnode) ==? Node.name fnode |
57 |
|
58 |
-- | We test that in a cluster, given a random node, we can find it by |
59 |
-- its name and alias, as long as all names and aliases are unique, |
60 |
-- and that we fail to find a non-existing name. |
61 |
prop_findByName :: Property |
62 |
prop_findByName = |
63 |
forAll (genNode (Just 1) Nothing) $ \node -> |
64 |
forAll (choose (1, 20)) $ \ cnt -> |
65 |
forAll (choose (0, cnt - 1)) $ \ fidx -> |
66 |
forAll (genUniquesList (cnt * 2) arbitrary) $ \ allnames -> |
67 |
forAll (arbitrary `suchThat` (`notElem` allnames)) $ \ othername -> |
68 |
let names = zip (take cnt allnames) (drop cnt allnames) |
69 |
nl = makeSmallCluster node cnt |
70 |
nodes = Container.elems nl |
71 |
nodes' = map (\((name, alias), nn) -> (Node.idx nn, |
72 |
nn { Node.name = name, |
73 |
Node.alias = alias })) |
74 |
$ zip names nodes |
75 |
nl' = Container.fromList nodes' |
76 |
target = snd (nodes' !! fidx) |
77 |
in conjoin |
78 |
[ Container.findByName nl' (Node.name target) ==? Just target |
79 |
, Container.findByName nl' (Node.alias target) ==? Just target |
80 |
, printTestCase "Found non-existing name" |
81 |
(isNothing (Container.findByName nl' othername)) |
82 |
] |
83 |
|
84 |
testSuite "HTools/Container" |
85 |
[ 'prop_addTwo |
86 |
, 'prop_nameOf |
87 |
, 'prop_findByName |
88 |
] |