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