## root / htest / Test / Ganeti / HTools / Instance.hs @ fb243105

History | View | Annotate | Download (5.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.Instance |

30 |
( testHTools_Instance |

31 |
, genInstanceSmallerThanNode |

32 |
, genInstanceSmallerThan |

33 |
, Instance.Instance(..) |

34 |
) where |

35 | |

36 |
import Test.QuickCheck |

37 | |

38 |
import Test.Ganeti.TestHelper |

39 |
import Test.Ganeti.TestCommon |

40 |
import Test.Ganeti.HTools.Types () |

41 | |

42 |
import qualified Ganeti.HTools.Instance as Instance |

43 |
import qualified Ganeti.HTools.Node as Node |

44 |
import qualified Ganeti.HTools.Types as Types |

45 | |

46 |
-- * Arbitrary instances |

47 | |

48 |
-- | Generates a random instance with maximum disk/mem/cpu values. |

49 |
genInstanceSmallerThan :: Int -> Int -> Int -> Gen Instance.Instance |

50 |
genInstanceSmallerThan lim_mem lim_dsk lim_cpu = do |

51 |
name <- getFQDN |

52 |
mem <- choose (0, lim_mem) |

53 |
dsk <- choose (0, lim_dsk) |

54 |
run_st <- arbitrary |

55 |
pn <- arbitrary |

56 |
sn <- arbitrary |

57 |
vcpus <- choose (0, lim_cpu) |

58 |
dt <- arbitrary |

59 |
return $ Instance.create name mem dsk vcpus run_st [] True pn sn dt 1 |

60 | |

61 |
-- | Generates an instance smaller than a node. |

62 |
genInstanceSmallerThanNode :: Node.Node -> Gen Instance.Instance |

63 |
genInstanceSmallerThanNode node = |

64 |
genInstanceSmallerThan (Node.availMem node `div` 2) |

65 |
(Node.availDisk node `div` 2) |

66 |
(Node.availCpu node `div` 2) |

67 | |

68 |
-- let's generate a random instance |

69 |
instance Arbitrary Instance.Instance where |

70 |
arbitrary = genInstanceSmallerThan maxMem maxDsk maxCpu |

71 | |

72 |
-- * Test cases |

73 | |

74 |
-- Simple instance tests, we only have setter/getters |

75 | |

76 |
prop_creat :: Instance.Instance -> Property |

77 |
prop_creat inst = |

78 |
Instance.name inst ==? Instance.alias inst |

79 | |

80 |
prop_setIdx :: Instance.Instance -> Types.Idx -> Property |

81 |
prop_setIdx inst idx = |

82 |
Instance.idx (Instance.setIdx inst idx) ==? idx |

83 | |

84 |
prop_setName :: Instance.Instance -> String -> Bool |

85 |
prop_setName inst name = |

86 |
Instance.name newinst == name && |

87 |
Instance.alias newinst == name |

88 |
where newinst = Instance.setName inst name |

89 | |

90 |
prop_setAlias :: Instance.Instance -> String -> Bool |

91 |
prop_setAlias inst name = |

92 |
Instance.name newinst == Instance.name inst && |

93 |
Instance.alias newinst == name |

94 |
where newinst = Instance.setAlias inst name |

95 | |

96 |
prop_setPri :: Instance.Instance -> Types.Ndx -> Property |

97 |
prop_setPri inst pdx = |

98 |
Instance.pNode (Instance.setPri inst pdx) ==? pdx |

99 | |

100 |
prop_setSec :: Instance.Instance -> Types.Ndx -> Property |

101 |
prop_setSec inst sdx = |

102 |
Instance.sNode (Instance.setSec inst sdx) ==? sdx |

103 | |

104 |
prop_setBoth :: Instance.Instance -> Types.Ndx -> Types.Ndx -> Bool |

105 |
prop_setBoth inst pdx sdx = |

106 |
Instance.pNode si == pdx && Instance.sNode si == sdx |

107 |
where si = Instance.setBoth inst pdx sdx |

108 | |

109 |
prop_shrinkMG :: Instance.Instance -> Property |

110 |
prop_shrinkMG inst = |

111 |
Instance.mem inst >= 2 * Types.unitMem ==> |

112 |
case Instance.shrinkByType inst Types.FailMem of |

113 |
Types.Ok inst' -> Instance.mem inst' == Instance.mem inst - Types.unitMem |

114 |
_ -> False |

115 | |

116 |
prop_shrinkMF :: Instance.Instance -> Property |

117 |
prop_shrinkMF inst = |

118 |
forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem -> |

119 |
let inst' = inst { Instance.mem = mem} |

120 |
in Types.isBad $ Instance.shrinkByType inst' Types.FailMem |

121 | |

122 |
prop_shrinkCG :: Instance.Instance -> Property |

123 |
prop_shrinkCG inst = |

124 |
Instance.vcpus inst >= 2 * Types.unitCpu ==> |

125 |
case Instance.shrinkByType inst Types.FailCPU of |

126 |
Types.Ok inst' -> |

127 |
Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu |

128 |
_ -> False |

129 | |

130 |
prop_shrinkCF :: Instance.Instance -> Property |

131 |
prop_shrinkCF inst = |

132 |
forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus -> |

133 |
let inst' = inst { Instance.vcpus = vcpus } |

134 |
in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU |

135 | |

136 |
prop_shrinkDG :: Instance.Instance -> Property |

137 |
prop_shrinkDG inst = |

138 |
Instance.dsk inst >= 2 * Types.unitDsk ==> |

139 |
case Instance.shrinkByType inst Types.FailDisk of |

140 |
Types.Ok inst' -> |

141 |
Instance.dsk inst' == Instance.dsk inst - Types.unitDsk |

142 |
_ -> False |

143 | |

144 |
prop_shrinkDF :: Instance.Instance -> Property |

145 |
prop_shrinkDF inst = |

146 |
forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk -> |

147 |
let inst' = inst { Instance.dsk = dsk } |

148 |
in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk |

149 | |

150 |
prop_setMovable :: Instance.Instance -> Bool -> Property |

151 |
prop_setMovable inst m = |

152 |
Instance.movable inst' ==? m |

153 |
where inst' = Instance.setMovable inst m |

154 | |

155 |
testSuite "HTools/Instance" |

156 |
[ 'prop_creat |

157 |
, 'prop_setIdx |

158 |
, 'prop_setName |

159 |
, 'prop_setAlias |

160 |
, 'prop_setPri |

161 |
, 'prop_setSec |

162 |
, 'prop_setBoth |

163 |
, 'prop_shrinkMG |

164 |
, 'prop_shrinkMF |

165 |
, 'prop_shrinkCG |

166 |
, 'prop_shrinkCF |

167 |
, 'prop_shrinkDG |

168 |
, 'prop_shrinkDF |

169 |
, 'prop_setMovable |

170 |
] |