Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / HTools / Instance.hs @ 2724417c

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
  spindles <- arbitrary
66
  let disk = Instance.Disk dsk spindles
67
  return $ Instance.create
68
    name mem dsk [disk] vcpus run_st [] True pn sn dt 1 []
69

    
70
-- | Generates an instance smaller than a node.
71
genInstanceSmallerThanNode :: Node.Node -> Gen Instance.Instance
72
genInstanceSmallerThanNode node =
73
  genInstanceSmallerThan (Node.availMem node `div` 2)
74
                         (Node.availDisk node `div` 2)
75
                         (Node.availCpu node `div` 2)
76

    
77
-- | Generates an instance possibly bigger than a node.
78
genInstanceMaybeBiggerThanNode :: Node.Node -> Gen Instance.Instance
79
genInstanceMaybeBiggerThanNode node =
80
  genInstanceSmallerThan (Node.availMem  node + Types.unitMem * 2)
81
                         (Node.availDisk node + Types.unitDsk * 3)
82
                         (Node.availCpu  node + Types.unitCpu * 4)
83

    
84
-- | Generates an instance with nodes on a node list.
85
-- The following rules are respected:
86
-- 1. The instance is never bigger than its primary node
87
-- 2. If possible the instance has different pnode and snode
88
-- 3. Else disk templates which require secondary nodes are disabled
89
genInstanceOnNodeList :: Node.List -> Gen Instance.Instance
90
genInstanceOnNodeList nl = do
91
  let nsize = Container.size nl
92
  pnode <- choose (0, nsize-1)
93
  let (snodefilter, dtfilter) =
94
        if nsize >= 2
95
          then ((/= pnode), const True)
96
          else (const True, not . Instance.hasSecondary)
97
  snode <- choose (0, nsize-1) `suchThat` snodefilter
98
  i <- genInstanceSmallerThanNode (Container.find pnode nl) `suchThat` dtfilter
99
  return $ i { Instance.pNode = pnode, Instance.sNode = snode }
100

    
101
-- | Generates an instance list given an instance generator.
102
genInstanceList :: Gen Instance.Instance -> Gen Instance.List
103
genInstanceList igen = fmap (snd . Loader.assignIndices) names_instances
104
    where names_instances =
105
            (fmap . map) (\n -> (Instance.name n, n)) $ listOf igen
106

    
107
-- let's generate a random instance
108
instance Arbitrary Instance.Instance where
109
  arbitrary = genInstanceSmallerThan maxMem maxDsk maxCpu
110

    
111
-- * Test cases
112

    
113
-- Simple instance tests, we only have setter/getters
114

    
115
prop_creat :: Instance.Instance -> Property
116
prop_creat inst =
117
  Instance.name inst ==? Instance.alias inst
118

    
119
prop_setIdx :: Instance.Instance -> Types.Idx -> Property
120
prop_setIdx inst idx =
121
  Instance.idx (Instance.setIdx inst idx) ==? idx
122

    
123
prop_setName :: Instance.Instance -> String -> Bool
124
prop_setName inst name =
125
  Instance.name newinst == name &&
126
  Instance.alias newinst == name
127
    where newinst = Instance.setName inst name
128

    
129
prop_setAlias :: Instance.Instance -> String -> Bool
130
prop_setAlias inst name =
131
  Instance.name newinst == Instance.name inst &&
132
  Instance.alias newinst == name
133
    where newinst = Instance.setAlias inst name
134

    
135
prop_setPri :: Instance.Instance -> Types.Ndx -> Property
136
prop_setPri inst pdx =
137
  Instance.pNode (Instance.setPri inst pdx) ==? pdx
138

    
139
prop_setSec :: Instance.Instance -> Types.Ndx -> Property
140
prop_setSec inst sdx =
141
  Instance.sNode (Instance.setSec inst sdx) ==? sdx
142

    
143
prop_setBoth :: Instance.Instance -> Types.Ndx -> Types.Ndx -> Bool
144
prop_setBoth inst pdx sdx =
145
  Instance.pNode si == pdx && Instance.sNode si == sdx
146
    where si = Instance.setBoth inst pdx sdx
147

    
148
prop_shrinkMG :: Instance.Instance -> Property
149
prop_shrinkMG inst =
150
  Instance.mem inst >= 2 * Types.unitMem ==>
151
    case Instance.shrinkByType inst Types.FailMem of
152
      Ok inst' -> Instance.mem inst' ==? Instance.mem inst - Types.unitMem
153
      Bad msg -> failTest msg
154

    
155
prop_shrinkMF :: Instance.Instance -> Property
156
prop_shrinkMF inst =
157
  forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
158
    let inst' = inst { Instance.mem = mem}
159
    in isBad $ Instance.shrinkByType inst' Types.FailMem
160

    
161
prop_shrinkCG :: Instance.Instance -> Property
162
prop_shrinkCG inst =
163
  Instance.vcpus inst >= 2 * Types.unitCpu ==>
164
    case Instance.shrinkByType inst Types.FailCPU of
165
      Ok inst' -> Instance.vcpus inst' ==? Instance.vcpus inst - Types.unitCpu
166
      Bad msg -> failTest msg
167

    
168
prop_shrinkCF :: Instance.Instance -> Property
169
prop_shrinkCF inst =
170
  forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
171
    let inst' = inst { Instance.vcpus = vcpus }
172
    in isBad $ Instance.shrinkByType inst' Types.FailCPU
173

    
174
prop_shrinkDG :: Instance.Instance -> Property
175
prop_shrinkDG inst =
176
  Instance.dsk inst >= 2 * Types.unitDsk ==>
177
    case Instance.shrinkByType inst Types.FailDisk of
178
      Ok inst' -> Instance.dsk inst' ==? Instance.dsk inst - Types.unitDsk
179
      Bad msg -> failTest msg
180

    
181
prop_shrinkDF :: Instance.Instance -> Property
182
prop_shrinkDF inst =
183
  forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
184
    let inst' = inst { Instance.dsk = dsk }
185
    in isBad $ Instance.shrinkByType inst' Types.FailDisk
186

    
187
prop_setMovable :: Instance.Instance -> Bool -> Property
188
prop_setMovable inst m =
189
  Instance.movable inst' ==? m
190
    where inst' = Instance.setMovable inst m
191

    
192
testSuite "HTools/Instance"
193
            [ 'prop_creat
194
            , 'prop_setIdx
195
            , 'prop_setName
196
            , 'prop_setAlias
197
            , 'prop_setPri
198
            , 'prop_setSec
199
            , 'prop_setBoth
200
            , 'prop_shrinkMG
201
            , 'prop_shrinkMF
202
            , 'prop_shrinkCG
203
            , 'prop_shrinkCF
204
            , 'prop_shrinkDG
205
            , 'prop_shrinkDF
206
            , 'prop_setMovable
207
            ]