We verify that 'readJSON . showJSON == Ok' and that maps are equal iff keys map to the same values.
Signed-off-by: Petr Pudlak <[email protected]> --- Makefile.am | 1 + src/Ganeti/Utils/MultiMap.hs | 5 +++ test/hs/Test/Ganeti/Utils/MultiMap.hs | 72 +++++++++++++++++++++++++++++++++++ test/hs/htest.hs | 2 + 4 files changed, 80 insertions(+) create mode 100644 test/hs/Test/Ganeti/Utils/MultiMap.hs diff --git a/Makefile.am b/Makefile.am index cfc4cab..cee824f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -942,6 +942,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 diff --git a/src/Ganeti/Utils/MultiMap.hs b/src/Ganeti/Utils/MultiMap.hs index 714f9d2..fcd892e 100644 --- a/src/Ganeti/Utils/MultiMap.hs +++ b/src/Ganeti/Utils/MultiMap.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 diff --git a/test/hs/Test/Ganeti/Utils/MultiMap.hs b/test/hs/Test/Ganeti/Utils/MultiMap.hs new file mode 100644 index 0000000..19b911e --- /dev/null +++ b/test/hs/Test/Ganeti/Utils/MultiMap.hs @@ -0,0 +1,72 @@ +{-# 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 + ] diff --git a/test/hs/htest.hs b/test/hs/htest.hs index a50ca98..05d1707 100644 --- a/test/hs/htest.hs +++ b/test/hs/htest.hs @@ -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 ] -- 2.0.0.526.g5318336
