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   , ("Cluster", slow, testCluster)
 114   ]
 115
 116 transformTestOpts :: Args -> Options -> IO Args
 117 transformTestOpts args opts = do
 118   r <- case optReplay opts of
 119          Nothing -> return Nothing
 120          Just str -> do
 121            let vs = sepSplit ',' str
 122            (case vs of
 123               [rng, size] -> return $ Just (read rng, read size)
 124               _ -> fail "Invalid state given")
 125   return args { chatty = optVerbose opts > 1,
 126                 replay = r
 127               }
 128
 129 main :: IO ()
 130 main = do
 131   errs <- newIORef 0
 132   let wrap = map (wrapTest errs)
 133   cmd_args <- System.getArgs
 134   (opts, args) <- parseOpts cmd_args "test" options
 135   let tests = if null args
 136               then allTests
 137               else filter (\(name, _, _) -> name `elem` args) allTests
 138       max_count = maximum $ map (\(_, _, t) -> length t) tests
 139   mapM_ (\(name, targs, tl) ->
 140              transformTestOpts targs opts >>= \newargs ->
 141              runTests name newargs (wrap tl) max_count) tests
 142   terr <- readIORef errs
 143   (if terr > 0
 144    then do
 145      hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
 146      exitWith $ ExitFailure 1
 147    else putStrLn "All tests succeeded.")