Statistics
| Branch: | Tag: | Revision:

root / htools / test.hs @ 23fe06c2

History | View | Annotate | Download (4.3 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.IORef
29
import Test.QuickCheck
30
import System.Console.GetOpt ()
31
import System.IO
32
import System.Exit
33
import System (getArgs)
34
import Text.Printf
35

    
36
import Ganeti.HTools.QC
37
import Ganeti.HTools.CLI
38
import Ganeti.HTools.Utils (sepSplit)
39

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

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

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

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

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

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

    
84
runTests name opts tests max_count = do
85
  _ <- printf "%25s : " name
86
  hFlush stdout
87
  results <- mapM (\t -> do
88
                     (r, c, desc) <- t opts
89
                     putChar c
90
                     hFlush stdout
91
                     return (r, desc)
92
                  ) tests
93
  let alldone = sum . map (numTests . fst) $ results
94
  _ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone
95
  mapM_ (\(r, desc) ->
96
             case r of
97
               Failure { output = o, usedSeed = u, usedSize = size } ->
98
                   printf "Test %s failed (seed was %s, test size %d): %s\n"
99
                          desc (show u) size o
100
               GaveUp { numTests = passed } ->
101
                   printf "Test %s incomplete: gave up with only %d\
102
                          \ passes after discarding %d tests\n"
103
                          desc passed (maxDiscard opts)
104
               _ -> return ()
105
        ) results
106
  return results
107

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

    
123
transformTestOpts :: Args -> Options -> IO Args
124
transformTestOpts args opts = do
125
  r <- case optReplay opts of
126
         Nothing -> return Nothing
127
         Just str -> do
128
           let vs = sepSplit ',' str
129
           (case vs of
130
              [rng, size] -> return $ Just (read rng, read size)
131
              _ -> fail "Invalid state given")
132
  return args { chatty = optVerbose opts > 1,
133
                replay = r
134
              }
135

    
136
main :: IO ()
137
main = do
138
  errs <- newIORef 0
139
  let wrap = map (wrapTest errs)
140
  cmd_args <- System.getArgs
141
  (opts, args) <- parseOpts cmd_args "test" options
142
  let tests = if null args
143
              then allTests
144
              else filter (\(_, (name, _)) -> name `elem` args) allTests
145
      max_count = maximum $ map (\(_, (_, t)) -> length t) tests
146
  mapM_ (\(targs, (name, tl)) ->
147
             transformTestOpts targs opts >>= \newargs ->
148
             runTests name newargs (wrap tl) max_count) tests
149
  terr <- readIORef errs
150
  (if terr > 0
151
   then do
152
     hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
153
     exitWith $ ExitFailure 1
154
   else putStrLn "All tests succeeded.")