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 System.Environment (getEnv)
35 import System.Exit (ExitCode(..))
36 import System.IO.Error (isDoesNotExistError)
37 import System.Process (readProcessWithExitCode)
41 -- | Maximum memory (1TiB, somewhat random value).
45 -- | Maximum disk (8TiB, somewhat random value).
47 maxDsk = 1024 * 1024 * 8
49 -- | Max CPUs (1024, somewhat random value).
53 -- | Max vcpu ratio (random value).
54 maxVcpuRatio :: Double
57 -- | Max spindle ratio (random value).
58 maxSpindleRatio :: Double
59 maxSpindleRatio = 1024.0
61 -- | Max nodes, used just to limit arbitrary instances for smaller
62 -- opcode definitions (e.g. list of nodes in OpTestDelay).
66 -- | Max opcodes or jobs in a submit job and submit many jobs.
72 -- | Checks for equality with proper annotation.
73 (==?) :: (Show a, Eq a) => a -> a -> Property
74 (==?) x y = printTestCase
75 ("Expected equality, but '" ++
76 show x ++ "' /= '" ++ show y ++ "'") (x == y)
79 -- | Show a message and fail the test.
80 failTest :: String -> Property
81 failTest msg = printTestCase msg False
83 -- | Return the python binary to use. If the PYTHON environment
84 -- variable is defined, use its value, otherwise use just \"python\".
85 pythonCmd :: IO String
86 pythonCmd = catchJust (guard . isDoesNotExistError)
87 (getEnv "PYTHON") (const (return "python"))
89 -- | Run Python with an expression, returning the exit code, standard
91 runPython :: String -> String -> IO (ExitCode, String, String)
92 runPython expr stdin = do
93 py_binary <- pythonCmd
94 readProcessWithExitCode py_binary ["-c", expr] stdin
96 -- | Check python exit code, and fail via HUnit assertions if
97 -- non-zero. Otherwise, return the standard output.
98 checkPythonResult :: (ExitCode, String, String) -> IO String
99 checkPythonResult (py_code, py_stdout, py_stderr) = do
100 HUnit.assertEqual ("python exited with error: " ++ py_stderr)
104 -- * Arbitrary instances
106 -- | Defines a DNS name.
107 newtype DNSChar = DNSChar { dnsGetChar::Char }
109 instance Arbitrary DNSChar where
111 x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
114 instance Show DNSChar where
115 show = show . dnsGetChar
117 -- | Generates a single name component.
118 getName :: Gen String
122 return (map dnsGetChar dn)
124 -- | Generates an entire FQDN.
125 getFQDN :: Gen String
127 ncomps <- choose (1, 4)
128 names <- vectorOf ncomps getName
129 return $ intercalate "." names
131 -- | Combinator that generates a 'Maybe' using a sub-combinator.
132 getMaybe :: Gen a -> Gen (Maybe a)
139 -- | Defines a tag type.
140 newtype TagChar = TagChar { tagGetChar :: Char }
142 -- | All valid tag chars. This doesn't need to match _exactly_
143 -- Ganeti's own tag regex, just enough for it to be close.
145 tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
147 instance Arbitrary TagChar where
149 c <- elements tagChar
153 genTag :: Gen [TagChar]
155 -- the correct value would be C.maxTagLen, but that's way too
156 -- verbose in unittests, and at the moment I don't see any possible
157 -- bugs with longer tags and the way we use tags in htools
161 -- | Generates a list of tags (correctly upper bounded).
162 genTags :: Gen [String]
164 -- the correct value would be C.maxTagsPerObj, but per the comment
165 -- in genTag, we don't use tags enough in htools to warrant testing
167 n <- choose (0, 10::Int)
168 tags <- mapM (const genTag) [1..n]
169 return $ map (map tagGetChar) tags
171 -- | Generates a fields list. This uses the same character set as a
172 -- DNS name (just for simplicity).
173 getFields :: Gen [String]
178 -- | Generates a list of a given size with non-duplicate elements.
179 genUniquesList :: (Eq a, Arbitrary a) => Int -> Gen [a]
182 newelem <- arbitrary `suchThat` (`notElem` lst)
183 return (newelem:lst)) [] [1..cnt]
185 newtype SmallRatio = SmallRatio Double deriving Show
186 instance Arbitrary SmallRatio where
189 return $ SmallRatio v