Revision 38f536cb test.hs

b/test.hs
25 25

  
26 26
module Main(main) where
27 27

  
28
import Control.Monad
29
import Data.IORef
28 30
import Test.QuickCheck.Batch
31
import System.IO
32
import System.Exit
33

  
29 34
import Ganeti.HTools.QC
30 35

  
36
options :: TestOptions
31 37
options = TestOptions
32 38
      { no_of_tests         = 500
33 39
      , length_of_tests     = 5
34 40
      , debug_tests         = False }
35 41

  
42

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

  
46
-- | Wrapper over a test runner with error counting
47
wrapTest :: IORef Int
48
         -> (TestOptions -> IO TestResult)
49
         -> TestOptions -> IO TestResult
50
wrapTest ir t to = do
51
    tr <- t to
52
    case tr of
53
      TestFailed _ _ -> incIORef ir
54
      TestAborted _ -> incIORef ir
55
      _ -> return ()
56
    return tr
57

  
58
main :: IO ()
36 59
main = do
37
  runTests "PeerMap" options test_PeerMap
38
  runTests "Container" options test_Container
39
  runTests "Instance" options test_Instance
40
  runTests "Node" options test_Node
41
  runTests "Text" options test_Text
42
  runTests "Cluster" options test_Cluster
60
  errs <- newIORef 0
61
  let wrap lst = map (wrapTest errs) lst
62
  runTests "PeerMap" options $ wrap test_PeerMap
63
  runTests "Container" options $ wrap test_Container
64
  runTests "Instance" options $ wrap test_Instance
65
  runTests "Node" options $ wrap test_Node
66
  runTests "Text" options $ wrap test_Text
67
  runTests "Cluster" options $ wrap test_Cluster
68
  terr <- readIORef errs
69
  (if (terr > 0)
70
   then do
71
     hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
72
     exitWith $ ExitFailure 1
73
   else putStrLn "All tests succeeded.")

Also available in: Unified diff