Statistics
| Branch: | Tag: | Revision:

root / htest / Test / Ganeti / TestCommon.hs @ 2e0bb81d

History | View | Annotate | Download (5.7 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 Test.HUnit as HUnit
33
import Test.QuickCheck
34
import qualified Text.JSON as J
35
import System.Environment (getEnv)
36
import System.Exit (ExitCode(..))
37
import System.IO.Error (isDoesNotExistError)
38
import System.Process (readProcessWithExitCode)
39

    
40
-- * Constants
41

    
42
-- | Maximum memory (1TiB, somewhat random value).
43
maxMem :: Int
44
maxMem = 1024 * 1024
45

    
46
-- | Maximum disk (8TiB, somewhat random value).
47
maxDsk :: Int
48
maxDsk = 1024 * 1024 * 8
49

    
50
-- | Max CPUs (1024, somewhat random value).
51
maxCpu :: Int
52
maxCpu = 1024
53

    
54
-- | Max vcpu ratio (random value).
55
maxVcpuRatio :: Double
56
maxVcpuRatio = 1024.0
57

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

    
62
-- | Max nodes, used just to limit arbitrary instances for smaller
63
-- opcode definitions (e.g. list of nodes in OpTestDelay).
64
maxNodes :: Int
65
maxNodes = 32
66

    
67
-- | Max opcodes or jobs in a submit job and submit many jobs.
68
maxOpCodes :: Int
69
maxOpCodes = 16
70

    
71
-- * Helper functions
72

    
73
-- | Checks for equality with proper annotation.
74
(==?) :: (Show a, Eq a) => a -> a -> Property
75
(==?) x y = printTestCase
76
            ("Expected equality, but '" ++
77
             show x ++ "' /= '" ++ show y ++ "'") (x == y)
78
infix 3 ==?
79

    
80
-- | Show a message and fail the test.
81
failTest :: String -> Property
82
failTest msg = printTestCase msg False
83

    
84
-- | A 'True' property.
85
passTest :: Property
86
passTest = property True
87

    
88
-- | Return the python binary to use. If the PYTHON environment
89
-- variable is defined, use its value, otherwise use just \"python\".
90
pythonCmd :: IO String
91
pythonCmd = catchJust (guard . isDoesNotExistError)
92
            (getEnv "PYTHON") (const (return "python"))
93

    
94
-- | Run Python with an expression, returning the exit code, standard
95
-- output and error.
96
runPython :: String -> String -> IO (ExitCode, String, String)
97
runPython expr stdin = do
98
  py_binary <- pythonCmd
99
  readProcessWithExitCode py_binary ["-c", expr] stdin
100

    
101
-- | Check python exit code, and fail via HUnit assertions if
102
-- non-zero. Otherwise, return the standard output.
103
checkPythonResult :: (ExitCode, String, String) -> IO String
104
checkPythonResult (py_code, py_stdout, py_stderr) = do
105
  HUnit.assertEqual ("python exited with error: " ++ py_stderr)
106
       ExitSuccess py_code
107
  return py_stdout
108

    
109
-- * Arbitrary instances
110

    
111
-- | Defines a DNS name.
112
newtype DNSChar = DNSChar { dnsGetChar::Char }
113

    
114
instance Arbitrary DNSChar where
115
  arbitrary = do
116
    x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
117
    return (DNSChar x)
118

    
119
instance Show DNSChar where
120
  show = show . dnsGetChar
121

    
122
-- | Generates a single name component.
123
getName :: Gen String
124
getName = do
125
  n <- choose (1, 64)
126
  dn <- vector n
127
  return (map dnsGetChar dn)
128

    
129
-- | Generates an entire FQDN.
130
getFQDN :: Gen String
131
getFQDN = do
132
  ncomps <- choose (1, 4)
133
  names <- vectorOf ncomps getName
134
  return $ intercalate "." names
135

    
136
-- | Combinator that generates a 'Maybe' using a sub-combinator.
137
getMaybe :: Gen a -> Gen (Maybe a)
138
getMaybe subgen = do
139
  bool <- arbitrary
140
  if bool
141
    then Just <$> subgen
142
    else return Nothing
143

    
144
-- | Defines a tag type.
145
newtype TagChar = TagChar { tagGetChar :: Char }
146

    
147
-- | All valid tag chars. This doesn't need to match _exactly_
148
-- Ganeti's own tag regex, just enough for it to be close.
149
tagChar :: [Char]
150
tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
151

    
152
instance Arbitrary TagChar where
153
  arbitrary = do
154
    c <- elements tagChar
155
    return (TagChar c)
156

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

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

    
176
-- | Generates a fields list. This uses the same character set as a
177
-- DNS name (just for simplicity).
178
getFields :: Gen [String]
179
getFields = do
180
  n <- choose (1, 32)
181
  vectorOf n getName
182

    
183
-- | Generates a list of a given size with non-duplicate elements.
184
genUniquesList :: (Eq a, Arbitrary a) => Int -> Gen [a]
185
genUniquesList cnt =
186
  foldM (\lst _ -> do
187
           newelem <- arbitrary `suchThat` (`notElem` lst)
188
           return (newelem:lst)) [] [1..cnt]
189

    
190
newtype SmallRatio = SmallRatio Double deriving Show
191
instance Arbitrary SmallRatio where
192
  arbitrary = do
193
    v <- choose (0, 1)
194
    return $ SmallRatio v
195

    
196
-- | Checks for serialisation idempotence.
197
testSerialisation :: (Eq a, Show a, J.JSON a) => a -> Property
198
testSerialisation a =
199
  case J.readJSON (J.showJSON a) of
200
    J.Error msg -> failTest $ "Failed to deserialise: " ++ msg
201
    J.Ok a' -> a ==? a'