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