code.grnet.gr Git - ganeti-local/blob - htools/test.hs

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