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