Add note in admin guide about drbd stacked devices

[ganeti-local] / htools / test.hs

diff --git a/htools/test.hs b/htools/test.hs
index 4c9ddf2..6e43427 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
@@ -25,12 +25,15 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 module Main(main) where
 
+import Data.Char
 import Data.IORef
-import Test.QuickCheck
+import Data.List
+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
@@ -40,11 +43,12 @@ import Ganeti.HTools.Utils (sepSplit)
 -- | Options list and functions.
 options :: [OptType]
 options =
-    [ oReplay
-    , oVerbose
-    , oShowVer
-    , oShowHelp
-    ]
+  [ oReplay
+  , oVerbose
+  , oShowVer
+  , oShowHelp
+  , oTestCount
+  ]
 
 fast :: Args
 fast = stdArgs
@@ -113,42 +117,67 @@ allTests =
   , (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
+           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
-  let tests = if null args
-              then allTests
-              else filter (\(_, (name, _)) -> name `elem` args) allTests
-      max_count = maximum $ map (\(_, (_, t)) -> length t) tests
+  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
+           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."