Revision adb77e3a
| b/htools/Ganeti/HTools/QC.hs | ||
|---|---|---|
| 51 | 51 |
, testRpc |
| 52 | 52 |
, testQlang |
| 53 | 53 |
, testConfd |
| 54 |
, testObjects |
|
| 54 | 55 |
) where |
| 55 | 56 |
|
| 56 | 57 |
import qualified Test.HUnit as HUnit |
| ... | ... | |
| 2161 | 2162 |
[ 'prop_Confd_req_sign |
| 2162 | 2163 |
, 'prop_Confd_bad_key |
| 2163 | 2164 |
] |
| 2165 |
|
|
| 2166 |
-- * Objects tests |
|
| 2167 |
|
|
| 2168 |
-- | Tests that fillDict behaves correctly |
|
| 2169 |
prop_Objects_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property |
|
| 2170 |
prop_Objects_fillDict defaults custom = |
|
| 2171 |
let d_map = Map.fromList defaults |
|
| 2172 |
d_keys = map fst defaults |
|
| 2173 |
c_map = Map.fromList custom |
|
| 2174 |
c_keys = map fst custom |
|
| 2175 |
in printTestCase "Empty custom filling" |
|
| 2176 |
(Objects.fillDict d_map Map.empty [] == d_map) .&&. |
|
| 2177 |
printTestCase "Empty defaults filling" |
|
| 2178 |
(Objects.fillDict Map.empty c_map [] == c_map) .&&. |
|
| 2179 |
printTestCase "Delete all keys" |
|
| 2180 |
(Objects.fillDict d_map c_map (d_keys++c_keys) == Map.empty) |
|
| 2181 |
|
|
| 2182 |
testSuite "Objects" |
|
| 2183 |
[ 'prop_Objects_fillDict |
|
| 2184 |
] |
|
| b/htools/Ganeti/Objects.hs | ||
|---|---|---|
| 61 | 61 |
, NodeGroup(..) |
| 62 | 62 |
, IpFamily(..) |
| 63 | 63 |
, ipFamilyToVersion |
| 64 |
, fillDict |
|
| 64 | 65 |
, Cluster(..) |
| 65 | 66 |
, ConfigData(..) |
| 66 | 67 |
) where |
| 67 | 68 |
|
| 69 |
import Data.List (foldl') |
|
| 68 | 70 |
import Data.Maybe |
| 71 |
import qualified Data.Map as Map |
|
| 69 | 72 |
import Text.JSON (makeObj, showJSON, readJSON, JSON, JSValue(..)) |
| 70 | 73 |
import qualified Text.JSON as J |
| 71 | 74 |
|
| ... | ... | |
| 74 | 77 |
|
| 75 | 78 |
import Ganeti.THH |
| 76 | 79 |
|
| 80 |
-- * Generic definitions |
|
| 81 |
|
|
| 82 |
-- | Fills one map with keys from the other map, if not already |
|
| 83 |
-- existing. Mirrors objects.py:FillDict. |
|
| 84 |
fillDict :: (Ord k) => Map.Map k v -> Map.Map k v -> [k] -> Map.Map k v |
|
| 85 |
fillDict defaults custom skip_keys = |
|
| 86 |
let updated = Map.union custom defaults |
|
| 87 |
in foldl' (flip Map.delete) updated skip_keys |
|
| 88 |
|
|
| 77 | 89 |
-- * NIC definitions |
| 78 | 90 |
|
| 79 | 91 |
$(declareSADT "NICMode" |
| b/htools/test.hs | ||
|---|---|---|
| 71 | 71 |
, (True, testQlang) |
| 72 | 72 |
, (True, testRpc) |
| 73 | 73 |
, (True, testConfd) |
| 74 |
, (True, testObjects) |
|
| 74 | 75 |
, (False, testCluster) |
| 75 | 76 |
] |
| 76 | 77 |
|
Also available in: Unified diff