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