Statistics
| Branch: | Tag: | Revision:

root / htools / test.hs @ aa3adf35

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