From 2e0bb81d32f8f42a6958960acf7a63b79f4bd2fe Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Fri, 31 Aug 2012 14:10:48 +0200
Subject: [PATCH] Add a small 'passTest' helper
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
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>
---
htest/Test/Ganeti/HTools/CLI.hs | 11 +++++------
htest/Test/Ganeti/HTools/Cluster.hs | 2 +-
htest/Test/Ganeti/HTools/Node.hs | 6 +++---
htest/Test/Ganeti/JSON.hs | 2 +-
htest/Test/Ganeti/TestCommon.hs | 4 ++++
5 files changed, 14 insertions(+), 11 deletions(-)
diff --git a/htest/Test/Ganeti/HTools/CLI.hs b/htest/Test/Ganeti/HTools/CLI.hs
index b64e6ff12..239dae9ac 100644
--- 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 c26560ef7..a779a5216 100644
--- 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 a437e6428..ddf6a9944 100644
--- 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 0ad22ff73..627952072 100644
--- 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 8d99d3e88..5a244e112 100644
--- 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
--
GitLab