Statistics
| Branch: | Tag: | Revision:

root / htools / test.hs @ e73c5fe2

History | View | Annotate | Download (5 kB)

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

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2009, 2011 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, testOpCodes)
119
  , (fast, testJobs)
120
  , (fast, testLoader)
121
  , (fast, testTypes)
122
  , (slow, testCluster)
123
  ]
124

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

    
129
-- | Lowercase a string.
130
lower :: String -> String
131
lower = map toLower
132

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

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

    
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
170
  if terr > 0
171
    then do
172
      hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
173
      exitWith $ ExitFailure 1
174
    else putStrLn "All tests succeeded."