Statistics
| Branch: | Tag: | Revision:

root / htools / test.hs @ e73c5fe2

History | View | Annotate | Download (5 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 72bb6b4e Iustin Pop
import Data.Char
29 38f536cb Iustin Pop
import Data.IORef
30 72bb6b4e Iustin Pop
import Data.List
31 23fe06c2 Iustin Pop
import System.Console.GetOpt ()
32 7345b69b Iustin Pop
import System.Environment (getArgs)
33 38f536cb Iustin Pop
import System.Exit
34 7345b69b Iustin Pop
import System.IO
35 7345b69b Iustin Pop
import Test.QuickCheck
36 8e4f6d56 Iustin Pop
import Text.Printf
37 38f536cb Iustin Pop
38 15f4c8ca Iustin Pop
import Ganeti.HTools.QC
39 509809db Iustin Pop
import Ganeti.HTools.CLI
40 509809db Iustin Pop
import Ganeti.HTools.Utils (sepSplit)
41 509809db Iustin Pop
42 179c0828 Iustin Pop
-- | Options list and functions.
43 509809db Iustin Pop
options :: [OptType]
44 509809db Iustin Pop
options =
45 ebf38064 Iustin Pop
  [ oReplay
46 ebf38064 Iustin Pop
  , oVerbose
47 ebf38064 Iustin Pop
  , oShowVer
48 ebf38064 Iustin Pop
  , oShowHelp
49 ebf38064 Iustin Pop
  ]
50 15f4c8ca Iustin Pop
51 8e4f6d56 Iustin Pop
fast :: Args
52 8e4f6d56 Iustin Pop
fast = stdArgs
53 8e4f6d56 Iustin Pop
       { maxSuccess = 500
54 8e4f6d56 Iustin Pop
       , chatty     = False
55 8e4f6d56 Iustin Pop
       }
56 15f4c8ca Iustin Pop
57 8e4f6d56 Iustin Pop
slow :: Args
58 8e4f6d56 Iustin Pop
slow = stdArgs
59 8e4f6d56 Iustin Pop
       { maxSuccess = 50
60 8e4f6d56 Iustin Pop
       , chatty     = False
61 8e4f6d56 Iustin Pop
       }
62 38f536cb Iustin Pop
63 38f536cb Iustin Pop
incIORef :: IORef Int -> IO ()
64 38f536cb Iustin Pop
incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
65 38f536cb Iustin Pop
66 179c0828 Iustin Pop
-- | Wrapper over a test runner with error counting.
67 38f536cb Iustin Pop
wrapTest :: IORef Int
68 23fe06c2 Iustin Pop
         -> (Args -> IO Result, String)
69 8e4f6d56 Iustin Pop
         -> Args
70 23fe06c2 Iustin Pop
         -> IO (Result, Char, String)
71 23fe06c2 Iustin Pop
wrapTest ir (test, desc) opts = do
72 8e4f6d56 Iustin Pop
  r <- test opts
73 8e4f6d56 Iustin Pop
  c <- case r of
74 8e4f6d56 Iustin Pop
         Success {} -> return '.'
75 8e4f6d56 Iustin Pop
         GaveUp  {} -> return '?'
76 8e4f6d56 Iustin Pop
         Failure {} -> incIORef ir >> return '#'
77 8e4f6d56 Iustin Pop
         NoExpectedFailure {} -> incIORef ir >> return '*'
78 23fe06c2 Iustin Pop
  return (r, c, desc)
79 23fe06c2 Iustin Pop
80 23fe06c2 Iustin Pop
runTests :: String
81 23fe06c2 Iustin Pop
         -> Args
82 23fe06c2 Iustin Pop
         -> [Args -> IO (Result, Char, String)]
83 23fe06c2 Iustin Pop
         -> Int
84 23fe06c2 Iustin Pop
         -> IO [(Result, String)]
85 8e4f6d56 Iustin Pop
86 8e4f6d56 Iustin Pop
runTests name opts tests max_count = do
87 8e4f6d56 Iustin Pop
  _ <- printf "%25s : " name
88 8e4f6d56 Iustin Pop
  hFlush stdout
89 8e4f6d56 Iustin Pop
  results <- mapM (\t -> do
90 23fe06c2 Iustin Pop
                     (r, c, desc) <- t opts
91 8e4f6d56 Iustin Pop
                     putChar c
92 8e4f6d56 Iustin Pop
                     hFlush stdout
93 23fe06c2 Iustin Pop
                     return (r, desc)
94 8e4f6d56 Iustin Pop
                  ) tests
95 23fe06c2 Iustin Pop
  let alldone = sum . map (numTests . fst) $ results
96 8e4f6d56 Iustin Pop
  _ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone
97 23fe06c2 Iustin Pop
  mapM_ (\(r, desc) ->
98 8e4f6d56 Iustin Pop
             case r of
99 8e4f6d56 Iustin Pop
               Failure { output = o, usedSeed = u, usedSize = size } ->
100 23fe06c2 Iustin Pop
                   printf "Test %s failed (seed was %s, test size %d): %s\n"
101 23fe06c2 Iustin Pop
                          desc (show u) size o
102 8e4f6d56 Iustin Pop
               GaveUp { numTests = passed } ->
103 23fe06c2 Iustin Pop
                   printf "Test %s incomplete: gave up with only %d\
104 8e4f6d56 Iustin Pop
                          \ passes after discarding %d tests\n"
105 23fe06c2 Iustin Pop
                          desc passed (maxDiscard opts)
106 8e4f6d56 Iustin Pop
               _ -> return ()
107 23fe06c2 Iustin Pop
        ) results
108 8e4f6d56 Iustin Pop
  return results
109 8e4f6d56 Iustin Pop
110 23fe06c2 Iustin Pop
allTests :: [(Args, (String, [(Args -> IO Result, String)]))]
111 06fe0cea Iustin Pop
allTests =
112 23fe06c2 Iustin Pop
  [ (fast, testUtils)
113 23fe06c2 Iustin Pop
  , (fast, testPeerMap)
114 23fe06c2 Iustin Pop
  , (fast, testContainer)
115 23fe06c2 Iustin Pop
  , (fast, testInstance)
116 23fe06c2 Iustin Pop
  , (fast, testNode)
117 23fe06c2 Iustin Pop
  , (fast, testText)
118 23fe06c2 Iustin Pop
  , (fast, testOpCodes)
119 23fe06c2 Iustin Pop
  , (fast, testJobs)
120 23fe06c2 Iustin Pop
  , (fast, testLoader)
121 23fe06c2 Iustin Pop
  , (fast, testTypes)
122 23fe06c2 Iustin Pop
  , (slow, testCluster)
123 06fe0cea Iustin Pop
  ]
124 06fe0cea Iustin Pop
125 72bb6b4e Iustin Pop
-- | Extracts the name of a test group.
126 72bb6b4e Iustin Pop
extractName :: (Args, (String, [(Args -> IO Result, String)])) -> String
127 72bb6b4e Iustin Pop
extractName (_, (name, _)) = name
128 72bb6b4e Iustin Pop
129 72bb6b4e Iustin Pop
-- | Lowercase a string.
130 72bb6b4e Iustin Pop
lower :: String -> String
131 72bb6b4e Iustin Pop
lower = map toLower
132 72bb6b4e Iustin Pop
133 509809db Iustin Pop
transformTestOpts :: Args -> Options -> IO Args
134 509809db Iustin Pop
transformTestOpts args opts = do
135 509809db Iustin Pop
  r <- case optReplay opts of
136 509809db Iustin Pop
         Nothing -> return Nothing
137 509809db Iustin Pop
         Just str -> do
138 509809db Iustin Pop
           let vs = sepSplit ',' str
139 3603605a Iustin Pop
           case vs of
140 3603605a Iustin Pop
             [rng, size] -> return $ Just (read rng, read size)
141 3603605a Iustin Pop
             _ -> fail "Invalid state given"
142 509809db Iustin Pop
  return args { chatty = optVerbose opts > 1,
143 509809db Iustin Pop
                replay = r
144 509809db Iustin Pop
              }
145 509809db Iustin Pop
146 38f536cb Iustin Pop
main :: IO ()
147 15f4c8ca Iustin Pop
main = do
148 38f536cb Iustin Pop
  errs <- newIORef 0
149 3a3c1eb4 Iustin Pop
  let wrap = map (wrapTest errs)
150 7345b69b Iustin Pop
  cmd_args <- getArgs
151 509809db Iustin Pop
  (opts, args) <- parseOpts cmd_args "test" options
152 3603605a Iustin Pop
  tests <- if null args
153 3603605a Iustin Pop
             then return allTests
154 3603605a Iustin Pop
             else let args' = map lower args
155 3603605a Iustin Pop
                      selected = filter ((`elem` args') . lower .
156 3603605a Iustin Pop
                                         extractName) allTests
157 3603605a Iustin Pop
                  in if null selected
158 3603605a Iustin Pop
                       then do
159 3603605a Iustin Pop
                         hPutStrLn stderr $ "No tests matching '"
160 3603605a Iustin Pop
                            ++ unwords args ++ "', available tests: "
161 3603605a Iustin Pop
                            ++ intercalate ", " (map extractName allTests)
162 3603605a Iustin Pop
                         exitWith $ ExitFailure 1
163 3603605a Iustin Pop
                       else return selected
164 72bb6b4e Iustin Pop
165 72bb6b4e Iustin Pop
  let max_count = maximum $ map (\(_, (_, t)) -> length t) tests
166 23fe06c2 Iustin Pop
  mapM_ (\(targs, (name, tl)) ->
167 ebf38064 Iustin Pop
           transformTestOpts targs opts >>= \newargs ->
168 ebf38064 Iustin Pop
           runTests name newargs (wrap tl) max_count) tests
169 38f536cb Iustin Pop
  terr <- readIORef errs
170 3603605a Iustin Pop
  if terr > 0
171 3603605a Iustin Pop
    then do
172 3603605a Iustin Pop
      hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
173 3603605a Iustin Pop
      exitWith $ ExitFailure 1
174 3603605a Iustin Pop
    else putStrLn "All tests succeeded."