Statistics
| Branch: | Tag: | Revision:

root / htest / Test / Ganeti / TestCommon.hs @ 4c49b965

History | View | Annotate | Download (8 kB)

1
{-| Unittest helpers for ganeti-htools.
2

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
8

    
9
This program is free software; you can redistribute it and/or modify
10
it under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2 of the License, or
12
(at your option) any later version.
13

    
14
This program is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17
General Public License for more details.
18

    
19
You should have received a copy of the GNU General Public License
20
along with this program; if not, write to the Free Software
21
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22
02110-1301, USA.
23

    
24
-}
25

    
26
module Test.Ganeti.TestCommon where
27

    
28
import Control.Applicative
29
import Control.Exception (catchJust)
30
import Control.Monad
31
import Data.List
32
import qualified Data.Set as Set
33
import System.Environment (getEnv)
34
import System.Exit (ExitCode(..))
35
import System.IO.Error (isDoesNotExistError)
36
import System.Process (readProcessWithExitCode)
37
import qualified Test.HUnit as HUnit
38
import Test.QuickCheck
39
import Test.QuickCheck.Monadic
40
import qualified Text.JSON as J
41

    
42
import qualified Ganeti.BasicTypes as BasicTypes
43

    
44
-- * Constants
45

    
46
-- | Maximum memory (1TiB, somewhat random value).
47
maxMem :: Int
48
maxMem = 1024 * 1024
49

    
50
-- | Maximum disk (8TiB, somewhat random value).
51
maxDsk :: Int
52
maxDsk = 1024 * 1024 * 8
53

    
54
-- | Max CPUs (1024, somewhat random value).
55
maxCpu :: Int
56
maxCpu = 1024
57

    
58
-- | Max vcpu ratio (random value).
59
maxVcpuRatio :: Double
60
maxVcpuRatio = 1024.0
61

    
62
-- | Max spindle ratio (random value).
63
maxSpindleRatio :: Double
64
maxSpindleRatio = 1024.0
65

    
66
-- | Max nodes, used just to limit arbitrary instances for smaller
67
-- opcode definitions (e.g. list of nodes in OpTestDelay).
68
maxNodes :: Int
69
maxNodes = 32
70

    
71
-- | Max opcodes or jobs in a submit job and submit many jobs.
72
maxOpCodes :: Int
73
maxOpCodes = 16
74

    
75
-- * Helper functions
76

    
77
-- | Checks for equality with proper annotation. The first argument is
78
-- the computed value, the second one the expected value.
79
(==?) :: (Show a, Eq a) => a -> a -> Property
80
(==?) x y = printTestCase
81
            ("Expected equality, but got mismatch\nexpected: " ++
82
             show y ++ "\n but got: " ++ show x) (x == y)
83
infix 3 ==?
84

    
85
-- | Checks for inequality with proper annotation. The first argument
86
-- is the computed value, the second one the expected (not equal)
87
-- value.
88
(/=?) :: (Show a, Eq a) => a -> a -> Property
89
(/=?) x y = printTestCase
90
            ("Expected inequality, but got equality: '" ++
91
             show x ++ "'.") (x /= y)
92
infix 3 /=?
93

    
94
-- | Show a message and fail the test.
95
failTest :: String -> Property
96
failTest msg = printTestCase msg False
97

    
98
-- | A 'True' property.
99
passTest :: Property
100
passTest = property True
101

    
102
-- | Return the python binary to use. If the PYTHON environment
103
-- variable is defined, use its value, otherwise use just \"python\".
104
pythonCmd :: IO String
105
pythonCmd = catchJust (guard . isDoesNotExistError)
106
            (getEnv "PYTHON") (const (return "python"))
107

    
108
-- | Run Python with an expression, returning the exit code, standard
109
-- output and error.
110
runPython :: String -> String -> IO (ExitCode, String, String)
111
runPython expr stdin = do
112
  py_binary <- pythonCmd
113
  readProcessWithExitCode py_binary ["-c", expr] stdin
114

    
115
-- | Check python exit code, and fail via HUnit assertions if
116
-- non-zero. Otherwise, return the standard output.
117
checkPythonResult :: (ExitCode, String, String) -> IO String
118
checkPythonResult (py_code, py_stdout, py_stderr) = do
119
  HUnit.assertEqual ("python exited with error: " ++ py_stderr)
120
       ExitSuccess py_code
121
  return py_stdout
122

    
123
-- * Arbitrary instances
124

    
125
-- | Defines a DNS name.
126
newtype DNSChar = DNSChar { dnsGetChar::Char }
127

    
128
instance Arbitrary DNSChar where
129
  arbitrary = liftM DNSChar $ elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
130

    
131
instance Show DNSChar where
132
  show = show . dnsGetChar
133

    
134
-- | Generates a single name component.
135
genName :: Gen String
136
genName = do
137
  n <- choose (1, 16)
138
  dn <- vector n
139
  return (map dnsGetChar dn)
140

    
141
-- | Generates an entire FQDN.
142
genFQDN :: Gen String
143
genFQDN = do
144
  ncomps <- choose (1, 4)
145
  names <- vectorOf ncomps genName
146
  return $ intercalate "." names
147

    
148
-- | Combinator that generates a 'Maybe' using a sub-combinator.
149
genMaybe :: Gen a -> Gen (Maybe a)
150
genMaybe subgen = frequency [ (1, pure Nothing), (3, Just <$> subgen) ]
151

    
152
-- | Defines a tag type.
153
newtype TagChar = TagChar { tagGetChar :: Char }
154

    
155
-- | All valid tag chars. This doesn't need to match _exactly_
156
-- Ganeti's own tag regex, just enough for it to be close.
157
tagChar :: String
158
tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
159

    
160
instance Arbitrary TagChar where
161
  arbitrary = liftM TagChar $ elements tagChar
162

    
163
-- | Generates a tag
164
genTag :: Gen [TagChar]
165
genTag = do
166
  -- the correct value would be C.maxTagLen, but that's way too
167
  -- verbose in unittests, and at the moment I don't see any possible
168
  -- bugs with longer tags and the way we use tags in htools
169
  n <- choose (1, 10)
170
  vector n
171

    
172
-- | Generates a list of tags (correctly upper bounded).
173
genTags :: Gen [String]
174
genTags = do
175
  -- the correct value would be C.maxTagsPerObj, but per the comment
176
  -- in genTag, we don't use tags enough in htools to warrant testing
177
  -- such big values
178
  n <- choose (0, 10::Int)
179
  tags <- mapM (const genTag) [1..n]
180
  return $ map (map tagGetChar) tags
181

    
182
-- | Generates a fields list. This uses the same character set as a
183
-- DNS name (just for simplicity).
184
genFields :: Gen [String]
185
genFields = do
186
  n <- choose (1, 32)
187
  vectorOf n genName
188

    
189
-- | Generates a list of a given size with non-duplicate elements.
190
genUniquesList :: (Eq a, Arbitrary a) => Int -> Gen [a]
191
genUniquesList cnt =
192
  foldM (\lst _ -> do
193
           newelem <- arbitrary `suchThat` (`notElem` lst)
194
           return (newelem:lst)) [] [1..cnt]
195

    
196
newtype SmallRatio = SmallRatio Double deriving Show
197
instance Arbitrary SmallRatio where
198
  arbitrary = liftM SmallRatio $ choose (0, 1)
199

    
200
-- | Helper for 'genSet', declared separately due to type constraints.
201
genSetHelper :: (Ord a) => [a] -> Maybe Int -> Gen (Set.Set a)
202
genSetHelper candidates size = do
203
  size' <- case size of
204
             Nothing -> choose (0, length candidates)
205
             Just s | s > length candidates ->
206
                        error $ "Invalid size " ++ show s ++ ", maximum is " ++
207
                                show (length candidates)
208
                    | otherwise -> return s
209
  foldM (\set _ -> do
210
           newelem <- elements candidates `suchThat` (`Set.notMember` set)
211
           return (Set.insert newelem set)) Set.empty [1..size']
212

    
213
-- | Generates a set of arbitrary elements.
214
genSet :: (Ord a, Bounded a, Enum a) => Maybe Int -> Gen (Set.Set a)
215
genSet = genSetHelper [minBound..maxBound]
216

    
217
-- * Helper functions
218

    
219
-- | Checks for serialisation idempotence.
220
testSerialisation :: (Eq a, Show a, J.JSON a) => a -> Property
221
testSerialisation a =
222
  case J.readJSON (J.showJSON a) of
223
    J.Error msg -> failTest $ "Failed to deserialise: " ++ msg
224
    J.Ok a' -> a ==? a'
225

    
226
-- | Result to PropertyM IO.
227
resultProp :: (Show a) => BasicTypes.GenericResult a b -> PropertyM IO b
228
resultProp (BasicTypes.Bad err) = stop . failTest $ show err
229
resultProp (BasicTypes.Ok  val) = return val
230

    
231
-- | Return the source directory of Ganeti.
232
getSourceDir :: IO FilePath
233
getSourceDir = catchJust (guard . isDoesNotExistError)
234
            (getEnv "TOP_SRCDIR")
235
            (const (return "."))
236

    
237
-- | Returns the path of a file in the test data directory, given its name.
238
testDataFilename :: String -> String -> IO FilePath
239
testDataFilename datadir name = do
240
        src <- getSourceDir
241
        return $ src ++ datadir ++ name
242

    
243
-- | Returns the content of the specified python test data file.
244
readPythonTestData :: String -> IO String
245
readPythonTestData filename = do
246
    name <- testDataFilename "/test/data/" filename
247
    readFile name
248

    
249
-- | Returns the content of the specified haskell test data file.
250
readTestData :: String -> IO String
251
readTestData filename = do
252
    name <- testDataFilename "/htest/data/" filename
253
    readFile name