Statistics
| Branch: | Tag: | Revision:

root / htools / test.hs @ 63a78055

History | View | Annotate | Download (4.2 kB)

1 525bfb36 Iustin Pop
{-| Unittest runner for ganeti-htools.
2 15f4c8ca Iustin Pop
3 15f4c8ca Iustin Pop
-}
4 15f4c8ca Iustin Pop
5 e2fa2baf Iustin Pop
{-
6 e2fa2baf Iustin Pop
7 8e4f6d56 Iustin Pop
Copyright (C) 2009, 2011 Google Inc.
8 e2fa2baf Iustin Pop
9 e2fa2baf Iustin Pop
This program is free software; you can redistribute it and/or modify
10 e2fa2baf Iustin Pop
it under the terms of the GNU General Public License as published by
11 e2fa2baf Iustin Pop
the Free Software Foundation; either version 2 of the License, or
12 e2fa2baf Iustin Pop
(at your option) any later version.
13 e2fa2baf Iustin Pop
14 e2fa2baf Iustin Pop
This program is distributed in the hope that it will be useful, but
15 e2fa2baf Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
16 e2fa2baf Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 e2fa2baf Iustin Pop
General Public License for more details.
18 e2fa2baf Iustin Pop
19 e2fa2baf Iustin Pop
You should have received a copy of the GNU General Public License
20 e2fa2baf Iustin Pop
along with this program; if not, write to the Free Software
21 e2fa2baf Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22 e2fa2baf Iustin Pop
02110-1301, USA.
23 e2fa2baf Iustin Pop
24 e2fa2baf Iustin Pop
-}
25 e2fa2baf Iustin Pop
26 15f4c8ca Iustin Pop
module Main(main) where
27 15f4c8ca Iustin Pop
28 38f536cb Iustin Pop
import Data.IORef
29 8e4f6d56 Iustin Pop
import Test.QuickCheck
30 509809db Iustin Pop
import System.Console.GetOpt
31 38f536cb Iustin Pop
import System.IO
32 38f536cb Iustin Pop
import System.Exit
33 06fe0cea Iustin Pop
import System (getArgs)
34 8e4f6d56 Iustin Pop
import Text.Printf
35 38f536cb Iustin Pop
36 15f4c8ca Iustin Pop
import Ganeti.HTools.QC
37 509809db Iustin Pop
import Ganeti.HTools.CLI
38 509809db Iustin Pop
import Ganeti.HTools.Utils (sepSplit)
39 509809db Iustin Pop
40 509809db Iustin Pop
-- | Options list and functions
41 509809db Iustin Pop
options :: [OptType]
42 509809db Iustin Pop
options =
43 509809db Iustin Pop
    [ oReplay
44 509809db Iustin Pop
    , oVerbose
45 509809db Iustin Pop
    , oShowVer
46 509809db Iustin Pop
    , oShowHelp
47 509809db Iustin Pop
    ]
48 15f4c8ca Iustin Pop
49 8e4f6d56 Iustin Pop
fast :: Args
50 8e4f6d56 Iustin Pop
fast = stdArgs
51 8e4f6d56 Iustin Pop
       { maxSuccess = 500
52 8e4f6d56 Iustin Pop
       , chatty     = False
53 8e4f6d56 Iustin Pop
       }
54 15f4c8ca Iustin Pop
55 8e4f6d56 Iustin Pop
slow :: Args
56 8e4f6d56 Iustin Pop
slow = stdArgs
57 8e4f6d56 Iustin Pop
       { maxSuccess = 50
58 8e4f6d56 Iustin Pop
       , chatty     = False
59 8e4f6d56 Iustin Pop
       }
60 38f536cb Iustin Pop
61 38f536cb Iustin Pop
incIORef :: IORef Int -> IO ()
62 38f536cb Iustin Pop
incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
63 38f536cb Iustin Pop
64 38f536cb Iustin Pop
-- | Wrapper over a test runner with error counting
65 38f536cb Iustin Pop
wrapTest :: IORef Int
66 8e4f6d56 Iustin Pop
         -> (Args -> IO Result)
67 8e4f6d56 Iustin Pop
         -> Args
68 8e4f6d56 Iustin Pop
         -> IO (Result, Char)
69 8e4f6d56 Iustin Pop
wrapTest ir test opts = do
70 8e4f6d56 Iustin Pop
  r <- test opts
71 8e4f6d56 Iustin Pop
  c <- case r of
72 8e4f6d56 Iustin Pop
         Success {} -> return '.'
73 8e4f6d56 Iustin Pop
         GaveUp  {} -> return '?'
74 8e4f6d56 Iustin Pop
         Failure {} -> incIORef ir >> return '#'
75 8e4f6d56 Iustin Pop
         NoExpectedFailure {} -> incIORef ir >> return '*'
76 8e4f6d56 Iustin Pop
  return (r, c)
77 8e4f6d56 Iustin Pop
78 8e4f6d56 Iustin Pop
runTests name opts tests max_count = do
79 8e4f6d56 Iustin Pop
  _ <- printf "%25s : " name
80 8e4f6d56 Iustin Pop
  hFlush stdout
81 8e4f6d56 Iustin Pop
  results <- mapM (\t -> do
82 8e4f6d56 Iustin Pop
                     (r, c) <- t opts
83 8e4f6d56 Iustin Pop
                     putChar c
84 8e4f6d56 Iustin Pop
                     hFlush stdout
85 8e4f6d56 Iustin Pop
                     return r
86 8e4f6d56 Iustin Pop
                  ) tests
87 8e4f6d56 Iustin Pop
  let alldone = sum . map numTests $ results
88 8e4f6d56 Iustin Pop
  _ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone
89 8e4f6d56 Iustin Pop
  mapM_ (\(idx, r) ->
90 8e4f6d56 Iustin Pop
             case r of
91 8e4f6d56 Iustin Pop
               Failure { output = o, usedSeed = u, usedSize = size } ->
92 8e4f6d56 Iustin Pop
                   printf "Test %d failed (seed was %s, test size %d): %s\n"
93 8e4f6d56 Iustin Pop
                          idx (show u) size o
94 8e4f6d56 Iustin Pop
               GaveUp { numTests = passed } ->
95 8e4f6d56 Iustin Pop
                   printf "Test %d incomplete: gave up with only %d\
96 8e4f6d56 Iustin Pop
                          \ passes after discarding %d tests\n"
97 8e4f6d56 Iustin Pop
                          idx passed (maxDiscard opts)
98 8e4f6d56 Iustin Pop
               _ -> return ()
99 8e4f6d56 Iustin Pop
        ) $ zip ([1..]::[Int]) results
100 8e4f6d56 Iustin Pop
  return results
101 8e4f6d56 Iustin Pop
102 8e4f6d56 Iustin Pop
allTests :: [(String, Args, [Args -> IO Result])]
103 06fe0cea Iustin Pop
allTests =
104 691dcd2a Iustin Pop
  [ ("Utils", fast, testUtils)
105 691dcd2a Iustin Pop
  , ("PeerMap", fast, testPeerMap)
106 06fe0cea Iustin Pop
  , ("Container", fast, testContainer)
107 06fe0cea Iustin Pop
  , ("Instance", fast, testInstance)
108 06fe0cea Iustin Pop
  , ("Node", fast, testNode)
109 06fe0cea Iustin Pop
  , ("Text", fast, testText)
110 06fe0cea Iustin Pop
  , ("OpCodes", fast, testOpCodes)
111 db079755 Iustin Pop
  , ("Jobs", fast, testJobs)
112 c088674b Iustin Pop
  , ("Loader", fast, testLoader)
113 3c002a13 Iustin Pop
  , ("Types", fast, testTypes)
114 06fe0cea Iustin Pop
  , ("Cluster", slow, testCluster)
115 06fe0cea Iustin Pop
  ]
116 06fe0cea Iustin Pop
117 509809db Iustin Pop
transformTestOpts :: Args -> Options -> IO Args
118 509809db Iustin Pop
transformTestOpts args opts = do
119 509809db Iustin Pop
  r <- case optReplay opts of
120 509809db Iustin Pop
         Nothing -> return Nothing
121 509809db Iustin Pop
         Just str -> do
122 509809db Iustin Pop
           let vs = sepSplit ',' str
123 509809db Iustin Pop
           (case vs of
124 509809db Iustin Pop
              [rng, size] -> return $ Just (read rng, read size)
125 509809db Iustin Pop
              _ -> fail "Invalid state given")
126 509809db Iustin Pop
  return args { chatty = optVerbose opts > 1,
127 509809db Iustin Pop
                replay = r
128 509809db Iustin Pop
              }
129 509809db Iustin Pop
130 38f536cb Iustin Pop
main :: IO ()
131 15f4c8ca Iustin Pop
main = do
132 38f536cb Iustin Pop
  errs <- newIORef 0
133 3a3c1eb4 Iustin Pop
  let wrap = map (wrapTest errs)
134 509809db Iustin Pop
  cmd_args <- System.getArgs
135 509809db Iustin Pop
  (opts, args) <- parseOpts cmd_args "test" options
136 06fe0cea Iustin Pop
  let tests = if null args
137 06fe0cea Iustin Pop
              then allTests
138 06fe0cea Iustin Pop
              else filter (\(name, _, _) -> name `elem` args) allTests
139 8e4f6d56 Iustin Pop
      max_count = maximum $ map (\(_, _, t) -> length t) tests
140 509809db Iustin Pop
  mapM_ (\(name, targs, tl) ->
141 509809db Iustin Pop
             transformTestOpts targs opts >>= \newargs ->
142 509809db Iustin Pop
             runTests name newargs (wrap tl) max_count) tests
143 38f536cb Iustin Pop
  terr <- readIORef errs
144 3a3c1eb4 Iustin Pop
  (if terr > 0
145 38f536cb Iustin Pop
   then do
146 38f536cb Iustin Pop
     hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
147 38f536cb Iustin Pop
     exitWith $ ExitFailure 1
148 38f536cb Iustin Pop
   else putStrLn "All tests succeeded.")