Statistics
| Branch: | Tag: | Revision:

root / htools / test.hs @ 89298c04

History | View | Annotate | Download (5.1 kB)

1
{-| Unittest runner for ganeti-htools.
2

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2009, 2011, 2012 Google Inc.
8

    
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.
13

    
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.
18

    
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
22
02110-1301, USA.
23

    
24
-}
25

    
26
module Main(main) where
27

    
28
import Data.Char
29
import Data.IORef
30
import Data.List
31
import System.Console.GetOpt ()
32
import System.Environment (getArgs)
33
import System.Exit
34
import System.IO
35
import Test.QuickCheck
36
import Text.Printf
37

    
38
import Ganeti.HTools.QC
39
import Ganeti.HTools.CLI
40
import Ganeti.HTools.Utils (sepSplit)
41

    
42
-- | Options list and functions.
43
options :: [OptType]
44
options =
45
  [ oReplay
46
  , oVerbose
47
  , oShowVer
48
  , oShowHelp
49
  ]
50

    
51
fast :: Args
52
fast = stdArgs
53
       { maxSuccess = 500
54
       , chatty     = False
55
       }
56

    
57
slow :: Args
58
slow = stdArgs
59
       { maxSuccess = 50
60
       , chatty     = False
61
       }
62

    
63
incIORef :: IORef Int -> IO ()
64
incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
65

    
66
-- | Wrapper over a test runner with error counting.
67
wrapTest :: IORef Int
68
         -> (Args -> IO Result, String)
69
         -> Args
70
         -> IO (Result, Char, String)
71
wrapTest ir (test, desc) opts = do
72
  r <- test opts
73
  c <- case r of
74
         Success {} -> return '.'
75
         GaveUp  {} -> return '?'
76
         Failure {} -> incIORef ir >> return '#'
77
         NoExpectedFailure {} -> incIORef ir >> return '*'
78
  return (r, c, desc)
79

    
80
runTests :: String
81
         -> Args
82
         -> [Args -> IO (Result, Char, String)]
83
         -> Int
84
         -> IO [(Result, String)]
85

    
86
runTests name opts tests max_count = do
87
  _ <- printf "%25s : " name
88
  hFlush stdout
89
  results <- mapM (\t -> do
90
                     (r, c, desc) <- t opts
91
                     putChar c
92
                     hFlush stdout
93
                     return (r, desc)
94
                  ) tests
95
  let alldone = sum . map (numTests . fst) $ results
96
  _ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone
97
  mapM_ (\(r, desc) ->
98
             case r of
99
               Failure { output = o, usedSeed = u, usedSize = size } ->
100
                   printf "Test %s failed (seed was %s, test size %d): %s\n"
101
                          desc (show u) size o
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)
106
               _ -> return ()
107
        ) results
108
  return results
109

    
110
allTests :: [(Args, (String, [(Args -> IO Result, String)]))]
111
allTests =
112
  [ (fast, testUtils)
113
  , (fast, testPeerMap)
114
  , (fast, testContainer)
115
  , (fast, testInstance)
116
  , (fast, testNode)
117
  , (fast, testText)
118
  , (fast, testSimu)
119
  , (fast, testOpCodes)
120
  , (fast, testJobs)
121
  , (fast, testLoader)
122
  , (fast, testTypes)
123
  , (fast, testCLI)
124
  , (slow, testCluster)
125
  ]
126

    
127
-- | Extracts the name of a test group.
128
extractName :: (Args, (String, [(Args -> IO Result, String)])) -> String
129
extractName (_, (name, _)) = name
130

    
131
-- | Lowercase a string.
132
lower :: String -> String
133
lower = map toLower
134

    
135
transformTestOpts :: Args -> Options -> IO Args
136
transformTestOpts args opts = do
137
  r <- case optReplay opts of
138
         Nothing -> return Nothing
139
         Just str -> do
140
           let vs = sepSplit ',' str
141
           case vs of
142
             [rng, size] -> return $ Just (read rng, read size)
143
             _ -> fail "Invalid state given"
144
  return args { chatty = optVerbose opts > 1,
145
                replay = r
146
              }
147

    
148
main :: IO ()
149
main = do
150
  errs <- newIORef 0
151
  let wrap = map (wrapTest errs)
152
  cmd_args <- getArgs
153
  (opts, args) <- parseOpts cmd_args "test" options
154
  tests <- if null args
155
             then return allTests
156
             else let args' = map lower args
157
                      selected = filter ((`elem` args') . lower .
158
                                         extractName) allTests
159
                  in if null selected
160
                       then do
161
                         hPutStrLn stderr $ "No tests matching '"
162
                            ++ unwords args ++ "', available tests: "
163
                            ++ intercalate ", " (map extractName allTests)
164
                         exitWith $ ExitFailure 1
165
                       else return selected
166

    
167
  let max_count = maximum $ map (\(_, (_, t)) -> length t) tests
168
  mapM_ (\(targs, (name, tl)) ->
169
           transformTestOpts targs opts >>= \newargs ->
170
           runTests name newargs (wrap tl) max_count) tests
171
  terr <- readIORef errs
172
  if terr > 0
173
    then do
174
      hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
175
      exitWith $ ExitFailure 1
176
    else putStrLn "All tests succeeded."