Add filtering support in Query

[ganeti-local] / htools / test.hs

diff --git a/htools/test.hs b/htools/test.hs
index 12aa50d..3aecfa6 100644 (file)
--- a/htools/test.hs
+++ b/htools/test.hs
@@ -1,10 +1,10 @@
-{-| Unittest runner for ganeti-htools
+{-| Unittest runner for ganeti-htools.
 
 -}
 
 {-
 
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2011, 2012 Google Inc.
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -25,69 +25,84 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 module Main(main) where
 
-import Data.IORef
-import Test.QuickCheck.Batch
-import System.IO
-import System.Exit
-import System (getArgs)
+import Data.Monoid (mappend)
+import Test.Framework
+import System.Environment (getArgs)
 
 import Ganeti.HTools.QC
 
+-- | Our default test options, overring the built-in test-framework
+-- ones.
 fast :: TestOptions
 fast = TestOptions
-              { no_of_tests         = 500
-              , length_of_tests     = 10
-              , debug_tests         = False }
-
+       { topt_seed                               = Nothing
+       , topt_maximum_generated_tests            = Just 500
+       , topt_maximum_unsuitable_generated_tests = Just 5000
+       , topt_maximum_test_size                  = Nothing
+       , topt_maximum_test_depth                 = Nothing
+       , topt_timeout                            = Nothing
+       }
+
+-- | Our slow test options.
 slow :: TestOptions
-slow = TestOptions
-              { no_of_tests         = 50
-              , length_of_tests     = 100
-              , debug_tests         = False }
-
-incIORef :: IORef Int -> IO ()
-incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
-
--- | Wrapper over a test runner with error counting
-wrapTest :: IORef Int
-         -> (TestOptions -> IO TestResult)
-         -> TestOptions -> IO TestResult
-wrapTest ir t to = do
-    tr <- t to
-    case tr of
-      TestFailed _ _ -> incIORef ir
-      TestAborted e -> do
-        incIORef ir
-        putStrLn ("Failure during test: <" ++ show e ++ ">")
-      _ -> return ()
-    return tr
+slow = fast
+       { topt_maximum_generated_tests            = Just 50
+       , topt_maximum_unsuitable_generated_tests = Just 500
+       }
 
-allTests :: [(String, TestOptions, [TestOptions -> IO TestResult])]
+-- | All our defined tests.
+allTests :: [(Bool, (String, [Test]))]
 allTests =
-  [ ("Utils", fast, testUtils)
-  , ("PeerMap", fast, testPeerMap)
-  , ("Container", fast, testContainer)
-  , ("Instance", fast, testInstance)
-  , ("Node", fast, testNode)
-  , ("Text", fast, testText)
-  , ("OpCodes", fast, testOpCodes)
-  , ("Jobs", fast, testJobs)
-  , ("Loader", fast, testLoader)
-  , ("Cluster", slow, testCluster)
+  [ (True, testUtils)
+  , (True, testPeerMap)
+  , (True, testContainer)
+  , (True, testInstance)
+  , (True, testNode)
+  , (True, testText)
+  , (True, testSimu)
+  , (True, testOpCodes)
+  , (True, testJobs)
+  , (True, testLoader)
+  , (True, testTypes)
+  , (True, testCLI)
+  , (True, testJSON)
+  , (True, testLuxi)
+  , (True, testSsconf)
+  , (True, testQlang)
+  , (True, testRpc)
+  , (True, testConfd)
+  , (True, testObjects)
+  , (False, testCluster)
   ]
 
+-- | Slow a test's max tests, if provided as such.
+makeSlowOrFast :: Bool -> TestOptions -> TestOptions
+makeSlowOrFast is_fast opts =
+  let template = if is_fast then fast else slow
+      fn_val v = if is_fast then v else v `div` 10
+  in case topt_maximum_generated_tests opts of
+       -- user didn't override the max_tests, so we'll do it here
+       Nothing -> opts `mappend` template
+       -- user did override, so we ignore the template and just directly
+       -- decrease the max_tests, if needed
+       Just max_tests -> opts { topt_maximum_generated_tests =
+                                  Just (fn_val max_tests)
+                              }
+
+-- | Main function. Note we don't use defaultMain since we want to
+-- control explicitly our test sizes (and override the default).
 main :: IO ()
 main = do
-  errs <- newIORef 0
-  let wrap = map (wrapTest errs)
-  args <- getArgs
-  let tests = if null args
-              then allTests
-              else filter (\(name, _, _) -> name `elem` args) allTests
-  mapM_ (\(name, opts, tl) -> runTests name opts (wrap tl)) tests
-  terr <- readIORef errs
-  (if terr > 0
-   then do
-     hPutStrLn stderr $ "A total of " ++ show terr ++ " tests failed."
-     exitWith $ ExitFailure 1
-   else putStrLn "All tests succeeded.")
+  ropts <- getArgs >>= interpretArgsOrExit
+  -- note: we do this overriding here since we need some groups to
+  -- have a smaller test count; so in effect we're basically
+  -- overriding t-f's inheritance here, but only for max_tests
+  let (act_fast, act_slow) =
+       case ropt_test_options ropts of
+         Nothing -> (fast, slow)
+         Just topts -> (makeSlowOrFast True topts, makeSlowOrFast False topts)
+      actual_opts is_fast = if is_fast then act_fast else act_slow
+  let tests = map (\(is_fast, (group_name, group_tests)) ->
+                     plusTestOptions (actual_opts is_fast) $
+                     testGroup group_name group_tests) allTests
+  defaultMainWithOpts tests ropts