Statistics
| Branch: | Tag: | Revision:

root / htools / test.hs @ 509809db

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
  , ("Cluster", slow, testCluster)
114
  ]
115

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

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