Commit eb84f8ae authored by Petr Pudlak's avatar Petr Pudlak

Add equality and serialization tests for MultiMap

We verify that 'readJSON . showJSON == Ok' and that maps are equal iff
keys map to the same values.
Signed-off-by: default avatarPetr Pudlak <pudlak@google.com>
Reviewed-by: default avatarKlaus Aehlig <aehlig@google.com>
parent 904edb90
......@@ -943,6 +943,7 @@ HS_TEST_SRCS = \
test/hs/Test/Ganeti/TestHelper.hs \
test/hs/Test/Ganeti/Types.hs \
test/hs/Test/Ganeti/Utils.hs \
test/hs/Test/Ganeti/Utils/MultiMap.hs \
test/hs/Test/Ganeti/Utils/Statistics.hs
......
......@@ -30,6 +30,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.Utils.MultiMap
( MultiMap()
, multiMap
, multiMapL
, multiMapValueL
, null
......@@ -73,6 +74,10 @@ instance (J.JSON k, Ord k, J.JSON v, Ord v) => J.JSON (MultiMap k v) where
showJSON = J.showJSON . getMultiMap
readJSON = liftM MultiMap . J.readJSON
-- | Creates a multi-map from a map of sets.
multiMap :: (Ord k, Ord v) => M.Map k (S.Set v) -> MultiMap k v
multiMap = MultiMap . M.filter (not . S.null)
-- | A 'Lens' that allows to access a set under a given key in a multi-map.
multiMapL :: (Ord k, Ord v) => k -> Lens' (MultiMap k v) (S.Set v)
multiMapL k f = fmap MultiMap
......
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for mutli-maps
-}
{-
Copyright (C) 2014 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.Utils.MultiMap
( testUtils_MultiMap
) where
import Control.Applicative
import qualified Data.Set as S
import qualified Data.Map as M
import Test.QuickCheck
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Ganeti.Utils.MultiMap as MM
instance (Arbitrary k, Ord k, Arbitrary v, Ord v)
=> Arbitrary (MultiMap k v) where
arbitrary =
let set = S.fromList <$> listOf arbitrary
in (multiMap . M.fromList) <$> listOf ((,) <$> arbitrary <*> set)
-- | A data type for testing extensional equality.
data Three = One | Two | Three
deriving (Eq, Ord, Show, Enum, Bounded)
instance Arbitrary Three where
arbitrary = elements [minBound..maxBound]
-- | Tests the extensional equality of multi-maps.
prop_MultiMap_equality
:: MultiMap Three Three -> MultiMap Three Three -> Property
prop_MultiMap_equality m1 m2 =
let testKey k = MM.lookup k m1 == MM.lookup k m2
in printTestCase ("Extensional equality of '" ++ show m1
++ "' and '" ++ show m2 ++ " doesn't match '=='.")
$ all testKey [minBound..maxBound] ==? (m1 == m2)
prop_MultiMap_serialisation :: MultiMap Int Int -> Property
prop_MultiMap_serialisation = testSerialisation
testSuite "Utils/MultiMap"
[ 'prop_MultiMap_equality
, 'prop_MultiMap_serialisation
]
......@@ -81,6 +81,7 @@ import Test.Ganeti.THH
import Test.Ganeti.THH.Types
import Test.Ganeti.Types
import Test.Ganeti.Utils
import Test.Ganeti.Utils.MultiMap
import Test.Ganeti.Utils.Statistics
-- | Our default test options, overring the built-in test-framework
......@@ -148,6 +149,7 @@ allTests =
, testTHH_Types
, testTypes
, testUtils
, testUtils_MultiMap
, testUtils_Statistics
]
......
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