1 {-| Unittest helpers for ganeti-htools.
7 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
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.
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.
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
26 module Test.Ganeti.TestCommon where
28 import Control.Applicative
29 import Control.Exception (catchJust)
32 import qualified Test.HUnit as HUnit
33 import Test.QuickCheck
34 import Test.QuickCheck.Monadic
35 import qualified Text.JSON as J
36 import System.Environment (getEnv)
37 import System.Exit (ExitCode(..))
38 import System.IO.Error (isDoesNotExistError)
39 import System.Process (readProcessWithExitCode)
41 import qualified Ganeti.BasicTypes as BasicTypes
45 -- | Maximum memory (1TiB, somewhat random value).
49 -- | Maximum disk (8TiB, somewhat random value).
51 maxDsk = 1024 * 1024 * 8
53 -- | Max CPUs (1024, somewhat random value).
57 -- | Max vcpu ratio (random value).
58 maxVcpuRatio :: Double
61 -- | Max spindle ratio (random value).
62 maxSpindleRatio :: Double
63 maxSpindleRatio = 1024.0
65 -- | Max nodes, used just to limit arbitrary instances for smaller
66 -- opcode definitions (e.g. list of nodes in OpTestDelay).
70 -- | Max opcodes or jobs in a submit job and submit many jobs.
76 -- | Checks for equality with proper annotation.
77 (==?) :: (Show a, Eq a) => a -> a -> Property
78 (==?) x y = printTestCase
79 ("Expected equality, but '" ++
80 show x ++ "' /= '" ++ show y ++ "'") (x == y)
83 -- | Show a message and fail the test.
84 failTest :: String -> Property
85 failTest msg = printTestCase msg False
87 -- | A 'True' property.
89 passTest = property True
91 -- | Return the python binary to use. If the PYTHON environment
92 -- variable is defined, use its value, otherwise use just \"python\".
93 pythonCmd :: IO String
94 pythonCmd = catchJust (guard . isDoesNotExistError)
95 (getEnv "PYTHON") (const (return "python"))
97 -- | Run Python with an expression, returning the exit code, standard
99 runPython :: String -> String -> IO (ExitCode, String, String)
100 runPython expr stdin = do
101 py_binary <- pythonCmd
102 readProcessWithExitCode py_binary ["-c", expr] stdin
104 -- | Check python exit code, and fail via HUnit assertions if
105 -- non-zero. Otherwise, return the standard output.
106 checkPythonResult :: (ExitCode, String, String) -> IO String
107 checkPythonResult (py_code, py_stdout, py_stderr) = do
108 HUnit.assertEqual ("python exited with error: " ++ py_stderr)
112 -- * Arbitrary instances
114 -- | Defines a DNS name.
115 newtype DNSChar = DNSChar { dnsGetChar::Char }
117 instance Arbitrary DNSChar where
119 x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
122 instance Show DNSChar where
123 show = show . dnsGetChar
125 -- | Generates a single name component.
126 getName :: Gen String
130 return (map dnsGetChar dn)
132 -- | Generates an entire FQDN.
133 getFQDN :: Gen String
135 ncomps <- choose (1, 4)
136 names <- vectorOf ncomps getName
137 return $ intercalate "." names
139 -- | Combinator that generates a 'Maybe' using a sub-combinator.
140 getMaybe :: Gen a -> Gen (Maybe a)
147 -- | Defines a tag type.
148 newtype TagChar = TagChar { tagGetChar :: Char }
150 -- | All valid tag chars. This doesn't need to match _exactly_
151 -- Ganeti's own tag regex, just enough for it to be close.
153 tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
155 instance Arbitrary TagChar where
157 c <- elements tagChar
161 genTag :: Gen [TagChar]
163 -- the correct value would be C.maxTagLen, but that's way too
164 -- verbose in unittests, and at the moment I don't see any possible
165 -- bugs with longer tags and the way we use tags in htools
169 -- | Generates a list of tags (correctly upper bounded).
170 genTags :: Gen [String]
172 -- the correct value would be C.maxTagsPerObj, but per the comment
173 -- in genTag, we don't use tags enough in htools to warrant testing
175 n <- choose (0, 10::Int)
176 tags <- mapM (const genTag) [1..n]
177 return $ map (map tagGetChar) tags
179 -- | Generates a fields list. This uses the same character set as a
180 -- DNS name (just for simplicity).
181 getFields :: Gen [String]
186 -- | Generates a list of a given size with non-duplicate elements.
187 genUniquesList :: (Eq a, Arbitrary a) => Int -> Gen [a]
190 newelem <- arbitrary `suchThat` (`notElem` lst)
191 return (newelem:lst)) [] [1..cnt]
193 newtype SmallRatio = SmallRatio Double deriving Show
194 instance Arbitrary SmallRatio where
197 return $ SmallRatio v
199 -- | Checks for serialisation idempotence.
200 testSerialisation :: (Eq a, Show a, J.JSON a) => a -> Property
201 testSerialisation a =
202 case J.readJSON (J.showJSON a) of
203 J.Error msg -> failTest $ "Failed to deserialise: " ++ msg
206 -- | Result to PropertyM IO.
207 resultProp :: BasicTypes.Result a -> PropertyM IO a
208 resultProp (BasicTypes.Bad msg) = stop $ failTest msg
209 resultProp (BasicTypes.Ok val) = return val