From 63b068c1a05e0f011b6f4108148394a4822ec7fc Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Thu, 30 Aug 2012 19:40:41 +0200
Subject: [PATCH] Add a test helper for simple JSON serialisation testing
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
While adding yet another JSON serialisation test, I realised that this
can be trivially abstracted; hence this patch, replacing both simple
versions (readJSON . showJSON == id) and the standard version (with
different error messages) across the tests with a single function
call.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: RenΓ© Nussbaumer <rn@google.com>
---
htest/Test/Ganeti/HTools/Types.hs | 26 +++++---------------------
htest/Test/Ganeti/Jobs.hs | 12 ++----------
htest/Test/Ganeti/Objects.hs | 7 ++-----
htest/Test/Ganeti/OpCodes.hs | 5 +----
htest/Test/Ganeti/Query/Language.hs | 7 ++-----
htest/Test/Ganeti/TestCommon.hs | 8 ++++++++
6 files changed, 20 insertions(+), 45 deletions(-)
diff --git a/htest/Test/Ganeti/HTools/Types.hs b/htest/Test/Ganeti/HTools/Types.hs
index 6281fa57d..34759c50b 100644
--- a/htest/Test/Ganeti/HTools/Types.hs
+++ b/htest/Test/Ganeti/HTools/Types.hs
@@ -41,7 +41,6 @@ module Test.Ganeti.HTools.Types
import Test.QuickCheck
import Control.Applicative
-import qualified Text.JSON as J
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
@@ -128,34 +127,19 @@ instance Arbitrary Types.IPolicy where
-- * Test cases
prop_AllocPolicy_serialisation :: Types.AllocPolicy -> Property
-prop_AllocPolicy_serialisation apol =
- case J.readJSON (J.showJSON apol) of
- J.Ok p -> p ==? apol
- J.Error s -> failTest $ "Failed to deserialise: " ++ s
+prop_AllocPolicy_serialisation = testSerialisation
prop_DiskTemplate_serialisation :: Types.DiskTemplate -> Property
-prop_DiskTemplate_serialisation dt =
- case J.readJSON (J.showJSON dt) of
- J.Ok p -> p ==? dt
- J.Error s -> failTest $ "Failed to deserialise: " ++ s
+prop_DiskTemplate_serialisation = testSerialisation
prop_ISpec_serialisation :: Types.ISpec -> Property
-prop_ISpec_serialisation ispec =
- case J.readJSON (J.showJSON ispec) of
- J.Ok p -> p ==? ispec
- J.Error s -> failTest $ "Failed to deserialise: " ++ s
+prop_ISpec_serialisation = testSerialisation
prop_IPolicy_serialisation :: Types.IPolicy -> Property
-prop_IPolicy_serialisation ipol =
- case J.readJSON (J.showJSON ipol) of
- J.Ok p -> p ==? ipol
- J.Error s -> failTest $ "Failed to deserialise: " ++ s
+prop_IPolicy_serialisation = testSerialisation
prop_EvacMode_serialisation :: Types.EvacMode -> Property
-prop_EvacMode_serialisation em =
- case J.readJSON (J.showJSON em) of
- J.Ok p -> p ==? em
- J.Error s -> failTest $ "Failed to deserialise: " ++ s
+prop_EvacMode_serialisation = testSerialisation
prop_opToResult :: Types.OpResult Int -> Bool
prop_opToResult op =
diff --git a/htest/Test/Ganeti/Jobs.hs b/htest/Test/Ganeti/Jobs.hs
index 3471c9524..b9504f718 100644
--- a/htest/Test/Ganeti/Jobs.hs
+++ b/htest/Test/Ganeti/Jobs.hs
@@ -30,8 +30,6 @@ module Test.Ganeti.Jobs (testJobs) where
import Test.QuickCheck
-import qualified Text.JSON as J
-
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
@@ -49,16 +47,10 @@ instance Arbitrary Jobs.JobStatus where
-- | Check that (queued) job\/opcode status serialization is idempotent.
prop_OpStatus_serialization :: Jobs.OpStatus -> Property
-prop_OpStatus_serialization os =
- case J.readJSON (J.showJSON os) of
- J.Error e -> failTest $ "Cannot deserialise: " ++ e
- J.Ok os' -> os ==? os'
+prop_OpStatus_serialization = testSerialisation
prop_JobStatus_serialization :: Jobs.JobStatus -> Property
-prop_JobStatus_serialization js =
- case J.readJSON (J.showJSON js) of
- J.Error e -> failTest $ "Cannot deserialise: " ++ e
- J.Ok js' -> js ==? js'
+prop_JobStatus_serialization = testSerialisation
testSuite "Jobs"
[ 'prop_OpStatus_serialization
diff --git a/htest/Test/Ganeti/Objects.hs b/htest/Test/Ganeti/Objects.hs
index 58129cf89..d39a9e62b 100644
--- a/htest/Test/Ganeti/Objects.hs
+++ b/htest/Test/Ganeti/Objects.hs
@@ -37,7 +37,6 @@ import Test.QuickCheck
import Control.Applicative
import qualified Data.Map as Map
import qualified Data.Set as Set
-import qualified Text.JSON as J
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
@@ -106,13 +105,11 @@ prop_fillDict defaults custom =
-- testing entire Disk serialisations. So this tests two things at
-- once, basically.
prop_Disk_serialisation :: Disk -> Property
-prop_Disk_serialisation disk =
- J.readJSON (J.showJSON disk) ==? J.Ok disk
+prop_Disk_serialisation = testSerialisation
-- | Check that node serialisation is idempotent.
prop_Node_serialisation :: Node -> Property
-prop_Node_serialisation node =
- J.readJSON (J.showJSON node) ==? J.Ok node
+prop_Node_serialisation = testSerialisation
testSuite "Objects"
[ 'prop_fillDict
diff --git a/htest/Test/Ganeti/OpCodes.hs b/htest/Test/Ganeti/OpCodes.hs
index d184d2104..39396cb86 100644
--- a/htest/Test/Ganeti/OpCodes.hs
+++ b/htest/Test/Ganeti/OpCodes.hs
@@ -74,10 +74,7 @@ instance Arbitrary OpCodes.OpCode where
-- | Check that opcode serialization is idempotent.
prop_serialization :: OpCodes.OpCode -> Property
-prop_serialization op =
- case J.readJSON (J.showJSON op) of
- J.Error e -> failTest $ "Cannot deserialise: " ++ e
- J.Ok op' -> op ==? op'
+prop_serialization = testSerialisation
-- | Check that Python and Haskell defined the same opcode list.
case_AllDefined :: HUnit.Assertion
diff --git a/htest/Test/Ganeti/Query/Language.hs b/htest/Test/Ganeti/Query/Language.hs
index ce2a3b755..15ff94ebb 100644
--- a/htest/Test/Ganeti/Query/Language.hs
+++ b/htest/Test/Ganeti/Query/Language.hs
@@ -34,7 +34,6 @@ module Test.Ganeti.Query.Language
import Test.QuickCheck
import Control.Applicative
-import qualified Text.JSON as J
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
@@ -83,13 +82,11 @@ instance Arbitrary Qlang.FilterRegex where
-- idempotent.
prop_Serialisation :: Property
prop_Serialisation =
- forAll genFilter $ \flt ->
- J.readJSON (J.showJSON flt) ==? J.Ok flt
+ forAll genFilter testSerialisation
prop_FilterRegex_instances :: Qlang.FilterRegex -> Property
prop_FilterRegex_instances rex =
- printTestCase "failed JSON encoding"
- (J.readJSON (J.showJSON rex) ==? J.Ok rex) .&&.
+ printTestCase "failed JSON encoding" (testSerialisation rex) .&&.
printTestCase "failed read/show instances" (read (show rex) ==? rex)
testSuite "Query/Language"
diff --git a/htest/Test/Ganeti/TestCommon.hs b/htest/Test/Ganeti/TestCommon.hs
index e38b3cb41..8d99d3e88 100644
--- a/htest/Test/Ganeti/TestCommon.hs
+++ b/htest/Test/Ganeti/TestCommon.hs
@@ -31,6 +31,7 @@ import Control.Monad
import Data.List
import qualified Test.HUnit as HUnit
import Test.QuickCheck
+import qualified Text.JSON as J
import System.Environment (getEnv)
import System.Exit (ExitCode(..))
import System.IO.Error (isDoesNotExistError)
@@ -187,3 +188,10 @@ instance Arbitrary SmallRatio where
arbitrary = do
v <- choose (0, 1)
return $ SmallRatio v
+
+-- | Checks for serialisation idempotence.
+testSerialisation :: (Eq a, Show a, J.JSON a) => a -> Property
+testSerialisation a =
+ case J.readJSON (J.showJSON a) of
+ J.Error msg -> failTest $ "Failed to deserialise: " ++ msg
+ J.Ok a' -> a ==? a'
--
GitLab