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.IORef
  29 import Test.QuickCheck
  30 import System.Console.GetOpt
  31 import System.IO
  32 import System.Exit
  33 import System (getArgs)
  34 import Text.Printf
  35
  36 import Ganeti.HTools.QC
  37 import Ganeti.HTools.CLI
  38 import Ganeti.HTools.Utils (sepSplit)
  39
  40 -- | Options list and functions.
  41 options :: [OptType]
  42 options =
  43     [ oReplay
  44     , oVerbose
  45     , oShowVer
  46     , oShowHelp
  47     ]
  48
  49 fast :: Args
  50 fast = stdArgs
  51        { maxSuccess = 500
  52        , chatty     = False
  53        }
  54
  55 slow :: Args
  56 slow = stdArgs
  57        { maxSuccess = 50
  58        , chatty     = False
  59        }
  60
  61 incIORef :: IORef Int -> IO ()
  62 incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
  63
  64 -- | Wrapper over a test runner with error counting.
  65 wrapTest :: IORef Int
  66          -> (Args -> IO Result)
  67          -> Args
  68          -> IO (Result, Char)
  69 wrapTest ir test opts = do
  70   r <- test opts
  71   c <- case r of
  72          Success {} -> return '.'
  73          GaveUp  {} -> return '?'
  74          Failure {} -> incIORef ir >> return '#'
  75          NoExpectedFailure {} -> incIORef ir >> return '*'
  76   return (r, c)
  77
  78 runTests name opts tests max_count = do
  79   _ <- printf "%25s : " name
  80   hFlush stdout
  81   results <- mapM (\t -> do
  82                      (r, c) <- t opts
  83                      putChar c
  84                      hFlush stdout
  85                      return r
  86                   ) tests
  87   let alldone = sum . map numTests $ results
  88   _ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone
  89   mapM_ (\(idx, r) ->
  90              case r of
  91                Failure { output = o, usedSeed = u, usedSize = size } ->
  92                    printf "Test %d failed (seed was %s, test size %d): %s\n"
  93                           idx (show u) size o
  94                GaveUp { numTests = passed } ->
  95                    printf "Test %d incomplete: gave up with only %d\
  96                           \ passes after discarding %d tests\n"
  97                           idx passed (maxDiscard opts)
  98                _ -> return ()
  99         ) $ zip ([1..]::[Int]) results
 100   return results
 101
 102 allTests :: [(String, Args, [Args -> IO Result])]
 103 allTests =
 104   [ ("Utils", fast, testUtils)
 105   , ("PeerMap", fast, testPeerMap)
 106   , ("Container", fast, testContainer)
 107   , ("Instance", fast, testInstance)
 108   , ("Node", fast, testNode)
 109   , ("Text", fast, testText)
 110   , ("OpCodes", fast, testOpCodes)
 111   , ("Jobs", fast, testJobs)
 112   , ("Loader", fast, testLoader)
 113   , ("Types", fast, testTypes)
 114   , ("Cluster", slow, testCluster)
 115   ]
 116
 117 transformTestOpts :: Args -> Options -> IO Args
 118 transformTestOpts args opts = do
 119   r <- case optReplay opts of
 120          Nothing -> return Nothing
 121          Just str -> do
 122            let vs = sepSplit ',' str
 123            (case vs of
 124               [rng, size] -> return $ Just (read rng, read size)
 125               _ -> fail "Invalid state given")
 126   return args { chatty = optVerbose opts > 1,
 127                 replay = r
 128               }
 129
 130 main :: IO ()
 131 main = do
 132   errs <- newIORef 0
 133   let wrap = map (wrapTest errs)
 134   cmd_args <- System.getArgs
 135   (opts, args) <- parseOpts cmd_args "test" options
 136   let tests = if null args
 137               then allTests
 138               else filter (\(name, _, _) -> name `elem` args) allTests
 139       max_count = maximum $ map (\(_, _, t) -> length t) tests
 140   mapM_ (\(name, targs, tl) ->
 141              transformTestOpts targs opts >>= \newargs ->
 142              runTests name newargs (wrap tl) max_count) tests
 143   terr <- readIORef errs
 144   (if terr > 0
 145    then do
 146      hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
 147      exitWith $ ExitFailure 1
 148    else putStrLn "All tests succeeded.")