{-
-Copyright (C) 2009, 2011 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
import Data.Char
import Data.IORef
import Data.List
-import Test.QuickCheck
+import Data.Maybe (fromMaybe)
import System.Console.GetOpt ()
-import System.IO
+import System.Environment (getArgs)
import System.Exit
-import System (getArgs)
+import System.IO
+import Test.QuickCheck
import Text.Printf
import Ganeti.HTools.QC
, oVerbose
, oShowVer
, oShowHelp
+ , oTestCount
]
fast :: Args
, (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)
]
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
+ 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)
- cmd_args <- System.getArgs
+ 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 '"
- ++ intercalate " " args ++ "', available tests: "
- ++ intercalate ", " (map extractName allTests)
- exitWith $ ExitFailure 1
- else return selected))
+ 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."