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