Statistics
| Branch: | Tag: | Revision:

root / htools / test.hs @ 9f13be88

History | View | Annotate | Download (5.1 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 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 e1dde6ad Iustin Pop
  , (fast, testSimu)
119 23fe06c2 Iustin Pop
  , (fast, testOpCodes)
120 23fe06c2 Iustin Pop
  , (fast, testJobs)
121 23fe06c2 Iustin Pop
  , (fast, testLoader)
122 23fe06c2 Iustin Pop
  , (fast, testTypes)
123 8b5a517a Iustin Pop
  , (fast, testCLI)
124 23fe06c2 Iustin Pop
  , (slow, testCluster)
125 06fe0cea Iustin Pop
  ]
126 06fe0cea Iustin Pop
127 72bb6b4e Iustin Pop
-- | Extracts the name of a test group.
128 72bb6b4e Iustin Pop
extractName :: (Args, (String, [(Args -> IO Result, String)])) -> String
129 72bb6b4e Iustin Pop
extractName (_, (name, _)) = name
130 72bb6b4e Iustin Pop
131 72bb6b4e Iustin Pop
-- | Lowercase a string.
132 72bb6b4e Iustin Pop
lower :: String -> String
133 72bb6b4e Iustin Pop
lower = map toLower
134 72bb6b4e Iustin Pop
135 509809db Iustin Pop
transformTestOpts :: Args -> Options -> IO Args
136 509809db Iustin Pop
transformTestOpts args opts = do
137 509809db Iustin Pop
  r <- case optReplay opts of
138 509809db Iustin Pop
         Nothing -> return Nothing
139 509809db Iustin Pop
         Just str -> do
140 509809db Iustin Pop
           let vs = sepSplit ',' str
141 3603605a Iustin Pop
           case vs of
142 3603605a Iustin Pop
             [rng, size] -> return $ Just (read rng, read size)
143 3603605a Iustin Pop
             _ -> fail "Invalid state given"
144 509809db Iustin Pop
  return args { chatty = optVerbose opts > 1,
145 509809db Iustin Pop
                replay = r
146 509809db Iustin Pop
              }
147 509809db Iustin Pop
148 38f536cb Iustin Pop
main :: IO ()
149 15f4c8ca Iustin Pop
main = do
150 38f536cb Iustin Pop
  errs <- newIORef 0
151 3a3c1eb4 Iustin Pop
  let wrap = map (wrapTest errs)
152 7345b69b Iustin Pop
  cmd_args <- getArgs
153 509809db Iustin Pop
  (opts, args) <- parseOpts cmd_args "test" options
154 3603605a Iustin Pop
  tests <- if null args
155 3603605a Iustin Pop
             then return allTests
156 3603605a Iustin Pop
             else let args' = map lower args
157 3603605a Iustin Pop
                      selected = filter ((`elem` args') . lower .
158 3603605a Iustin Pop
                                         extractName) allTests
159 3603605a Iustin Pop
                  in if null selected
160 3603605a Iustin Pop
                       then do
161 3603605a Iustin Pop
                         hPutStrLn stderr $ "No tests matching '"
162 3603605a Iustin Pop
                            ++ unwords args ++ "', available tests: "
163 3603605a Iustin Pop
                            ++ intercalate ", " (map extractName allTests)
164 3603605a Iustin Pop
                         exitWith $ ExitFailure 1
165 3603605a Iustin Pop
                       else return selected
166 72bb6b4e Iustin Pop
167 72bb6b4e Iustin Pop
  let max_count = maximum $ map (\(_, (_, t)) -> length t) tests
168 23fe06c2 Iustin Pop
  mapM_ (\(targs, (name, tl)) ->
169 ebf38064 Iustin Pop
           transformTestOpts targs opts >>= \newargs ->
170 ebf38064 Iustin Pop
           runTests name newargs (wrap tl) max_count) tests
171 38f536cb Iustin Pop
  terr <- readIORef errs
172 3603605a Iustin Pop
  if terr > 0
173 3603605a Iustin Pop
    then do
174 3603605a Iustin Pop
      hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
175 3603605a Iustin Pop
      exitWith $ ExitFailure 1
176 3603605a Iustin Pop
    else putStrLn "All tests succeeded."