1 {-| Unittest runner for ganeti-htools.
7 Copyright (C) 2009, 2011, 2012 Google Inc.
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
14 This program is distributed in the hope that it will be useful, but
15 WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 module Main(main) where
31 import Data.Maybe (fromMaybe)
32 import System.Console.GetOpt ()
33 import System.Environment (getArgs)
36 import Test.QuickCheck
39 import Ganeti.HTools.QC
40 import Ganeti.HTools.CLI
41 import Ganeti.HTools.Utils (sepSplit)
43 -- | Options list and functions.
65 incIORef :: IORef Int -> IO ()
66 incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
68 -- | Wrapper over a test runner with error counting.
70 -> (Args -> IO Result, String)
72 -> IO (Result, Char, String)
73 wrapTest ir (test, desc) opts = do
76 Success {} -> return '.'
77 GaveUp {} -> return '?'
78 Failure {} -> incIORef ir >> return '#'
79 NoExpectedFailure {} -> incIORef ir >> return '*'
84 -> [Args -> IO (Result, Char, String)]
86 -> IO [(Result, String)]
88 runTests name opts tests max_count = do
89 _ <- printf "%25s : " name
91 results <- mapM (\t -> do
92 (r, c, desc) <- t opts
97 let alldone = sum . map (numTests . fst) $ results
98 _ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone
101 Failure { output = o, usedSeed = u, usedSize = size } ->
102 printf "Test %s failed (seed was %s, test size %d): %s\n"
104 GaveUp { numTests = passed } ->
105 printf "Test %s incomplete: gave up with only %d\
106 \ passes after discarding %d tests\n"
107 desc passed (maxDiscard opts)
112 allTests :: [(Args, (String, [(Args -> IO Result, String)]))]
115 , (fast, testPeerMap)
116 , (fast, testContainer)
117 , (fast, testInstance)
121 , (fast, testOpCodes)
129 , (slow, testCluster)
132 -- | Extracts the name of a test group.
133 extractName :: (Args, (String, [(Args -> IO Result, String)])) -> String
134 extractName (_, (name, _)) = name
136 -- | Lowercase a string.
137 lower :: String -> String
140 transformTestOpts :: Args -> Options -> IO Args
141 transformTestOpts args opts = do
142 r <- case optReplay opts of
143 Nothing -> return Nothing
145 let vs = sepSplit ',' str
147 [rng, size] -> return $ Just (read rng, read size)
148 _ -> fail "Invalid state given"
149 return args { chatty = optVerbose opts > 1
151 , maxSuccess = fromMaybe (maxSuccess args) (optTestCount opts)
152 , maxDiscard = fromMaybe (maxDiscard args) (optTestCount opts)
158 let wrap = map (wrapTest errs)
160 (opts, args) <- parseOpts cmd_args "test" options
161 tests <- if null args
163 else let args' = map lower args
164 selected = filter ((`elem` args') . lower .
165 extractName) allTests
168 hPutStrLn stderr $ "No tests matching '"
169 ++ unwords args ++ "', available tests: "
170 ++ intercalate ", " (map extractName allTests)
171 exitWith $ ExitFailure 1
174 let max_count = maximum $ map (\(_, (_, t)) -> length t) tests
175 mapM_ (\(targs, (name, tl)) ->
176 transformTestOpts targs opts >>= \newargs ->
177 runTests name newargs (wrap tl) max_count) tests
178 terr <- readIORef errs
181 hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
182 exitWith $ ExitFailure 1
183 else putStrLn "All tests succeeded."