Merge branch 'stable-2.6'

[ganeti-local] / htools / test.hs

diff --git a/htools/test.hs b/htools/test.hs
index 7af9e8f..eedefd3 100644 (file)
--- a/htools/test.hs
+++ b/htools/test.hs
@@ -4,7 +4,7 @@
 
 {-
 
-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
@@ -28,6 +28,7 @@ module Main(main) where
 import Data.Char
 import Data.IORef
 import Data.List
+import Data.Maybe (fromMaybe)
 import System.Console.GetOpt ()
 import System.Environment (getArgs)
 import System.Exit
@@ -46,6 +47,7 @@ options =
   , oVerbose
   , oShowVer
   , oShowHelp
+  , oTestCount
   ]
 
 fast :: Args
@@ -115,10 +117,14 @@ allTests =
   , (fast, testInstance)
   , (fast, testNode)
   , (fast, testText)
+  , (fast, testSimu)
   , (fast, testOpCodes)
   , (fast, testJobs)
   , (fast, testLoader)
   , (fast, testTypes)
+  , (fast, testCLI)
+  , (fast, testJSON)
+  , (fast, testLUXI)
   , (slow, testCluster)
   ]
 
@@ -136,11 +142,13 @@ transformTestOpts args opts = do
          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 ()
@@ -149,26 +157,26 @@ main = do
   let wrap = map (wrapTest errs)
   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."