Statistics
| Branch: | Tag: | Revision:

root / htest / test.hs @ 2d87bd0a

History | View | Annotate | Download (4.1 kB)

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.Jobs
46
import Test.Ganeti.JSON
47
import Test.Ganeti.Luxi
48
import Test.Ganeti.Objects
49
import Test.Ganeti.OpCodes
50
import Test.Ganeti.Query.Language
51
import Test.Ganeti.Rpc
52
import Test.Ganeti.Ssconf
53

    
54
-- | Our default test options, overring the built-in test-framework
55
-- ones.
56
fast :: TestOptions
57
fast = TestOptions
58
       { topt_seed                               = Nothing
59
       , topt_maximum_generated_tests            = Just 500
60
       , topt_maximum_unsuitable_generated_tests = Just 5000
61
       , topt_maximum_test_size                  = Nothing
62
       , topt_maximum_test_depth                 = Nothing
63
       , topt_timeout                            = Nothing
64
       }
65

    
66
-- | Our slow test options.
67
slow :: TestOptions
68
slow = fast
69
       { topt_maximum_generated_tests            = Just 50
70
       , topt_maximum_unsuitable_generated_tests = Just 500
71
       }
72

    
73
-- | All our defined tests.
74
allTests :: [(Bool, (String, [Test]))]
75
allTests =
76
  [ (True, testUtils)
77
  , (True, testPeerMap)
78
  , (True, testContainer)
79
  , (True, testInstance)
80
  , (True, testNode)
81
  , (True, testText)
82
  , (True, testSimu)
83
  , (True, testOpCodes)
84
  , (True, testJobs)
85
  , (True, testLoader)
86
  , (True, testTypes)
87
  , (True, testCLI)
88
  , (True, testJSON)
89
  , (True, testLuxi)
90
  , (True, testSsconf)
91
  , (True, testQlang)
92
  , (True, testRpc)
93
  , (True, testConfdUtils)
94
  , (True, testObjects)
95
  , (False, testCluster)
96
  ]
97

    
98
-- | Slow a test's max tests, if provided as such.
99
makeSlowOrFast :: Bool -> TestOptions -> TestOptions
100
makeSlowOrFast is_fast opts =
101
  let template = if is_fast then fast else slow
102
      fn_val v = if is_fast then v else v `div` 10
103
  in case topt_maximum_generated_tests opts of
104
       -- user didn't override the max_tests, so we'll do it here
105
       Nothing -> opts `mappend` template
106
       -- user did override, so we ignore the template and just directly
107
       -- decrease the max_tests, if needed
108
       Just max_tests -> opts { topt_maximum_generated_tests =
109
                                  Just (fn_val max_tests)
110
                              }
111

    
112
-- | Main function. Note we don't use defaultMain since we want to
113
-- control explicitly our test sizes (and override the default).
114
main :: IO ()
115
main = do
116
  ropts <- getArgs >>= interpretArgsOrExit
117
  -- note: we do this overriding here since we need some groups to
118
  -- have a smaller test count; so in effect we're basically
119
  -- overriding t-f's inheritance here, but only for max_tests
120
  let (act_fast, act_slow) =
121
       case ropt_test_options ropts of
122
         Nothing -> (fast, slow)
123
         Just topts -> (makeSlowOrFast True topts, makeSlowOrFast False topts)
124
      actual_opts is_fast = if is_fast then act_fast else act_slow
125
  let tests = map (\(is_fast, (group_name, group_tests)) ->
126
                     plusTestOptions (actual_opts is_fast) $
127
                     testGroup group_name group_tests) allTests
128
  defaultMainWithOpts tests ropts