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

   1 {-| Unittest runner for ganeti-htools.
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2009, 2011, 2012 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.Monoid (mappend)
  29 import Test.Framework
  30 import System.Environment (getArgs)
  31
  32 import Ganeti.HTools.QC
  33 import Test.Ganeti.Confd.Utils
  34 import Test.Ganeti.Objects
  35
  36 -- | Our default test options, overring the built-in test-framework
  37 -- ones.
  38 fast :: TestOptions
  39 fast = TestOptions
  40        { topt_seed                               = Nothing
  41        , topt_maximum_generated_tests            = Just 500
  42        , topt_maximum_unsuitable_generated_tests = Just 5000
  43        , topt_maximum_test_size                  = Nothing
  44        , topt_maximum_test_depth                 = Nothing
  45        , topt_timeout                            = Nothing
  46        }
  47
  48 -- | Our slow test options.
  49 slow :: TestOptions
  50 slow = fast
  51        { topt_maximum_generated_tests            = Just 50
  52        , topt_maximum_unsuitable_generated_tests = Just 500
  53        }
  54
  55 -- | All our defined tests.
  56 allTests :: [(Bool, (String, [Test]))]
  57 allTests =
  58   [ (True, testUtils)
  59   , (True, testPeerMap)
  60   , (True, testContainer)
  61   , (True, testInstance)
  62   , (True, testNode)
  63   , (True, testText)
  64   , (True, testSimu)
  65   , (True, testOpCodes)
  66   , (True, testJobs)
  67   , (True, testLoader)
  68   , (True, testTypes)
  69   , (True, testCLI)
  70   , (True, testJSON)
  71   , (True, testLuxi)
  72   , (True, testSsconf)
  73   , (True, testQlang)
  74   , (True, testRpc)
  75   , (True, testConfdUtils)
  76   , (True, testObjects)
  77   , (False, testCluster)
  78   ]
  79
  80 -- | Slow a test's max tests, if provided as such.
  81 makeSlowOrFast :: Bool -> TestOptions -> TestOptions
  82 makeSlowOrFast is_fast opts =
  83   let template = if is_fast then fast else slow
  84       fn_val v = if is_fast then v else v `div` 10
  85   in case topt_maximum_generated_tests opts of
  86        -- user didn't override the max_tests, so we'll do it here
  87        Nothing -> opts `mappend` template
  88        -- user did override, so we ignore the template and just directly
  89        -- decrease the max_tests, if needed
  90        Just max_tests -> opts { topt_maximum_generated_tests =
  91                                   Just (fn_val max_tests)
  92                               }
  93
  94 -- | Main function. Note we don't use defaultMain since we want to
  95 -- control explicitly our test sizes (and override the default).
  96 main :: IO ()
  97 main = do
  98   ropts <- getArgs >>= interpretArgsOrExit
  99   -- note: we do this overriding here since we need some groups to
 100   -- have a smaller test count; so in effect we're basically
 101   -- overriding t-f's inheritance here, but only for max_tests
 102   let (act_fast, act_slow) =
 103        case ropt_test_options ropts of
 104          Nothing -> (fast, slow)
 105          Just topts -> (makeSlowOrFast True topts, makeSlowOrFast False topts)
 106       actual_opts is_fast = if is_fast then act_fast else act_slow
 107   let tests = map (\(is_fast, (group_name, group_tests)) ->
 108                      plusTestOptions (actual_opts is_fast) $
 109                      testGroup group_name group_tests) allTests
 110   defaultMainWithOpts tests ropts