1 {-| Unittest runner for ganeti-htools.
7 Copyright (C) 2009, 2011 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 System.Console.GetOpt ()
32 import System.Environment (getArgs)
35 import Test.QuickCheck
38 import Ganeti.HTools.QC
39 import Ganeti.HTools.CLI
40 import Ganeti.HTools.Utils (sepSplit)
42 -- | Options list and functions.
63 incIORef :: IORef Int -> IO ()
64 incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
66 -- | Wrapper over a test runner with error counting.
68 -> (Args -> IO Result, String)
70 -> IO (Result, Char, String)
71 wrapTest ir (test, desc) opts = do
74 Success {} -> return '.'
75 GaveUp {} -> return '?'
76 Failure {} -> incIORef ir >> return '#'
77 NoExpectedFailure {} -> incIORef ir >> return '*'
82 -> [Args -> IO (Result, Char, String)]
84 -> IO [(Result, String)]
86 runTests name opts tests max_count = do
87 _ <- printf "%25s : " name
89 results <- mapM (\t -> do
90 (r, c, desc) <- t opts
95 let alldone = sum . map (numTests . fst) $ results
96 _ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone
99 Failure { output = o, usedSeed = u, usedSize = size } ->
100 printf "Test %s failed (seed was %s, test size %d): %s\n"
102 GaveUp { numTests = passed } ->
103 printf "Test %s incomplete: gave up with only %d\
104 \ passes after discarding %d tests\n"
105 desc passed (maxDiscard opts)
110 allTests :: [(Args, (String, [(Args -> IO Result, String)]))]
113 , (fast, testPeerMap)
114 , (fast, testContainer)
115 , (fast, testInstance)
118 , (fast, testOpCodes)
122 , (slow, testCluster)
125 -- | Extracts the name of a test group.
126 extractName :: (Args, (String, [(Args -> IO Result, String)])) -> String
127 extractName (_, (name, _)) = name
129 -- | Lowercase a string.
130 lower :: String -> String
133 transformTestOpts :: Args -> Options -> IO Args
134 transformTestOpts args opts = do
135 r <- case optReplay opts of
136 Nothing -> return Nothing
138 let vs = sepSplit ',' str
140 [rng, size] -> return $ Just (read rng, read size)
141 _ -> fail "Invalid state given"
142 return args { chatty = optVerbose opts > 1,
149 let wrap = map (wrapTest errs)
151 (opts, args) <- parseOpts cmd_args "test" options
152 tests <- if null args
154 else let args' = map lower args
155 selected = filter ((`elem` args') . lower .
156 extractName) allTests
159 hPutStrLn stderr $ "No tests matching '"
160 ++ unwords args ++ "', available tests: "
161 ++ intercalate ", " (map extractName allTests)
162 exitWith $ ExitFailure 1
165 let max_count = maximum $ map (\(_, (_, t)) -> length t) tests
166 mapM_ (\(targs, (name, tl)) ->
167 transformTestOpts targs opts >>= \newargs ->
168 runTests name newargs (wrap tl) max_count) tests
169 terr <- readIORef errs
172 hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
173 exitWith $ ExitFailure 1
174 else putStrLn "All tests succeeded."