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
29 import Test.QuickCheck
30 import System.Console.GetOpt
33 import System (getArgs)
36 import Ganeti.HTools.QC
37 import Ganeti.HTools.CLI
38 import Ganeti.HTools.Utils (sepSplit)
40 -- | Options list and functions.
61 incIORef :: IORef Int -> IO ()
62 incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
64 -- | Wrapper over a test runner with error counting.
66 -> (Args -> IO Result)
69 wrapTest ir test opts = do
72 Success {} -> return '.'
73 GaveUp {} -> return '?'
74 Failure {} -> incIORef ir >> return '#'
75 NoExpectedFailure {} -> incIORef ir >> return '*'
78 runTests name opts tests max_count = do
79 _ <- printf "%25s : " name
81 results <- mapM (\t -> do
87 let alldone = sum . map numTests $ results
88 _ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone
91 Failure { output = o, usedSeed = u, usedSize = size } ->
92 printf "Test %d failed (seed was %s, test size %d): %s\n"
94 GaveUp { numTests = passed } ->
95 printf "Test %d incomplete: gave up with only %d\
96 \ passes after discarding %d tests\n"
97 idx passed (maxDiscard opts)
99 ) $ zip ([1..]::[Int]) results
102 allTests :: [(String, Args, [Args -> IO Result])]
104 [ ("Utils", fast, testUtils)
105 , ("PeerMap", fast, testPeerMap)
106 , ("Container", fast, testContainer)
107 , ("Instance", fast, testInstance)
108 , ("Node", fast, testNode)
109 , ("Text", fast, testText)
110 , ("OpCodes", fast, testOpCodes)
111 , ("Jobs", fast, testJobs)
112 , ("Loader", fast, testLoader)
113 , ("Types", fast, testTypes)
114 , ("Cluster", slow, testCluster)
117 transformTestOpts :: Args -> Options -> IO Args
118 transformTestOpts args opts = do
119 r <- case optReplay opts of
120 Nothing -> return Nothing
122 let vs = sepSplit ',' str
124 [rng, size] -> return $ Just (read rng, read size)
125 _ -> fail "Invalid state given")
126 return args { chatty = optVerbose opts > 1,
133 let wrap = map (wrapTest errs)
134 cmd_args <- System.getArgs
135 (opts, args) <- parseOpts cmd_args "test" options
136 let tests = if null args
138 else filter (\(name, _, _) -> name `elem` args) allTests
139 max_count = maximum $ map (\(_, _, t) -> length t) tests
140 mapM_ (\(name, targs, tl) ->
141 transformTestOpts targs opts >>= \newargs ->
142 runTests name newargs (wrap tl) max_count) tests
143 terr <- readIORef errs
146 hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
147 exitWith $ ExitFailure 1
148 else putStrLn "All tests succeeded.")