module Test.Ganeti.TestCommon where
import Control.Applicative
+import Control.Exception (catchJust)
+import Control.Monad
import Data.List
+import qualified Test.HUnit as HUnit
import Test.QuickCheck
+import System.Environment (getEnv)
+import System.Exit (ExitCode(..))
+import System.IO.Error (isDoesNotExistError)
+import System.Process (readProcessWithExitCode)
-- * Constants
failTest :: String -> Property
failTest msg = printTestCase msg False
+-- | Return the python binary to use. If the PYTHON environment
+-- variable is defined, use its value, otherwise use just \"python\".
+pythonCmd :: IO String
+pythonCmd = catchJust (guard . isDoesNotExistError)
+ (getEnv "PYTHON") (const (return "python"))
+
+-- | Run Python with an expression, returning the exit code, standard
+-- output and error.
+runPython :: String -> String -> IO (ExitCode, String, String)
+runPython expr stdin = do
+ py_binary <- pythonCmd
+ readProcessWithExitCode py_binary ["-c", expr] stdin
+
+-- | Check python exit code, and fail via HUnit assertions if
+-- non-zero. Otherwise, return the standard output.
+checkPythonResult :: (ExitCode, String, String) -> IO String
+checkPythonResult (py_code, py_stdout, py_stderr) = do
+ HUnit.assertEqual ("python exited with error: " ++ py_stderr)
+ ExitSuccess py_code
+ return py_stdout
-- * Arbitrary instances
if bool
then Just <$> subgen
else return Nothing
+
+-- | Defines a tag type.
+newtype TagChar = TagChar { tagGetChar :: Char }
+
+-- | All valid tag chars. This doesn't need to match _exactly_
+-- Ganeti's own tag regex, just enough for it to be close.
+tagChar :: [Char]
+tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
+
+instance Arbitrary TagChar where
+ arbitrary = do
+ c <- elements tagChar
+ return (TagChar c)
+
+-- | Generates a tag
+genTag :: Gen [TagChar]
+genTag = do
+ -- the correct value would be C.maxTagLen, but that's way too
+ -- verbose in unittests, and at the moment I don't see any possible
+ -- bugs with longer tags and the way we use tags in htools
+ n <- choose (1, 10)
+ vector n
+
+-- | Generates a list of tags (correctly upper bounded).
+genTags :: Gen [String]
+genTags = do
+ -- the correct value would be C.maxTagsPerObj, but per the comment
+ -- in genTag, we don't use tags enough in htools to warrant testing
+ -- such big values
+ n <- choose (0, 10::Int)
+ tags <- mapM (const genTag) [1..n]
+ return $ map (map tagGetChar) tags
+
+-- | Generates a fields list. This uses the same character set as a
+-- DNS name (just for simplicity).
+getFields :: Gen [String]
+getFields = do
+ n <- choose (1, 32)
+ vectorOf n getName
+
+-- | Generates a list of a given size with non-duplicate elements.
+genUniquesList :: (Eq a, Arbitrary a) => Int -> Gen [a]
+genUniquesList cnt =
+ foldM (\lst _ -> do
+ newelem <- arbitrary `suchThat` (`notElem` lst)
+ return (newelem:lst)) [] [1..cnt]
+
+newtype SmallRatio = SmallRatio Double deriving Show
+instance Arbitrary SmallRatio where
+ arbitrary = do
+ v <- choose (0, 1)
+ return $ SmallRatio v