Revision 8e4f6d56 htools/test.hs
b/htools/test.hs | ||
---|---|---|
4 | 4 |
|
5 | 5 |
{- |
6 | 6 |
|
7 |
Copyright (C) 2009 Google Inc. |
|
7 |
Copyright (C) 2009, 2011 Google Inc.
|
|
8 | 8 |
|
9 | 9 |
This program is free software; you can redistribute it and/or modify |
10 | 10 |
it under the terms of the GNU General Public License as published by |
... | ... | |
26 | 26 |
module Main(main) where |
27 | 27 |
|
28 | 28 |
import Data.IORef |
29 |
import Test.QuickCheck.Batch
|
|
29 |
import Test.QuickCheck |
|
30 | 30 |
import System.IO |
31 | 31 |
import System.Exit |
32 | 32 |
import System (getArgs) |
33 |
import Text.Printf |
|
33 | 34 |
|
34 | 35 |
import Ganeti.HTools.QC |
35 | 36 |
|
36 |
fast :: TestOptions
|
|
37 |
fast = TestOptions
|
|
38 |
{ no_of_tests = 500
|
|
39 |
, length_of_tests = 10
|
|
40 |
, debug_tests = False }
|
|
37 |
fast :: Args
|
|
38 |
fast = stdArgs
|
|
39 |
{ maxSuccess = 500
|
|
40 |
, chatty = False
|
|
41 |
} |
|
41 | 42 |
|
42 |
slow :: TestOptions
|
|
43 |
slow = TestOptions
|
|
44 |
{ no_of_tests = 50
|
|
45 |
, length_of_tests = 100
|
|
46 |
, debug_tests = False }
|
|
43 |
slow :: Args
|
|
44 |
slow = stdArgs
|
|
45 |
{ maxSuccess = 50
|
|
46 |
, chatty = False
|
|
47 |
} |
|
47 | 48 |
|
48 | 49 |
incIORef :: IORef Int -> IO () |
49 | 50 |
incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ())) |
50 | 51 |
|
51 | 52 |
-- | Wrapper over a test runner with error counting |
52 | 53 |
wrapTest :: IORef Int |
53 |
-> (TestOptions -> IO TestResult) |
|
54 |
-> TestOptions -> IO TestResult |
|
55 |
wrapTest ir t to = do |
|
56 |
tr <- t to |
|
57 |
case tr of |
|
58 |
TestFailed _ _ -> incIORef ir |
|
59 |
TestAborted e -> do |
|
60 |
incIORef ir |
|
61 |
putStrLn ("Failure during test: <" ++ show e ++ ">") |
|
62 |
_ -> return () |
|
63 |
return tr |
|
64 |
|
|
65 |
allTests :: [(String, TestOptions, [TestOptions -> IO TestResult])] |
|
54 |
-> (Args -> IO Result) |
|
55 |
-> Args |
|
56 |
-> IO (Result, Char) |
|
57 |
wrapTest ir test opts = do |
|
58 |
r <- test opts |
|
59 |
c <- case r of |
|
60 |
Success {} -> return '.' |
|
61 |
GaveUp {} -> return '?' |
|
62 |
Failure {} -> incIORef ir >> return '#' |
|
63 |
NoExpectedFailure {} -> incIORef ir >> return '*' |
|
64 |
return (r, c) |
|
65 |
|
|
66 |
runTests name opts tests max_count = do |
|
67 |
_ <- printf "%25s : " name |
|
68 |
hFlush stdout |
|
69 |
results <- mapM (\t -> do |
|
70 |
(r, c) <- t opts |
|
71 |
putChar c |
|
72 |
hFlush stdout |
|
73 |
return r |
|
74 |
) tests |
|
75 |
let alldone = sum . map numTests $ results |
|
76 |
_ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone |
|
77 |
mapM_ (\(idx, r) -> |
|
78 |
case r of |
|
79 |
Failure { output = o, usedSeed = u, usedSize = size } -> |
|
80 |
printf "Test %d failed (seed was %s, test size %d): %s\n" |
|
81 |
idx (show u) size o |
|
82 |
GaveUp { numTests = passed } -> |
|
83 |
printf "Test %d incomplete: gave up with only %d\ |
|
84 |
\ passes after discarding %d tests\n" |
|
85 |
idx passed (maxDiscard opts) |
|
86 |
_ -> return () |
|
87 |
) $ zip ([1..]::[Int]) results |
|
88 |
return results |
|
89 |
|
|
90 |
allTests :: [(String, Args, [Args -> IO Result])] |
|
66 | 91 |
allTests = |
67 | 92 |
[ ("Utils", fast, testUtils) |
68 | 93 |
, ("PeerMap", fast, testPeerMap) |
... | ... | |
84 | 109 |
let tests = if null args |
85 | 110 |
then allTests |
86 | 111 |
else filter (\(name, _, _) -> name `elem` args) allTests |
87 |
mapM_ (\(name, opts, tl) -> runTests name opts (wrap tl)) tests |
|
112 |
max_count = maximum $ map (\(_, _, t) -> length t) tests |
|
113 |
mapM_ (\(name, opts, tl) -> runTests name opts (wrap tl) max_count) tests |
|
88 | 114 |
terr <- readIORef errs |
89 | 115 |
(if terr > 0 |
90 | 116 |
then do |
Also available in: Unified diff