-{-| Unittest runner for ganeti-htools
+{-| Unittest runner for ganeti-htools.
-}
{-
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2011, 2012 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
module Main(main) where
+import Data.Char
import Data.IORef
-import Test.QuickCheck.Batch
-import System.IO
+import Data.List
+import Data.Maybe (fromMaybe)
+import System.Console.GetOpt ()
+import System.Environment (getArgs)
import System.Exit
-import System (getArgs)
+import System.IO
+import Test.QuickCheck
+import Text.Printf
import Ganeti.HTools.QC
+import Ganeti.HTools.CLI
+import Ganeti.HTools.Utils (sepSplit)
+
+-- | Options list and functions.
+options :: [OptType]
+options =
+ [ oReplay
+ , oVerbose
+ , oShowVer
+ , oShowHelp
+ , oTestCount
+ ]
-fast :: TestOptions
-fast = TestOptions
- { no_of_tests = 500
- , length_of_tests = 10
- , debug_tests = False }
+fast :: Args
+fast = stdArgs
+ { maxSuccess = 500
+ , chatty = False
+ }
-slow :: TestOptions
-slow = TestOptions
- { no_of_tests = 50
- , length_of_tests = 100
- , debug_tests = False }
+slow :: Args
+slow = stdArgs
+ { maxSuccess = 50
+ , chatty = False
+ }
incIORef :: IORef Int -> IO ()
incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
--- | Wrapper over a test runner with error counting
+-- | Wrapper over a test runner with error counting.
wrapTest :: IORef Int
- -> (TestOptions -> IO TestResult)
- -> TestOptions -> IO TestResult
-wrapTest ir t to = do
- tr <- t to
- case tr of
- TestFailed _ _ -> incIORef ir
- TestAborted e -> do
- incIORef ir
- putStrLn ("Failure during test: <" ++ show e ++ ">")
- _ -> return ()
- return tr
-
-allTests :: [(String, TestOptions, [TestOptions -> IO TestResult])]
+ -> (Args -> IO Result, String)
+ -> Args
+ -> IO (Result, Char, String)
+wrapTest ir (test, desc) opts = do
+ r <- test opts
+ c <- case r of
+ Success {} -> return '.'
+ GaveUp {} -> return '?'
+ Failure {} -> incIORef ir >> return '#'
+ NoExpectedFailure {} -> incIORef ir >> return '*'
+ return (r, c, desc)
+
+runTests :: String
+ -> Args
+ -> [Args -> IO (Result, Char, String)]
+ -> Int
+ -> IO [(Result, String)]
+
+runTests name opts tests max_count = do
+ _ <- printf "%25s : " name
+ hFlush stdout
+ results <- mapM (\t -> do
+ (r, c, desc) <- t opts
+ putChar c
+ hFlush stdout
+ return (r, desc)
+ ) tests
+ let alldone = sum . map (numTests . fst) $ results
+ _ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone
+ mapM_ (\(r, desc) ->
+ case r of
+ Failure { output = o, usedSeed = u, usedSize = size } ->
+ printf "Test %s failed (seed was %s, test size %d): %s\n"
+ desc (show u) size o
+ GaveUp { numTests = passed } ->
+ printf "Test %s incomplete: gave up with only %d\
+ \ passes after discarding %d tests\n"
+ desc passed (maxDiscard opts)
+ _ -> return ()
+ ) results
+ return results
+
+allTests :: [(Args, (String, [(Args -> IO Result, String)]))]
allTests =
- [ ("Utils", fast, testUtils)
- , ("PeerMap", fast, testPeerMap)
- , ("Container", fast, testContainer)
- , ("Instance", fast, testInstance)
- , ("Node", fast, testNode)
- , ("Text", fast, testText)
- , ("OpCodes", fast, testOpCodes)
- , ("Jobs", fast, testJobs)
- , ("Loader", fast, testLoader)
- , ("Cluster", slow, testCluster)
+ [ (fast, testUtils)
+ , (fast, testPeerMap)
+ , (fast, testContainer)
+ , (fast, testInstance)
+ , (fast, testNode)
+ , (fast, testText)
+ , (fast, testSimu)
+ , (fast, testOpCodes)
+ , (fast, testJobs)
+ , (fast, testLoader)
+ , (fast, testTypes)
+ , (fast, testCLI)
+ , (fast, testJSON)
+ , (fast, testLUXI)
+ , (fast, testSsconf)
+ , (slow, testCluster)
]
+-- | Extracts the name of a test group.
+extractName :: (Args, (String, [(Args -> IO Result, String)])) -> String
+extractName (_, (name, _)) = name
+
+-- | Lowercase a string.
+lower :: String -> String
+lower = map toLower
+
+transformTestOpts :: Args -> Options -> IO Args
+transformTestOpts args opts = do
+ r <- case optReplay opts of
+ Nothing -> return Nothing
+ Just str -> do
+ let vs = sepSplit ',' str
+ case vs of
+ [rng, size] -> return $ Just (read rng, read size)
+ _ -> fail "Invalid state given"
+ return args { chatty = optVerbose opts > 1
+ , replay = r
+ , maxSuccess = fromMaybe (maxSuccess args) (optTestCount opts)
+ , maxDiscard = fromMaybe (maxDiscard args) (optTestCount opts)
+ }
+
main :: IO ()
main = do
errs <- newIORef 0
let wrap = map (wrapTest errs)
- args <- getArgs
- let tests = if null args
- then allTests
- else filter (\(name, _, _) -> name `elem` args) allTests
- mapM_ (\(name, opts, tl) -> runTests name opts (wrap tl)) tests
+ cmd_args <- getArgs
+ (opts, args) <- parseOpts cmd_args "test" options
+ tests <- if null args
+ then return allTests
+ else let args' = map lower args
+ selected = filter ((`elem` args') . lower .
+ extractName) allTests
+ in if null selected
+ then do
+ hPutStrLn stderr $ "No tests matching '"
+ ++ unwords args ++ "', available tests: "
+ ++ intercalate ", " (map extractName allTests)
+ exitWith $ ExitFailure 1
+ else return selected
+
+ let max_count = maximum $ map (\(_, (_, t)) -> length t) tests
+ mapM_ (\(targs, (name, tl)) ->
+ transformTestOpts targs opts >>= \newargs ->
+ runTests name newargs (wrap tl) max_count) tests
terr <- readIORef errs
- (if terr > 0
- then do
- hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
- exitWith $ ExitFailure 1
- else putStrLn "All tests succeeded.")
+ if terr > 0
+ then do
+ hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
+ exitWith $ ExitFailure 1
+ else putStrLn "All tests succeeded."
projects / ganeti-local / blobdiff