test.hs 2.41 KB
Newer Older
1
{-| Unittest runner for ganeti-htools
2
3
4

-}

Iustin Pop's avatar
Iustin Pop committed
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
{-

Copyright (C) 2009 Google Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

26
27
module Main(main) where

28
import Data.IORef
29
import Test.QuickCheck.Batch
30
31
import System.IO
import System.Exit
Iustin Pop's avatar
Iustin Pop committed
32
import System (getArgs)
33

34
35
import Ganeti.HTools.QC

Iustin Pop's avatar
Iustin Pop committed
36
37
fast :: TestOptions
fast = TestOptions
38
39
40
              { no_of_tests         = 500
              , length_of_tests     = 10
              , debug_tests         = False }
41

Iustin Pop's avatar
Iustin Pop committed
42
43
slow :: TestOptions
slow = TestOptions
44
45
46
              { no_of_tests         = 50
              , length_of_tests     = 100
              , debug_tests         = False }
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62

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

-- | Wrapper over a test runner with error counting
wrapTest :: IORef Int
         -> (TestOptions -> IO TestResult)
         -> TestOptions -> IO TestResult
wrapTest ir t to = do
    tr <- t to
    case tr of
      TestFailed _ _ -> incIORef ir
      TestAborted _ -> incIORef ir
      _ -> return ()
    return tr

Iustin Pop's avatar
Iustin Pop committed
63
64
65
66
67
68
69
70
71
72
73
allTests :: [(String, TestOptions, [TestOptions -> IO TestResult])]
allTests =
  [ ("PeerMap", fast, testPeerMap)
  , ("Container", fast, testContainer)
  , ("Instance", fast, testInstance)
  , ("Node", fast, testNode)
  , ("Text", fast, testText)
  , ("OpCodes", fast, testOpCodes)
  , ("Cluster", slow, testCluster)
  ]

74
main :: IO ()
75
main = do
76
  errs <- newIORef 0
Iustin Pop's avatar
Iustin Pop committed
77
  let wrap = map (wrapTest errs)
Iustin Pop's avatar
Iustin Pop committed
78
79
80
81
82
  args <- getArgs
  let tests = if null args
              then allTests
              else filter (\(name, _, _) -> name `elem` args) allTests
  mapM_ (\(name, opts, tl) -> runTests name opts (wrap tl)) tests
83
  terr <- readIORef errs
Iustin Pop's avatar
Iustin Pop committed
84
  (if terr > 0
85
86
87
88
   then do
     hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
     exitWith $ ExitFailure 1
   else putStrLn "All tests succeeded.")