## root / test / hs / Test / Ganeti / HTools / Instance.hs @ 241cea1e

History | View | Annotate | Download (7 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 |
, genInstanceMaybeBiggerThanNode |

33 |
, genInstanceSmallerThan |

34 |
, genInstanceOnNodeList |

35 |
, genInstanceList |

36 |
, Instance.Instance(..) |

37 |
) where |

38 | |

39 |
import Test.QuickCheck hiding (Result) |

40 | |

41 |
import Test.Ganeti.TestHelper |

42 |
import Test.Ganeti.TestCommon |

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

44 | |

45 |
import Ganeti.BasicTypes |

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

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

48 |
import qualified Ganeti.HTools.Container as Container |

49 |
import qualified Ganeti.HTools.Loader as Loader |

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

51 | |

52 |
-- * Arbitrary instances |

53 | |

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

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

56 |
genInstanceSmallerThan lim_mem lim_dsk lim_cpu = do |

57 |
name <- genFQDN |

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

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

60 |
run_st <- arbitrary |

61 |
pn <- arbitrary |

62 |
sn <- arbitrary |

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

64 |
dt <- arbitrary |

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

66 | |

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

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

69 |
genInstanceSmallerThanNode node = |

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

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

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

73 | |

74 |
-- | Generates an instance possibly bigger than a node. |

75 |
genInstanceMaybeBiggerThanNode :: Node.Node -> Gen Instance.Instance |

76 |
genInstanceMaybeBiggerThanNode node = |

77 |
genInstanceSmallerThan (Node.availMem node + Types.unitMem * 2) |

78 |
(Node.availDisk node + Types.unitDsk * 3) |

79 |
(Node.availCpu node + Types.unitCpu * 4) |

80 | |

81 |
-- | Generates an instance with nodes on a node list. |

82 |
-- The following rules are respected: |

83 |
-- 1. The instance is never bigger than its primary node |

84 |
-- 2. If possible the instance has different pnode and snode |

85 |
-- 3. Else disk templates which require secondary nodes are disabled |

86 |
genInstanceOnNodeList :: Node.List -> Gen Instance.Instance |

87 |
genInstanceOnNodeList nl = do |

88 |
let nsize = Container.size nl |

89 |
pnode <- choose (0, nsize-1) |

90 |
let (snodefilter, dtfilter) = |

91 |
if nsize >= 2 |

92 |
then ((/= pnode), const True) |

93 |
else (const True, not . Instance.hasSecondary) |

94 |
snode <- choose (0, nsize-1) `suchThat` snodefilter |

95 |
i <- genInstanceSmallerThanNode (Container.find pnode nl) `suchThat` dtfilter |

96 |
return $ i { Instance.pNode = pnode, Instance.sNode = snode } |

97 | |

98 |
-- | Generates an instance list given an instance generator. |

99 |
genInstanceList :: Gen Instance.Instance -> Gen Instance.List |

100 |
genInstanceList igen = fmap (snd . Loader.assignIndices) names_instances |

101 |
where names_instances = |

102 |
(fmap . map) (\n -> (Instance.name n, n)) $ listOf igen |

103 | |

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

105 |
instance Arbitrary Instance.Instance where |

106 |
arbitrary = genInstanceSmallerThan maxMem maxDsk maxCpu |

107 | |

108 |
-- * Test cases |

109 | |

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

111 | |

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

113 |
prop_creat inst = |

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

115 | |

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

117 |
prop_setIdx inst idx = |

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

119 | |

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

121 |
prop_setName inst name = |

122 |
Instance.name newinst == name && |

123 |
Instance.alias newinst == name |

124 |
where newinst = Instance.setName inst name |

125 | |

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

127 |
prop_setAlias inst name = |

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

129 |
Instance.alias newinst == name |

130 |
where newinst = Instance.setAlias inst name |

131 | |

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

133 |
prop_setPri inst pdx = |

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

135 | |

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

137 |
prop_setSec inst sdx = |

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

139 | |

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

141 |
prop_setBoth inst pdx sdx = |

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

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

144 | |

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

146 |
prop_shrinkMG inst = |

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

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

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

150 |
Bad msg -> failTest msg |

151 | |

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

153 |
prop_shrinkMF inst = |

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

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

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

157 | |

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

159 |
prop_shrinkCG inst = |

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

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

162 |
Ok inst' -> Instance.vcpus inst' ==? Instance.vcpus inst - Types.unitCpu |

163 |
Bad msg -> failTest msg |

164 | |

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

166 |
prop_shrinkCF inst = |

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

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

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

170 | |

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

172 |
prop_shrinkDG inst = |

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

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

175 |
Ok inst' -> Instance.dsk inst' ==? Instance.dsk inst - Types.unitDsk |

176 |
Bad msg -> failTest msg |

177 | |

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

179 |
prop_shrinkDF inst = |

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

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

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

183 | |

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

185 |
prop_setMovable inst m = |

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

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

188 | |

189 |
testSuite "HTools/Instance" |

190 |
[ 'prop_creat |

191 |
, 'prop_setIdx |

192 |
, 'prop_setName |

193 |
, 'prop_setAlias |

194 |
, 'prop_setPri |

195 |
, 'prop_setSec |

196 |
, 'prop_setBoth |

197 |
, 'prop_shrinkMG |

198 |
, 'prop_shrinkMF |

199 |
, 'prop_shrinkCG |

200 |
, 'prop_shrinkCF |

201 |
, 'prop_shrinkDG |

202 |
, 'prop_shrinkDF |

203 |
, 'prop_setMovable |

204 |
] |