Text: read/write the allocation policy

[ganeti-local] / test.hs

diff --git a/test.hs b/test.hs
index 421b300..12aa50d 100644 (file)
--- a/test.hs
+++ b/test.hs
@@ -25,20 +25,25 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 module Main(main) where
 
-import Control.Monad
 import Data.IORef
 import Test.QuickCheck.Batch
 import System.IO
 import System.Exit
+import System (getArgs)
 
 import Ganeti.HTools.QC
 
-options :: TestOptions
-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, ()))
@@ -51,20 +56,35 @@ wrapTest ir t to = do
     tr <- t to
     case tr of
       TestFailed _ _ -> incIORef ir
-      TestAborted _ -> 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
   errs <- newIORef 0
   let wrap = map (wrapTest errs)
-  runTests "PeerMap" options $ wrap testPeerMap
-  runTests "Container" options $ wrap testContainer
-  runTests "Instance" options $ wrap testInstance
-  runTests "Node" options $ wrap testNode
-  runTests "Text" options $ wrap testText
-  runTests "Cluster" options $ wrap testCluster
+  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