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