Statistics
| Branch: | Tag: | Revision:

root / htools / test.hs @ 63a78055

History | View | Annotate | Download (4.2 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)
67
         -> Args
68
         -> IO (Result, Char)
69
wrapTest ir test 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)
77

    
78
runTests name opts tests max_count = do
79
  _ <- printf "%25s : " name
80
  hFlush stdout
81
  results <- mapM (\t -> do
82
                     (r, c) <- t opts
83
                     putChar c
84
                     hFlush stdout
85
                     return r
86
                  ) tests
87
  let alldone = sum . map numTests $ results
88
  _ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone
89
  mapM_ (\(idx, r) ->
90
             case r of
91
               Failure { output = o, usedSeed = u, usedSize = size } ->
92
                   printf "Test %d failed (seed was %s, test size %d): %s\n"
93
                          idx (show u) size o
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)
98
               _ -> return ()
99
        ) $ zip ([1..]::[Int]) results
100
  return results
101

    
102
allTests :: [(String, Args, [Args -> IO Result])]
103
allTests =
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)
115
  ]
116

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

    
130
main :: IO ()
131
main = do
132
  errs <- newIORef 0
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
137
              then allTests
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
144
  (if terr > 0
145
   then do
146
     hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
147
     exitWith $ ExitFailure 1
148
   else putStrLn "All tests succeeded.")