From 471b6c46fb01fdc3296431bc0c9bb623ad66e919 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Tue, 6 Nov 2012 16:47:53 +0100
Subject: [PATCH] Add test for Luxi calls consistency hs/py
This tests that the same Luxi calls are defined in Python and
Haskell. It doesn't test yet that their serialisation is correct
though.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
htest/Test/Ganeti/Luxi.hs | 19 +++++++++++++++++++
htools/Ganeti/Luxi.hs | 4 ++++
htools/Ganeti/THH.hs | 1 +
3 files changed, 24 insertions(+)
diff --git a/htest/Test/Ganeti/Luxi.hs b/htest/Test/Ganeti/Luxi.hs
index 09b829a6a..81698b08d 100644
--- a/htest/Test/Ganeti/Luxi.hs
+++ b/htest/Test/Ganeti/Luxi.hs
@@ -28,9 +28,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.Luxi (testLuxi) where
+import Test.HUnit
import Test.QuickCheck
import Test.QuickCheck.Monadic (monadicIO, run, stop)
+import Data.List
import Control.Applicative
import Control.Concurrent (forkIO)
import Control.Exception (bracket)
@@ -134,7 +136,24 @@ prop_ClientServer dnschars = monadicIO $ do
(`luxiClientPong` msgs)
stop $ replies ==? msgs
+-- | Check that Python and Haskell define the same Luxi requests list.
+case_AllDefined :: Assertion
+case_AllDefined = do
+ py_stdout <- runPython "from ganeti import luxi\n\
+ \print '\\n'.join(luxi.REQ_ALL)" "" >>=
+ checkPythonResult
+ let py_ops = sort $ lines py_stdout
+ hs_ops = Luxi.allLuxiCalls
+ extra_py = py_ops \\ hs_ops
+ extra_hs = hs_ops \\ py_ops
+ assertBool ("Luxi calls missing from Haskell code:\n" ++
+ unlines extra_py) (null extra_py)
+ assertBool ("Extra Luxi calls in the Haskell code code:\n" ++
+ unlines extra_hs) (null extra_hs)
+
+
testSuite "Luxi"
[ 'prop_CallEncoding
, 'prop_ClientServer
+ , 'case_AllDefined
]
diff --git a/htools/Ganeti/Luxi.hs b/htools/Ganeti/Luxi.hs
index 7cbccd946..4e5c505c2 100644
--- a/htools/Ganeti/Luxi.hs
+++ b/htools/Ganeti/Luxi.hs
@@ -48,6 +48,7 @@ module Ganeti.Luxi
, recvMsg
, recvMsgExt
, sendMsg
+ , allLuxiCalls
) where
import Control.Exception (catch)
@@ -183,6 +184,9 @@ $(genLuxiOp "LuxiOp"
$(makeJSONInstance ''LuxiReq)
+-- | List of all defined Luxi calls.
+$(genAllConstr (drop 3) ''LuxiReq "allLuxiCalls")
+
-- | The serialisation of LuxiOps into strings in messages.
$(genStrOfOp ''LuxiOp "strOfOp")
diff --git a/htools/Ganeti/THH.hs b/htools/Ganeti/THH.hs
index 8681417e7..93a599279 100644
--- a/htools/Ganeti/THH.hs
+++ b/htools/Ganeti/THH.hs
@@ -33,6 +33,7 @@ module Ganeti.THH ( declareSADT
, declareIADT
, makeJSONInstance
, genOpID
+ , genAllConstr
, genAllOpIDs
, genOpCode
, genStrOfOp
--
GitLab