Add a small 'passTest' helper

This is symmetric to failTest, and allows us to use it in cases where
we need to return a property.

While replacing 'property True' with it, I saw a case where we can
simplify the use and thus reworked that check.

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: René Nussbaumer <rn@google.com>

diff --git a/htest/Test/Ganeti/HTools/CLI.hs b/htest/Test/Ganeti/HTools/CLI.hs
index b64e6ff..239dae9 100644 (file)
--- a/htest/Test/Ganeti/HTools/CLI.hs
+++ b/htest/Test/Ganeti/HTools/CLI.hs
@@ -56,7 +56,7 @@ prop_parseISpecFail descr =
   let str = intercalate "," $ map show (values::[Int])
   in case CLI.parseISpecString descr str of
        Types.Ok v -> failTest $ "Expected failure, got " ++ show v
-       _ -> property True
+       _ -> passTest
 
 -- | Test parseYesNo.
 prop_parseYesNo :: Bool -> Bool -> [Char] -> Property
@@ -99,11 +99,10 @@ prop_StringArg argument =
 checkEarlyExit :: String -> [CLI.OptType] -> String -> Property
 checkEarlyExit name options param =
   case CLI.parseOptsInner [param] name options of
-    Left (code, _) -> if code == 0
-                          then property True
-                          else failTest $ "Program " ++ name ++
-                                 " returns invalid code " ++ show code ++
-                                 " for option " ++ param
+    Left (code, _) ->
+      printTestCase ("Program " ++ name ++
+                     " returns invalid code " ++ show code ++
+                     " for option " ++ param) (code == 0)
     _ -> failTest $ "Program " ++ name ++ " doesn't consider option " ++
          param ++ " as early exit one"
 

diff --git a/htest/Test/Ganeti/HTools/Cluster.hs b/htest/Test/Ganeti/HTools/Cluster.hs
index c26560e..a779a52 100644 (file)
--- a/htest/Test/Ganeti/HTools/Cluster.hs
+++ b/htest/Test/Ganeti/HTools/Cluster.hs
@@ -206,7 +206,7 @@ prop_AllocRelocate =
              [(if Instance.diskTemplate inst' == Types.DTDrbd8
                  then Instance.sNode
                  else Instance.pNode) inst'] of
-        Types.Ok _ -> property True
+        Types.Ok _ -> passTest
         Types.Bad msg -> failTest $ "Failed to relocate: " ++ msg
 
 -- | Helper property checker for the result of a nodeEvac or

diff --git a/htest/Test/Ganeti/HTools/Node.hs b/htest/Test/Ganeti/HTools/Node.hs
index a437e64..ddf6a99 100644 (file)
--- a/htest/Test/Ganeti/HTools/Node.hs
+++ b/htest/Test/Ganeti/HTools/Node.hs
@@ -154,7 +154,7 @@ prop_addPriFC =
   let inst' = setInstanceSmallerThanNode node inst
       inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
   in case Node.addPri node inst'' of
-       Types.OpFail Types.FailCPU -> property True
+       Types.OpFail Types.FailCPU -> passTest
        v -> failTest $ "Expected OpFail FailCPU, but got " ++ show v
 
 -- | Check that an instance add with too high memory or disk will be
@@ -177,7 +177,7 @@ prop_addOfflinePri (NonNegative extra_mem) (NonNegative extra_cpu) =
                    , Instance.mem = Node.availMem node + extra_mem
                    , Instance.vcpus = Node.availCpu node + extra_cpu }
   in case Node.addPri node inst' of
-       Types.OpGood _ -> property True
+       Types.OpGood _ -> passTest
        v -> failTest $ "Expected OpGood, but got: " ++ show v
 
 -- | Check that an offline instance with reasonable disk size but
@@ -192,7 +192,7 @@ prop_addOfflineSec (NonNegative extra_mem) (NonNegative extra_cpu) pdx =
                    , Instance.vcpus = Node.availCpu node + extra_cpu
                    , Instance.diskTemplate = Types.DTDrbd8 }
   in case Node.addSec node inst' pdx of
-       Types.OpGood _ -> property True
+       Types.OpGood _ -> passTest
        v -> failTest $ "Expected OpGood/OpGood, but got: " ++ show v
 
 -- | Checks for memory reservation changes.

diff --git a/htest/Test/Ganeti/JSON.hs b/htest/Test/Ganeti/JSON.hs
index 0ad22ff..6279520 100644 (file)
--- a/htest/Test/Ganeti/JSON.hs
+++ b/htest/Test/Ganeti/JSON.hs
@@ -50,7 +50,7 @@ prop_toArrayFail i s b =
   -- poor man's instance Arbitrary JSValue
   forAll (elements [J.showJSON i, J.showJSON s, J.showJSON b]) $ \item ->
   case JSON.toArray item of
-    BasicTypes.Bad _ -> property True
+    BasicTypes.Bad _ -> passTest
     BasicTypes.Ok result -> failTest $ "Unexpected parse, got " ++ show result
 
 testSuite "JSON"

diff --git a/htest/Test/Ganeti/TestCommon.hs b/htest/Test/Ganeti/TestCommon.hs
index 8d99d3e..5a244e1 100644 (file)
--- a/htest/Test/Ganeti/TestCommon.hs
+++ b/htest/Test/Ganeti/TestCommon.hs
@@ -81,6 +81,10 @@ infix 3 ==?
 failTest :: String -> Property
 failTest msg = printTestCase msg False
 
+-- | A 'True' property.
+passTest :: Property
+passTest = property True
+
 -- | Return the python binary to use. If the PYTHON environment
 -- variable is defined, use its value, otherwise use just \"python\".
 pythonCmd :: IO String