| 57 |
57 |
import Test.Ganeti.Ssconf
|
| 58 |
58 |
|
| 59 |
59 |
-- | Our default test options, overring the built-in test-framework
|
| 60 |
|
-- ones.
|
| 61 |
|
fast :: TestOptions
|
| 62 |
|
fast = TestOptions
|
|
60 |
-- ones (but not the supplied command line parameters).
|
|
61 |
defOpts :: TestOptions
|
|
62 |
defOpts = TestOptions
|
| 63 |
63 |
{ topt_seed = Nothing
|
| 64 |
64 |
, topt_maximum_generated_tests = Just 500
|
| 65 |
65 |
, topt_maximum_unsuitable_generated_tests = Just 5000
|
| ... | ... | |
| 68 |
68 |
, topt_timeout = Nothing
|
| 69 |
69 |
}
|
| 70 |
70 |
|
| 71 |
|
-- | Our slow test options.
|
| 72 |
|
slow :: TestOptions
|
| 73 |
|
slow = fast
|
| 74 |
|
{ topt_maximum_generated_tests = Just 50
|
| 75 |
|
, topt_maximum_unsuitable_generated_tests = Just 500
|
| 76 |
|
}
|
| 77 |
|
|
| 78 |
71 |
-- | All our defined tests.
|
| 79 |
|
allTests :: [(Bool, (String, [Test]))]
|
|
72 |
allTests :: [(String, [Test])]
|
| 80 |
73 |
allTests =
|
| 81 |
|
[ (True, testBasicTypes)
|
| 82 |
|
, (True, testConfd_Utils)
|
| 83 |
|
, (True, testCommon)
|
| 84 |
|
, (True, testDaemon)
|
| 85 |
|
, (True, testHTools_CLI)
|
| 86 |
|
, (True, testHTools_Container)
|
| 87 |
|
, (True, testHTools_Instance)
|
| 88 |
|
, (True, testHTools_Loader)
|
| 89 |
|
, (True, testHTools_Node)
|
| 90 |
|
, (True, testHTools_PeerMap)
|
| 91 |
|
, (True, testHTools_Simu)
|
| 92 |
|
, (True, testHTools_Text)
|
| 93 |
|
, (True, testHTools_Types)
|
| 94 |
|
, (True, testHTools_Utils)
|
| 95 |
|
, (True, testJSON)
|
| 96 |
|
, (True, testJobs)
|
| 97 |
|
, (True, testLuxi)
|
| 98 |
|
, (True, testObjects)
|
| 99 |
|
, (True, testOpCodes)
|
| 100 |
|
, (True, testQuery_Filter)
|
| 101 |
|
, (True, testQuery_Language)
|
| 102 |
|
, (True, testQuery_Query)
|
| 103 |
|
, (True, testRpc)
|
| 104 |
|
, (True, testSsconf)
|
| 105 |
|
, (False, testHTools_Cluster)
|
| 106 |
|
, (False, testSlowObjects)
|
|
74 |
[ testBasicTypes
|
|
75 |
, testCommon
|
|
76 |
, testConfd_Utils
|
|
77 |
, testDaemon
|
|
78 |
, testHTools_CLI
|
|
79 |
, testHTools_Cluster
|
|
80 |
, testHTools_Container
|
|
81 |
, testHTools_Instance
|
|
82 |
, testHTools_Loader
|
|
83 |
, testHTools_Node
|
|
84 |
, testHTools_PeerMap
|
|
85 |
, testHTools_Simu
|
|
86 |
, testHTools_Text
|
|
87 |
, testHTools_Types
|
|
88 |
, testHTools_Utils
|
|
89 |
, testJSON
|
|
90 |
, testJobs
|
|
91 |
, testLuxi
|
|
92 |
, testObjects
|
|
93 |
, testOpCodes
|
|
94 |
, testQuery_Filter
|
|
95 |
, testQuery_Language
|
|
96 |
, testQuery_Query
|
|
97 |
, testRpc
|
|
98 |
, testSsconf
|
| 107 |
99 |
]
|
| 108 |
100 |
|
| 109 |
|
-- | Slow a test's max tests, if provided as such.
|
| 110 |
|
makeSlowOrFast :: Bool -> TestOptions -> TestOptions
|
| 111 |
|
makeSlowOrFast is_fast opts =
|
| 112 |
|
let template = if is_fast then fast else slow
|
| 113 |
|
fn_val v = if is_fast then v else v `div` 10
|
| 114 |
|
in case topt_maximum_generated_tests opts of
|
| 115 |
|
-- user didn't override the max_tests, so we'll do it here
|
| 116 |
|
Nothing -> opts `mappend` template
|
| 117 |
|
-- user did override, so we ignore the template and just directly
|
| 118 |
|
-- decrease the max_tests, if needed
|
| 119 |
|
Just max_tests -> opts { topt_maximum_generated_tests =
|
| 120 |
|
Just (fn_val max_tests)
|
| 121 |
|
}
|
| 122 |
|
|
| 123 |
101 |
-- | Main function. Note we don't use defaultMain since we want to
|
| 124 |
102 |
-- control explicitly our test sizes (and override the default).
|
| 125 |
103 |
main :: IO ()
|
| 126 |
104 |
main = do
|
| 127 |
105 |
ropts <- getArgs >>= interpretArgsOrExit
|
| 128 |
|
-- note: we do this overriding here since we need some groups to
|
| 129 |
|
-- have a smaller test count; so in effect we're basically
|
| 130 |
|
-- overriding t-f's inheritance here, but only for max_tests
|
| 131 |
|
let (act_fast, act_slow) =
|
| 132 |
|
case ropt_test_options ropts of
|
| 133 |
|
Nothing -> (fast, slow)
|
| 134 |
|
Just topts -> (makeSlowOrFast True topts, makeSlowOrFast False topts)
|
| 135 |
|
actual_opts is_fast = if is_fast then act_fast else act_slow
|
| 136 |
|
let tests = map (\(is_fast, (group_name, group_tests)) ->
|
| 137 |
|
plusTestOptions (actual_opts is_fast) $
|
| 138 |
|
testGroup group_name group_tests) allTests
|
| 139 |
|
defaultMainWithOpts tests ropts
|
|
106 |
let opts = maybe defOpts (defOpts `mappend`) $ ropt_test_options ropts
|
|
107 |
tests = map (uncurry testGroup) allTests
|
|
108 |
defaultMainWithOpts tests (ropts { ropt_test_options = Just opts })
|