Commit b9bdc10e authored by Iustin Pop's avatar Iustin Pop
Browse files

Add some unittests for node queries



These new tests check that:

- no known fields return unknown
- any unknown field returns unknown
- the type of the fields is consistent between the getters and the
  field definition
- the length of each result row corresponds with the number of fields
  queried, and the length of the field definitions returned
- the length of the rows corresponds to the number of nodes
- querying fields on empty fields returns all fields

Finally this patch found a bug, in that the pinst_list/sinst_list
fields were declared as QFTNumber (copy-paste error from
pinst_cnt/sinst_cnt), yay!

I also changed genEmptyCluster to ensure that it generates unique node
names, so that the number of result rows is consistent with what we
requested, and switched ResultEntry from a normal constructor to
record syntax, so that we can extract the fields without having to use
pattern matching.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarRené Nussbaumer <rn@google.com>
parent 2e0bb81d
...@@ -457,6 +457,7 @@ HS_TEST_SRCS = \ ...@@ -457,6 +457,7 @@ HS_TEST_SRCS = \
htest/Test/Ganeti/Objects.hs \ htest/Test/Ganeti/Objects.hs \
htest/Test/Ganeti/OpCodes.hs \ htest/Test/Ganeti/OpCodes.hs \
htest/Test/Ganeti/Query/Language.hs \ htest/Test/Ganeti/Query/Language.hs \
htest/Test/Ganeti/Query/Query.hs \
htest/Test/Ganeti/Rpc.hs \ htest/Test/Ganeti/Rpc.hs \
htest/Test/Ganeti/Ssconf.hs \ htest/Test/Ganeti/Ssconf.hs \
htest/Test/Ganeti/TestCommon.hs \ htest/Test/Ganeti/TestCommon.hs \
......
...@@ -177,7 +177,9 @@ genEmptyCluster ncount = do ...@@ -177,7 +177,9 @@ genEmptyCluster ncount = do
nodes <- vector ncount nodes <- vector ncount
version <- arbitrary version <- arbitrary
let guuid = "00" let guuid = "00"
nodes' = map (\n -> n { nodeGroup = guuid }) nodes nodes' = zipWith (\n idx -> n { nodeGroup = guuid,
nodeName = nodeName n ++ show idx })
nodes [(1::Int)..]
contnodes = Container . Map.fromList $ map (\n -> (nodeName n, n)) nodes' contnodes = Container . Map.fromList $ map (\n -> (nodeName n, n)) nodes'
continsts = Container $ Map.empty continsts = Container $ Map.empty
grp <- arbitrary grp <- arbitrary
......
{-# 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.Query.Query (testQuery_Query) where
import Test.HUnit (Assertion, assertEqual)
import Test.QuickCheck hiding (Result)
import Test.QuickCheck.Monadic
import Data.Function (on)
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import Text.JSON (JSValue(..))
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.Objects (genEmptyCluster)
import Ganeti.BasicTypes
import Ganeti.Query.Language
import Ganeti.Query.Node
import Ganeti.Query.Query
-- * Helpers
-- | Checks if a list of field definitions contains unknown fields.
hasUnknownFields :: [FieldDefinition] -> Bool
hasUnknownFields = (QFTUnknown `notElem`) . map fdefKind
-- * Test cases
-- | Tests that querying any existing fields, via either query or
-- queryFields, will not return unknown fields.
prop_queryNode_noUnknown :: Property
prop_queryNode_noUnknown =
forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cluster (Query QRNode [field] EmptyFilter)) >>= resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRNode [field])
stop $ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")")
(hasUnknownFields fdefs) .&&.
printTestCase ("Got unknown result status via query (" ++
show fdata ++ ")")
(all (all ((/= RSUnknown) . rentryStatus)) fdata) .&&.
printTestCase ("Got unknown fields via query fields (" ++ show fdefs'
++ ")") (hasUnknownFields fdefs')
-- | Tests that an unknown field is returned as such.
prop_queryNode_Unknown :: Property
prop_queryNode_Unknown =
forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster ->
forAll (arbitrary `suchThat` (`notElem` (Map.keys nodeFieldsMap)))
$ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cluster (Query QRNode [field] EmptyFilter)) >>= resultProp
QueryFieldsResult fdefs' <-
resultProp $ queryFields (QueryFields QRNode [field])
stop $ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")")
(not $ hasUnknownFields fdefs) .&&.
printTestCase ("Got /= ResultUnknown result status via query (" ++
show fdata ++ ")")
(all (all ((== RSUnknown) . rentryStatus)) fdata) .&&.
printTestCase ("Got a Just in a result value (" ++
show fdata ++ ")")
(all (all (isNothing . rentryValue)) fdata) .&&.
printTestCase ("Got known fields via query fields (" ++ show fdefs'
++ ")") (not $ hasUnknownFields fdefs')
-- | Checks that a result type is conforming to a field definition.
checkResultType :: FieldDefinition -> ResultEntry -> Property
checkResultType _ (ResultEntry RSNormal Nothing) =
failTest "Nothing result in RSNormal field"
checkResultType _ (ResultEntry _ Nothing) = passTest
checkResultType fdef (ResultEntry RSNormal (Just v)) =
case (fdefKind fdef, v) of
(QFTText , JSString {}) -> passTest
(QFTBool , JSBool {}) -> passTest
(QFTNumber , JSRational {}) -> passTest
(QFTTimestamp , JSRational {}) -> passTest
(QFTUnit , JSRational {}) -> passTest
(QFTOther , _) -> passTest -- meh, QFT not precise...
(kind, _) -> failTest $ "Type mismatch, field definition says " ++
show kind ++ " but returned value is " ++ show v ++
" for field '" ++ fdefName fdef ++ "'"
checkResultType _ (ResultEntry r (Just _)) =
failTest $ "Just result in " ++ show r ++ " field"
-- | Tests that querying any existing fields, the following three
-- properties hold: RSNormal corresponds to a Just value, any other
-- value corresponds to Nothing, and for a RSNormal and value field,
-- the type of the value corresponds to the type of the field as
-- declared in the FieldDefinition.
prop_queryNode_types :: Property
prop_queryNode_types =
forAll (choose (0, maxNodes)) $ \numnodes ->
forAll (genEmptyCluster numnodes) $ \cfg ->
forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do
QueryResult fdefs fdata <-
run (query cfg (Query QRNode [field] EmptyFilter)) >>= resultProp
stop $ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")")
(conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) .&&.
printTestCase "Wrong field definitions length"
(length fdefs ==? 1) .&&.
printTestCase "Wrong field result rows length"
(all ((== 1) . length) fdata) .&&.
printTestCase "Wrong number of result rows"
(length fdata ==? numnodes)
-- | Test that queryFields with empty fields list returns all node fields.
case_queryNode_allfields :: Assertion
case_queryNode_allfields = do
fdefs <- case queryFields (QueryFields QRNode []) of
Bad msg -> fail $ "Error in query all fields: " ++ msg
Ok (QueryFieldsResult v) -> return v
let field_sort = compare `on` fdefName
assertEqual "Mismatch in all fields list"
(sortBy field_sort . map fst $ Map.elems nodeFieldsMap)
(sortBy field_sort fdefs)
testSuite "Query/Query"
[ 'prop_queryNode_noUnknown
, 'prop_queryNode_Unknown
, 'prop_queryNode_types
, 'case_queryNode_allfields
]
...@@ -31,12 +31,15 @@ import Control.Monad ...@@ -31,12 +31,15 @@ import Control.Monad
import Data.List import Data.List
import qualified Test.HUnit as HUnit import qualified Test.HUnit as HUnit
import Test.QuickCheck import Test.QuickCheck
import Test.QuickCheck.Monadic
import qualified Text.JSON as J import qualified Text.JSON as J
import System.Environment (getEnv) import System.Environment (getEnv)
import System.Exit (ExitCode(..)) import System.Exit (ExitCode(..))
import System.IO.Error (isDoesNotExistError) import System.IO.Error (isDoesNotExistError)
import System.Process (readProcessWithExitCode) import System.Process (readProcessWithExitCode)
import qualified Ganeti.BasicTypes as BasicTypes
-- * Constants -- * Constants
-- | Maximum memory (1TiB, somewhat random value). -- | Maximum memory (1TiB, somewhat random value).
...@@ -199,3 +202,8 @@ testSerialisation a = ...@@ -199,3 +202,8 @@ testSerialisation a =
case J.readJSON (J.showJSON a) of case J.readJSON (J.showJSON a) of
J.Error msg -> failTest $ "Failed to deserialise: " ++ msg J.Error msg -> failTest $ "Failed to deserialise: " ++ msg
J.Ok a' -> a ==? a' J.Ok a' -> a ==? a'
-- | Result to PropertyM IO.
resultProp :: BasicTypes.Result a -> PropertyM IO a
resultProp (BasicTypes.Bad msg) = stop $ failTest msg
resultProp (BasicTypes.Ok val) = return val
...@@ -49,6 +49,7 @@ import Test.Ganeti.Luxi ...@@ -49,6 +49,7 @@ import Test.Ganeti.Luxi
import Test.Ganeti.Objects import Test.Ganeti.Objects
import Test.Ganeti.OpCodes import Test.Ganeti.OpCodes
import Test.Ganeti.Query.Language import Test.Ganeti.Query.Language
import Test.Ganeti.Query.Query
import Test.Ganeti.Rpc import Test.Ganeti.Rpc
import Test.Ganeti.Ssconf import Test.Ganeti.Ssconf
...@@ -92,6 +93,7 @@ allTests = ...@@ -92,6 +93,7 @@ allTests =
, (True, testObjects) , (True, testObjects)
, (True, testOpCodes) , (True, testOpCodes)
, (True, testQuery_Language) , (True, testQuery_Language)
, (True, testQuery_Query)
, (True, testRpc) , (True, testRpc)
, (True, testSsconf) , (True, testSsconf)
, (False, testHTools_Cluster) , (False, testHTools_Cluster)
......
...@@ -336,8 +336,10 @@ $(buildObject "FieldDefinition" "fdef" ...@@ -336,8 +336,10 @@ $(buildObject "FieldDefinition" "fdef"
]) ])
--- | Single field entry result. --- | Single field entry result.
data ResultEntry = ResultEntry ResultStatus (Maybe ResultValue) data ResultEntry = ResultEntry
deriving (Show, Read, Eq) { rentryStatus :: ResultStatus -- ^ The result status
, rentryValue :: Maybe ResultValue -- ^ The (optional) result value
} deriving (Show, Read, Eq)
instance JSON ResultEntry where instance JSON ResultEntry where
showJSON (ResultEntry rs rv) = showJSON (ResultEntry rs rv) =
......
...@@ -128,11 +128,11 @@ nodeFields = ...@@ -128,11 +128,11 @@ nodeFields =
"Number of instances with this node as secondary", "Number of instances with this node as secondary",
FieldConfig (\cfg -> FieldConfig (\cfg ->
rsNormal . length . snd . getNodeInstances cfg . nodeName)) rsNormal . length . snd . getNodeInstances cfg . nodeName))
, (FieldDefinition "pinst_list" "PriInstances" QFTNumber , (FieldDefinition "pinst_list" "PriInstances" QFTOther
"List of instances with this node as primary", "List of instances with this node as primary",
FieldConfig (\cfg -> rsNormal . map instName . fst . FieldConfig (\cfg -> rsNormal . map instName . fst .
getNodeInstances cfg . nodeName)) getNodeInstances cfg . nodeName))
, (FieldDefinition "sinst_list" "SecInstances" QFTNumber , (FieldDefinition "sinst_list" "SecInstances" QFTOther
"List of instances with this node as secondary", "List of instances with this node as secondary",
FieldConfig (\cfg -> rsNormal . map instName . snd . FieldConfig (\cfg -> rsNormal . map instName . snd .
getNodeInstances cfg . nodeName)) getNodeInstances cfg . nodeName))
......
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