diff --git a/htools/Ganeti/HTools/CLI.hs b/htools/Ganeti/HTools/CLI.hs index bc30b898b18007ace940e9b769b7fc5ecb98b2b1..33cacd94148db5fd31d4fe730ba74f714e4391d5 100644 --- a/htools/Ganeti/HTools/CLI.hs +++ b/htools/Ganeti/HTools/CLI.hs @@ -67,6 +67,7 @@ module Ganeti.HTools.CLI , oPrintNodes , oQuiet , oRapiMaster + , oReplay , oSaveCluster , oShowHelp , oShowVer @@ -126,6 +127,7 @@ data Options = Options , optShowNodes :: Maybe [String] -- ^ Whether to show node status , optShowVer :: Bool -- ^ Just show the program version , optTieredSpec :: Maybe RSpec -- ^ Requested specs for tiered mode + , optReplay :: Maybe String -- ^ Unittests: RNG state , optVerbose :: Int -- ^ Verbosity level } deriving Show @@ -164,6 +166,7 @@ defaultOptions = Options , optShowNodes = Nothing , optShowVer = False , optTieredSpec = Nothing + , optReplay = Nothing , optVerbose = 1 } @@ -381,6 +384,11 @@ oTieredSpec = Option "" ["tiered-alloc"] "TSPEC") "enable tiered specs allocation, given as 'disk,ram,cpu'" +oReplay :: OptType +oReplay = Option "" ["replay"] + (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE") + "Pre-seed the random number generator with STATE" + oVerbose :: OptType oVerbose = Option "v" ["verbose"] (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 })) diff --git a/htools/test.hs b/htools/test.hs index d0708ee27c2284b4891b94fff8932ea743a56061..228ef914debc6e4cacfa12a3508384c02d2dfb61 100644 --- a/htools/test.hs +++ b/htools/test.hs @@ -27,12 +27,24 @@ module Main(main) where import Data.IORef import Test.QuickCheck +import System.Console.GetOpt import System.IO import System.Exit import System (getArgs) 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 + ] fast :: Args fast = stdArgs @@ -101,16 +113,32 @@ allTests = , ("Cluster", slow, testCluster) ] +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 + } + main :: IO () main = do errs <- newIORef 0 let wrap = map (wrapTest errs) - args <- getArgs + cmd_args <- System.getArgs + (opts, args) <- parseOpts cmd_args "test" options let tests = if null args then allTests else filter (\(name, _, _) -> name `elem` args) allTests max_count = maximum $ map (\(_, _, t) -> length t) tests - mapM_ (\(name, opts, tl) -> runTests name opts (wrap tl) max_count) tests + mapM_ (\(name, targs, tl) -> + transformTestOpts targs opts >>= \newargs -> + runTests name newargs (wrap tl) max_count) tests terr <- readIORef errs (if terr > 0 then do