## root / htest / Test / Ganeti / HTools / Container.hs @ df8578fb

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 |
] |