Commit 305e174c authored by Iustin Pop's avatar Iustin Pop

Split Rpc tests from QC

This required lots of other code moves, so I created it as a
standalone patch.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarRené Nussbaumer <rn@google.com>
parent 2733df51
......@@ -433,8 +433,9 @@ HS_LIB_SRCS = \
htools/Ganeti/THH.hs \
htest/Test/Ganeti/TestHelper.hs \
htest/Test/Ganeti/TestCommon.hs \
htest/Test/Ganeti/Confd/Utils.hs \
htest/Test/Ganeti/Objects.hs \
htest/Test/Ganeti/Confd/Utils.hs
htest/Test/Ganeti/Rpc.hs
HS_BUILT_SRCS = htools/Ganeti/HTools/Version.hs htools/Ganeti/Constants.hs
......
......@@ -26,14 +26,34 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Test.Ganeti.Objects (testObjects) where
module Test.Ganeti.Objects
( testObjects
, Objects.Hypervisor(..)
, Objects.Node(..)
) where
import Control.Applicative
import qualified Data.Map as Map
import qualified Data.Set as Set
import Test.QuickCheck
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import qualified Ganeti.Objects as Objects
instance Arbitrary Objects.Hypervisor where
arbitrary = elements [minBound..maxBound]
instance Arbitrary Objects.PartialNDParams where
arbitrary = Objects.PartialNDParams <$> arbitrary <*> arbitrary
instance Arbitrary Objects.Node where
arbitrary = Objects.Node <$> getFQDN <*> getFQDN <*> getFQDN
<*> arbitrary <*> arbitrary <*> arbitrary <*> getFQDN
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> getFQDN <*> arbitrary
<*> (Set.fromList <$> genTags)
-- | Tests that fillDict behaves correctly
prop_Objects_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property
prop_Objects_fillDict defaults custom =
......
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for ganeti-htools.
-}
{-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.
-}
module Test.Ganeti.Rpc (testRpc) where
import Test.QuickCheck
import Test.QuickCheck.Monadic (monadicIO, run, stop)
import Control.Applicative
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.Objects ()
import qualified Ganeti.Rpc as Rpc
import qualified Ganeti.Objects as Objects
instance Arbitrary Rpc.RpcCallAllInstancesInfo where
arbitrary = Rpc.RpcCallAllInstancesInfo <$> arbitrary
instance Arbitrary Rpc.RpcCallInstanceList where
arbitrary = Rpc.RpcCallInstanceList <$> arbitrary
instance Arbitrary Rpc.RpcCallNodeInfo where
arbitrary = Rpc.RpcCallNodeInfo <$> arbitrary <*> arbitrary
-- | Monadic check that, for an offline node and a call that does not
-- offline nodes, we get a OfflineNodeError response.
-- FIXME: We need a way of generalizing this, running it for
-- every call manually will soon get problematic
prop_Rpc_noffl_request_allinstinfo :: Rpc.RpcCallAllInstancesInfo -> Property
prop_Rpc_noffl_request_allinstinfo call =
forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
res <- run $ Rpc.executeRpcCall [node] call
stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
prop_Rpc_noffl_request_instlist :: Rpc.RpcCallInstanceList -> Property
prop_Rpc_noffl_request_instlist call =
forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
res <- run $ Rpc.executeRpcCall [node] call
stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
prop_Rpc_noffl_request_nodeinfo :: Rpc.RpcCallNodeInfo -> Property
prop_Rpc_noffl_request_nodeinfo call =
forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
res <- run $ Rpc.executeRpcCall [node] call
stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
testSuite "Rpc"
[ 'prop_Rpc_noffl_request_allinstinfo
, 'prop_Rpc_noffl_request_instlist
, 'prop_Rpc_noffl_request_nodeinfo
]
......@@ -108,3 +108,35 @@ getMaybe subgen = do
if bool
then Just <$> subgen
else return Nothing
-- | Defines a tag type.
newtype TagChar = TagChar { tagGetChar :: Char }
-- | All valid tag chars. This doesn't need to match _exactly_
-- Ganeti's own tag regex, just enough for it to be close.
tagChar :: [Char]
tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
instance Arbitrary TagChar where
arbitrary = do
c <- elements tagChar
return (TagChar c)
-- | Generates a tag
genTag :: Gen [TagChar]
genTag = do
-- the correct value would be C.maxTagLen, but that's way too
-- verbose in unittests, and at the moment I don't see any possible
-- bugs with longer tags and the way we use tags in htools
n <- choose (1, 10)
vector n
-- | Generates a list of tags (correctly upper bounded).
genTags :: Gen [String]
genTags = do
-- the correct value would be C.maxTagsPerObj, but per the comment
-- in genTag, we don't use tags enough in htools to warrant testing
-- such big values
n <- choose (0, 10::Int)
tags <- mapM (const genTag) [1..n]
return $ map (map tagGetChar) tags
......@@ -32,6 +32,7 @@ import System.Environment (getArgs)
import Ganeti.HTools.QC
import Test.Ganeti.Confd.Utils
import Test.Ganeti.Objects
import Test.Ganeti.Rpc
-- | Our default test options, overring the built-in test-framework
-- ones.
......
......@@ -48,9 +48,7 @@ module Ganeti.HTools.QC
, testJSON
, testLuxi
, testSsconf
, testRpc
, testQlang
, testConfd
) where
import qualified Test.HUnit as HUnit
......@@ -87,7 +85,6 @@ import qualified Ganeti.Logging as Logging
import qualified Ganeti.Luxi as Luxi
import qualified Ganeti.Objects as Objects
import qualified Ganeti.OpCodes as OpCodes
import qualified Ganeti.Rpc as Rpc
import qualified Ganeti.Query.Language as Qlang
import qualified Ganeti.Runtime as Runtime
import qualified Ganeti.Ssconf as Ssconf
......@@ -281,38 +278,6 @@ getFields = do
n <- choose (1, 32)
vectorOf n getName
-- | Defines a tag type.
newtype TagChar = TagChar { tagGetChar :: Char }
-- | All valid tag chars. This doesn't need to match _exactly_
-- Ganeti's own tag regex, just enough for it to be close.
tagChar :: [Char]
tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
instance Arbitrary TagChar where
arbitrary = do
c <- elements tagChar
return (TagChar c)
-- | Generates a tag
genTag :: Gen [TagChar]
genTag = do
-- the correct value would be C.maxTagLen, but that's way too
-- verbose in unittests, and at the moment I don't see any possible
-- bugs with longer tags and the way we use tags in htools
n <- choose (1, 10)
vector n
-- | Generates a list of tags (correctly upper bounded).
genTags :: Gen [String]
genTags = do
-- the correct value would be C.maxTagsPerObj, but per the comment
-- in genTag, we don't use tags enough in htools to warrant testing
-- such big values
n <- choose (0, 10::Int)
tags <- mapM (const genTag) [1..n]
return $ map (map tagGetChar) tags
instance Arbitrary Types.InstanceStatus where
arbitrary = elements [minBound..maxBound]
......@@ -489,28 +454,6 @@ instance Arbitrary Types.IPolicy where
, Types.iPolicySpindleRatio = spindle_ratio
}
instance Arbitrary Objects.Hypervisor where
arbitrary = elements [minBound..maxBound]
instance Arbitrary Objects.PartialNDParams where
arbitrary = Objects.PartialNDParams <$> arbitrary <*> arbitrary
instance Arbitrary Objects.Node where
arbitrary = Objects.Node <$> getFQDN <*> getFQDN <*> getFQDN
<*> arbitrary <*> arbitrary <*> arbitrary <*> getFQDN
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> getFQDN <*> arbitrary
<*> (Set.fromList <$> genTags)
instance Arbitrary Rpc.RpcCallAllInstancesInfo where
arbitrary = Rpc.RpcCallAllInstancesInfo <$> arbitrary
instance Arbitrary Rpc.RpcCallInstanceList where
arbitrary = Rpc.RpcCallInstanceList <$> arbitrary
instance Arbitrary Rpc.RpcCallNodeInfo where
arbitrary = Rpc.RpcCallNodeInfo <$> arbitrary <*> arbitrary
-- | Custom 'Qlang.Filter' generator (top-level), which enforces a
-- (sane) limit on the depth of the generated filters.
genFilter :: Gen (Qlang.Filter Qlang.FilterField)
......@@ -1976,36 +1919,6 @@ testSuite "Ssconf"
[ 'prop_Ssconf_filename
]
-- * Rpc tests
-- | Monadic check that, for an offline node and a call that does not
-- offline nodes, we get a OfflineNodeError response.
-- FIXME: We need a way of generalizing this, running it for
-- every call manually will soon get problematic
prop_Rpc_noffl_request_allinstinfo :: Rpc.RpcCallAllInstancesInfo -> Property
prop_Rpc_noffl_request_allinstinfo call =
forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
res <- run $ Rpc.executeRpcCall [node] call
stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
prop_Rpc_noffl_request_instlist :: Rpc.RpcCallInstanceList -> Property
prop_Rpc_noffl_request_instlist call =
forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
res <- run $ Rpc.executeRpcCall [node] call
stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
prop_Rpc_noffl_request_nodeinfo :: Rpc.RpcCallNodeInfo -> Property
prop_Rpc_noffl_request_nodeinfo call =
forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
res <- run $ Rpc.executeRpcCall [node] call
stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
testSuite "Rpc"
[ 'prop_Rpc_noffl_request_allinstinfo
, 'prop_Rpc_noffl_request_instlist
, 'prop_Rpc_noffl_request_nodeinfo
]
-- * Qlang tests
-- | Tests that serialisation/deserialisation of filters is
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment