Text: read/write the allocation policy

[ganeti-local] / test.hs

diff --git a/test.hs b/test.hs
index 59d6f10..12aa50d 100644 (file)
--- a/test.hs
+++ b/test.hs
@@ -25,16 +25,69 @@ 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 Ganeti.HTools.QC
 
-options = TestOptions
-      { no_of_tests         = 500
-      , length_of_tests     = 5
-      , debug_tests         = False }
+fast :: TestOptions
+fast = TestOptions
+              { no_of_tests         = 500
+              , length_of_tests     = 10
+              , debug_tests         = False }
+
+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
+
+allTests :: [(String, TestOptions, [TestOptions -> IO TestResult])]
+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)
+  ]
 
+main :: IO ()
 main = do
-  runTests "PeerMap" options test_PeerMap
-  runTests "Container" options test_Container
-  runTests "Instance" options test_Instance
-  runTests "Node" options test_Node
+  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.")