root / htest / Test / Ganeti / Query / Query.hs @ 51000365
History | View | Annotate | Download (6.1 kB)
1 | b9bdc10e | Iustin Pop | {-# LANGUAGE TemplateHaskell #-} |
---|---|---|---|
2 | b9bdc10e | Iustin Pop | {-# OPTIONS_GHC -fno-warn-orphans #-} |
3 | b9bdc10e | Iustin Pop | |
4 | b9bdc10e | Iustin Pop | {-| Unittests for ganeti-htools. |
5 | b9bdc10e | Iustin Pop | |
6 | b9bdc10e | Iustin Pop | -} |
7 | b9bdc10e | Iustin Pop | |
8 | b9bdc10e | Iustin Pop | {- |
9 | b9bdc10e | Iustin Pop | |
10 | b9bdc10e | Iustin Pop | Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
11 | b9bdc10e | Iustin Pop | |
12 | b9bdc10e | Iustin Pop | This program is free software; you can redistribute it and/or modify |
13 | b9bdc10e | Iustin Pop | it under the terms of the GNU General Public License as published by |
14 | b9bdc10e | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
15 | b9bdc10e | Iustin Pop | (at your option) any later version. |
16 | b9bdc10e | Iustin Pop | |
17 | b9bdc10e | Iustin Pop | This program is distributed in the hope that it will be useful, but |
18 | b9bdc10e | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | b9bdc10e | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 | b9bdc10e | Iustin Pop | General Public License for more details. |
21 | b9bdc10e | Iustin Pop | |
22 | b9bdc10e | Iustin Pop | You should have received a copy of the GNU General Public License |
23 | b9bdc10e | Iustin Pop | along with this program; if not, write to the Free Software |
24 | b9bdc10e | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 | b9bdc10e | Iustin Pop | 02110-1301, USA. |
26 | b9bdc10e | Iustin Pop | |
27 | b9bdc10e | Iustin Pop | -} |
28 | b9bdc10e | Iustin Pop | |
29 | b9bdc10e | Iustin Pop | module Test.Ganeti.Query.Query (testQuery_Query) where |
30 | b9bdc10e | Iustin Pop | |
31 | b9bdc10e | Iustin Pop | import Test.HUnit (Assertion, assertEqual) |
32 | b9bdc10e | Iustin Pop | import Test.QuickCheck hiding (Result) |
33 | b9bdc10e | Iustin Pop | import Test.QuickCheck.Monadic |
34 | b9bdc10e | Iustin Pop | |
35 | b9bdc10e | Iustin Pop | import Data.Function (on) |
36 | b9bdc10e | Iustin Pop | import Data.List |
37 | b9bdc10e | Iustin Pop | import qualified Data.Map as Map |
38 | b9bdc10e | Iustin Pop | import Data.Maybe |
39 | b9bdc10e | Iustin Pop | import Text.JSON (JSValue(..)) |
40 | b9bdc10e | Iustin Pop | |
41 | b9bdc10e | Iustin Pop | import Test.Ganeti.TestHelper |
42 | b9bdc10e | Iustin Pop | import Test.Ganeti.TestCommon |
43 | b9bdc10e | Iustin Pop | import Test.Ganeti.Objects (genEmptyCluster) |
44 | b9bdc10e | Iustin Pop | |
45 | b9bdc10e | Iustin Pop | import Ganeti.BasicTypes |
46 | b9bdc10e | Iustin Pop | import Ganeti.Query.Language |
47 | b9bdc10e | Iustin Pop | import Ganeti.Query.Node |
48 | b9bdc10e | Iustin Pop | import Ganeti.Query.Query |
49 | b9bdc10e | Iustin Pop | |
50 | b9bdc10e | Iustin Pop | -- * Helpers |
51 | b9bdc10e | Iustin Pop | |
52 | b9bdc10e | Iustin Pop | -- | Checks if a list of field definitions contains unknown fields. |
53 | b9bdc10e | Iustin Pop | hasUnknownFields :: [FieldDefinition] -> Bool |
54 | b9bdc10e | Iustin Pop | hasUnknownFields = (QFTUnknown `notElem`) . map fdefKind |
55 | b9bdc10e | Iustin Pop | |
56 | b9bdc10e | Iustin Pop | -- * Test cases |
57 | b9bdc10e | Iustin Pop | |
58 | b9bdc10e | Iustin Pop | -- | Tests that querying any existing fields, via either query or |
59 | b9bdc10e | Iustin Pop | -- queryFields, will not return unknown fields. |
60 | b9bdc10e | Iustin Pop | prop_queryNode_noUnknown :: Property |
61 | b9bdc10e | Iustin Pop | prop_queryNode_noUnknown = |
62 | b9bdc10e | Iustin Pop | forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster -> |
63 | b9bdc10e | Iustin Pop | forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do |
64 | b9bdc10e | Iustin Pop | QueryResult fdefs fdata <- |
65 | b9bdc10e | Iustin Pop | run (query cluster (Query QRNode [field] EmptyFilter)) >>= resultProp |
66 | b9bdc10e | Iustin Pop | QueryFieldsResult fdefs' <- |
67 | b9bdc10e | Iustin Pop | resultProp $ queryFields (QueryFields QRNode [field]) |
68 | b9bdc10e | Iustin Pop | stop $ printTestCase ("Got unknown fields via query (" ++ show fdefs ++ ")") |
69 | b9bdc10e | Iustin Pop | (hasUnknownFields fdefs) .&&. |
70 | b9bdc10e | Iustin Pop | printTestCase ("Got unknown result status via query (" ++ |
71 | b9bdc10e | Iustin Pop | show fdata ++ ")") |
72 | b9bdc10e | Iustin Pop | (all (all ((/= RSUnknown) . rentryStatus)) fdata) .&&. |
73 | b9bdc10e | Iustin Pop | printTestCase ("Got unknown fields via query fields (" ++ show fdefs' |
74 | b9bdc10e | Iustin Pop | ++ ")") (hasUnknownFields fdefs') |
75 | b9bdc10e | Iustin Pop | |
76 | b9bdc10e | Iustin Pop | -- | Tests that an unknown field is returned as such. |
77 | b9bdc10e | Iustin Pop | prop_queryNode_Unknown :: Property |
78 | b9bdc10e | Iustin Pop | prop_queryNode_Unknown = |
79 | b9bdc10e | Iustin Pop | forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster -> |
80 | b9bdc10e | Iustin Pop | forAll (arbitrary `suchThat` (`notElem` (Map.keys nodeFieldsMap))) |
81 | b9bdc10e | Iustin Pop | $ \field -> monadicIO $ do |
82 | b9bdc10e | Iustin Pop | QueryResult fdefs fdata <- |
83 | b9bdc10e | Iustin Pop | run (query cluster (Query QRNode [field] EmptyFilter)) >>= resultProp |
84 | b9bdc10e | Iustin Pop | QueryFieldsResult fdefs' <- |
85 | b9bdc10e | Iustin Pop | resultProp $ queryFields (QueryFields QRNode [field]) |
86 | b9bdc10e | Iustin Pop | stop $ printTestCase ("Got known fields via query (" ++ show fdefs ++ ")") |
87 | b9bdc10e | Iustin Pop | (not $ hasUnknownFields fdefs) .&&. |
88 | b9bdc10e | Iustin Pop | printTestCase ("Got /= ResultUnknown result status via query (" ++ |
89 | b9bdc10e | Iustin Pop | show fdata ++ ")") |
90 | b9bdc10e | Iustin Pop | (all (all ((== RSUnknown) . rentryStatus)) fdata) .&&. |
91 | b9bdc10e | Iustin Pop | printTestCase ("Got a Just in a result value (" ++ |
92 | b9bdc10e | Iustin Pop | show fdata ++ ")") |
93 | b9bdc10e | Iustin Pop | (all (all (isNothing . rentryValue)) fdata) .&&. |
94 | b9bdc10e | Iustin Pop | printTestCase ("Got known fields via query fields (" ++ show fdefs' |
95 | b9bdc10e | Iustin Pop | ++ ")") (not $ hasUnknownFields fdefs') |
96 | b9bdc10e | Iustin Pop | |
97 | b9bdc10e | Iustin Pop | -- | Checks that a result type is conforming to a field definition. |
98 | b9bdc10e | Iustin Pop | checkResultType :: FieldDefinition -> ResultEntry -> Property |
99 | b9bdc10e | Iustin Pop | checkResultType _ (ResultEntry RSNormal Nothing) = |
100 | b9bdc10e | Iustin Pop | failTest "Nothing result in RSNormal field" |
101 | b9bdc10e | Iustin Pop | checkResultType _ (ResultEntry _ Nothing) = passTest |
102 | b9bdc10e | Iustin Pop | checkResultType fdef (ResultEntry RSNormal (Just v)) = |
103 | b9bdc10e | Iustin Pop | case (fdefKind fdef, v) of |
104 | b9bdc10e | Iustin Pop | (QFTText , JSString {}) -> passTest |
105 | b9bdc10e | Iustin Pop | (QFTBool , JSBool {}) -> passTest |
106 | b9bdc10e | Iustin Pop | (QFTNumber , JSRational {}) -> passTest |
107 | b9bdc10e | Iustin Pop | (QFTTimestamp , JSRational {}) -> passTest |
108 | b9bdc10e | Iustin Pop | (QFTUnit , JSRational {}) -> passTest |
109 | b9bdc10e | Iustin Pop | (QFTOther , _) -> passTest -- meh, QFT not precise... |
110 | b9bdc10e | Iustin Pop | (kind, _) -> failTest $ "Type mismatch, field definition says " ++ |
111 | b9bdc10e | Iustin Pop | show kind ++ " but returned value is " ++ show v ++ |
112 | b9bdc10e | Iustin Pop | " for field '" ++ fdefName fdef ++ "'" |
113 | b9bdc10e | Iustin Pop | checkResultType _ (ResultEntry r (Just _)) = |
114 | b9bdc10e | Iustin Pop | failTest $ "Just result in " ++ show r ++ " field" |
115 | b9bdc10e | Iustin Pop | |
116 | b9bdc10e | Iustin Pop | -- | Tests that querying any existing fields, the following three |
117 | b9bdc10e | Iustin Pop | -- properties hold: RSNormal corresponds to a Just value, any other |
118 | b9bdc10e | Iustin Pop | -- value corresponds to Nothing, and for a RSNormal and value field, |
119 | b9bdc10e | Iustin Pop | -- the type of the value corresponds to the type of the field as |
120 | b9bdc10e | Iustin Pop | -- declared in the FieldDefinition. |
121 | b9bdc10e | Iustin Pop | prop_queryNode_types :: Property |
122 | b9bdc10e | Iustin Pop | prop_queryNode_types = |
123 | b9bdc10e | Iustin Pop | forAll (choose (0, maxNodes)) $ \numnodes -> |
124 | b9bdc10e | Iustin Pop | forAll (genEmptyCluster numnodes) $ \cfg -> |
125 | b9bdc10e | Iustin Pop | forAll (elements (Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do |
126 | b9bdc10e | Iustin Pop | QueryResult fdefs fdata <- |
127 | b9bdc10e | Iustin Pop | run (query cfg (Query QRNode [field] EmptyFilter)) >>= resultProp |
128 | b9bdc10e | Iustin Pop | stop $ printTestCase ("Inconsistent result entries (" ++ show fdata ++ ")") |
129 | b9bdc10e | Iustin Pop | (conjoin $ map (conjoin . zipWith checkResultType fdefs) fdata) .&&. |
130 | b9bdc10e | Iustin Pop | printTestCase "Wrong field definitions length" |
131 | b9bdc10e | Iustin Pop | (length fdefs ==? 1) .&&. |
132 | b9bdc10e | Iustin Pop | printTestCase "Wrong field result rows length" |
133 | b9bdc10e | Iustin Pop | (all ((== 1) . length) fdata) .&&. |
134 | b9bdc10e | Iustin Pop | printTestCase "Wrong number of result rows" |
135 | b9bdc10e | Iustin Pop | (length fdata ==? numnodes) |
136 | b9bdc10e | Iustin Pop | |
137 | b9bdc10e | Iustin Pop | -- | Test that queryFields with empty fields list returns all node fields. |
138 | b9bdc10e | Iustin Pop | case_queryNode_allfields :: Assertion |
139 | b9bdc10e | Iustin Pop | case_queryNode_allfields = do |
140 | b9bdc10e | Iustin Pop | fdefs <- case queryFields (QueryFields QRNode []) of |
141 | b9bdc10e | Iustin Pop | Bad msg -> fail $ "Error in query all fields: " ++ msg |
142 | b9bdc10e | Iustin Pop | Ok (QueryFieldsResult v) -> return v |
143 | b9bdc10e | Iustin Pop | let field_sort = compare `on` fdefName |
144 | b9bdc10e | Iustin Pop | assertEqual "Mismatch in all fields list" |
145 | b9bdc10e | Iustin Pop | (sortBy field_sort . map fst $ Map.elems nodeFieldsMap) |
146 | b9bdc10e | Iustin Pop | (sortBy field_sort fdefs) |
147 | b9bdc10e | Iustin Pop | |
148 | b9bdc10e | Iustin Pop | testSuite "Query/Query" |
149 | b9bdc10e | Iustin Pop | [ 'prop_queryNode_noUnknown |
150 | b9bdc10e | Iustin Pop | , 'prop_queryNode_Unknown |
151 | b9bdc10e | Iustin Pop | , 'prop_queryNode_types |
152 | b9bdc10e | Iustin Pop | , 'case_queryNode_allfields |
153 | b9bdc10e | Iustin Pop | ] |