On Thu, Feb 14, 2013 at 11:16 AM, Guido Trotter <[email protected]>wrote:
> On Thu, Feb 14, 2013 at 11:02 AM, Helga Velroyen <[email protected]> > wrote: > > This patch adds a couple of unit tests for Query/Network.hs. > > Note that they'll need to be adapted, once issue 362 is addressed. > > > > Signed-off-by: Helga Velroyen <[email protected]> > > --- > > Makefile.am | 1 + > > src/Ganeti/Query/Network.hs | 11 ++- > > test/hs/Test/Ganeti/Query/Network.hs | 162 > +++++++++++++++++++++++++++++++++++ > > test/hs/htest.hs | 2 + > > 4 files changed, 173 insertions(+), 3 deletions(-) > > create mode 100644 test/hs/Test/Ganeti/Query/Network.hs > > > > diff --git a/Makefile.am b/Makefile.am > > index 7487044..c0a3a41 100644 > > --- a/Makefile.am > > +++ b/Makefile.am > > @@ -572,6 +572,7 @@ HS_TEST_SRCS = \ > > test/hs/Test/Ganeti/OpCodes.hs \ > > test/hs/Test/Ganeti/Query/Filter.hs \ > > test/hs/Test/Ganeti/Query/Language.hs \ > > + test/hs/Test/Ganeti/Query/Network.hs \ > > test/hs/Test/Ganeti/Query/Query.hs \ > > test/hs/Test/Ganeti/Rpc.hs \ > > test/hs/Test/Ganeti/Runtime.hs \ > > diff --git a/src/Ganeti/Query/Network.hs b/src/Ganeti/Query/Network.hs > > index 2d262bf..a9c46c7 100644 > > --- a/src/Ganeti/Query/Network.hs > > +++ b/src/Ganeti/Query/Network.hs > > @@ -24,10 +24,16 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, > Boston, MA > > -} > > > > module Ganeti.Query.Network > > - ( NetworkRuntime(..) > > + ( getGroupConnection > > + , getNetworkUuid > > + , instIsConnected > > + , NetworkRuntime(..) > > , networkFieldsMap > > ) where > > > > +-- FIXME: everything except NetworkRuntime(..) and networkFieldsMap > > +-- is only exported for testing. > > + > > import qualified Data.Map as Map > > import Data.Maybe (fromMaybe, mapMaybe) > > import Data.List (find) > > @@ -88,8 +94,7 @@ networkFieldsMap :: FieldMap Network NetworkRuntime > > networkFieldsMap = > > Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) networkFields > > > > --- TODO: the following fields are not implemented yet: > external_reservations, > > --- inst_cnt, inst_list > > +-- TODO: the following fields are not implemented yet: > external_reservations > > > > -- | Given a network's UUID, this function lists all connections from > > -- the network to nodegroups including the respective mode and links. > > diff --git a/test/hs/Test/Ganeti/Query/Network.hs > b/test/hs/Test/Ganeti/Query/Network.hs > > new file mode 100644 > > index 0000000..9573a88 > > --- /dev/null > > +++ b/test/hs/Test/Ganeti/Query/Network.hs > > @@ -0,0 +1,162 @@ > > +{-# LANGUAGE TemplateHaskell #-} > > +{-# OPTIONS_GHC -fno-warn-orphans #-} > > + > > +{-| Unittests for ganeti-htools. > > + > > Not quite. :) > > > +-} > > + > > +{- > > + > > +Copyright (C) 2013 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.Network > > + ( testQuery_Network > > + ) where > > + > > +import Ganeti.JSON > > +import Ganeti.Objects > > +import Ganeti.Query.Network > > +import Ganeti.Types > > + > > +import Test.Ganeti.Objects (genValidNetwork) > > +import Test.Ganeti.TestCommon > > +import Test.Ganeti.TestHelper > > + > > +import Test.QuickCheck > > + > > +import Control.Applicative > > +import qualified Data.List as List > > +import qualified Data.Map as Map > > +import qualified Data.Set as Set > > +import Data.Maybe > > + > > +-- | This generates config data with a couple of networks. > > Maybe "Generate a config data with a couple of networks." ? > ("this" is sort of implied) > > > +genConfigDataWithNetworks :: Gen ConfigData > > +genConfigDataWithNetworks = do > > + version <- arbitrary > > + cluster <- arbitrary > > + serial <- arbitrary > > + num_nets <- choose (0, 3) > > + nets <- vectorOf num_nets genValidNetwork > > + let nodes = GenericContainer Map.empty > > + nodegroups = GenericContainer Map.empty > > + instances = GenericContainer Map.empty > > + net_map = GenericContainer $ Map.fromList > > + (map (\n -> (networkUuid n, n)) nets) > > + cfg = ConfigData version cluster nodes nodegroups instances > net_map serial > > + return cfg > > + > > Meh, I wonder if we should have a central point generating config > datas "with caratheristics" rather than sprinkling them around the > test code. > > +1 test/hs/Test/Ganeti/TestCommon.hs already has quite a few. Maybe it could be the right place. > > > +-- | Generates an instance that is connected to the given networks > > +-- and possibly some other networks > > +genInstWithNets :: [String] -> Gen Instance > > +genInstWithNets nets = do > > + mac <- arbitrary > > + ip <- arbitrary > > + nicparams <- arbitrary > > + name <- genFQDN > > + pn <- genFQDN > > + os <- genName > > + hv <- arbitrary > > + hvparams <- pure (GenericContainer Map.empty) > > + beparams <- arbitrary > > + osparams <- pure (GenericContainer Map.empty) > > + admin_state <- arbitrary > > + disks <- arbitrary > > + disk_template <- arbitrary > > + network_port <- arbitrary > > + ctime <- arbitrary > > + mtime <- arbitrary > > + uuid <- arbitrary > > + serial <- arbitrary > > + tags <- genTags > > + -- generate some more networks than the given ones > > + num_more_nets <- choose (0,3) > > + more_nets <- vectorOf num_more_nets genName > > + let partial_nics = map (PartialNic mac ip nicparams . Just) > > + (nets `List.union` more_nets) > > + inst = Instance name pn os hv hvparams beparams osparams > admin_state > > + partial_nics disks disk_template network_port ctime > mtime uuid > > + serial (Set.fromList tags) > > + return inst > > + > > Here too: does it make sense to redo the instance generation, just to > alter one charactheristic? > > > > +instance Arbitrary ConfigData where > > + arbitrary = genConfigDataWithNetworks > > + > > +-- | Check if looking up a valid network ID of a nodegroup yields > > +-- a non-Nothing result. > > +prop_getGroupConnection :: NodeGroup -> Property > > +prop_getGroupConnection group = > > + let net_keys = (Map.keys . fromContainer . groupNetworks) group > > + in True ==? all > > + (\nk -> isJust (getGroupConnection nk group)) net_keys > > + > > +-- | Checks if looking up an ID of a non-existing network in a node > group > > +-- yields 'Nothing'. > > +prop_getGroupConnection_notFound :: NodeGroup -> String -> Property > > +prop_getGroupConnection_notFound group uuid = > > + let net_keys = (Map.keys . fromContainer . groupNetworks) group > > + in notElem uuid net_keys ==> isNothing (getGroupConnection uuid group) > > + > > This shouldn't happen, in real life, though, right? > > > +-- | Check if getting the network's UUID from the config actually gets > the > > +-- correct UUIDs. > > +prop_getNetworkUuid :: ConfigData -> Property > > +prop_getNetworkUuid cfg = > > + let nets = (Map.elems . fromContainer . configNetworks) cfg > > + in True ==? all > > + (\n -> fromJust (getNetworkUuid cfg ((fromNonEmpty . networkName) > n)) > > + == networkUuid n) nets > > + > > +-- | Check if trying to get a UUID of a non-existing networks results in > > +-- 'Nothing'. > > +prop_getNetworkUuid_notFound :: ConfigData -> String -> Property > > +prop_getNetworkUuid_notFound cfg uuid = > > + let net_keys = (Map.keys . fromContainer . configNetworks) cfg > > + in notElem uuid net_keys ==> isNothing (getNetworkUuid cfg uuid) > > + > > +-- | Checks whether actually connected instances are identified as such. > > +prop_instIsConnected :: ConfigData -> Property > > +prop_instIsConnected cfg = > > + let nets = (fromContainer . configNetworks) cfg > > + net_keys = Map.keys nets > > + net_names = map (fromNonEmpty . networkName) (Map.elems nets) > > + in forAll (genInstWithNets net_names) $ \inst -> > > + True ==? all (\nk -> instIsConnected cfg nk inst) net_keys > > + > > +-- | Tests whether instances that are not connected to a network are > > +-- correctly classified as such. > > +prop_instIsConnected_notFound :: ConfigData -> String -> Property > > +prop_instIsConnected_notFound cfg network_uuid = > > + let nets = (fromContainer . configNetworks) cfg > > + net_keys = Map.keys nets > > + net_names = map (fromNonEmpty . networkName) (Map.elems nets) > > + in notElem network_uuid net_keys ==> > > + forAll (genInstWithNets net_names) $ \inst -> > > + not (instIsConnected cfg network_uuid inst) > > + > > +testSuite "Query_Network" > > + [ 'prop_getNetworkUuid > > + , 'prop_getNetworkUuid_notFound > > + , 'prop_getGroupConnection > > + , 'prop_getGroupConnection_notFound > > + , 'prop_instIsConnected > > + , 'prop_instIsConnected_notFound > > + ] > > + > > + > > diff --git a/test/hs/htest.hs b/test/hs/htest.hs > > index c2791f3..8ed7f61 100644 > > --- a/test/hs/htest.hs > > +++ b/test/hs/htest.hs > > @@ -60,6 +60,7 @@ import Test.Ganeti.Objects > > import Test.Ganeti.OpCodes > > import Test.Ganeti.Query.Filter > > import Test.Ganeti.Query.Language > > +import Test.Ganeti.Query.Network > > import Test.Ganeti.Query.Query > > import Test.Ganeti.Rpc > > import Test.Ganeti.Runtime > > @@ -112,6 +113,7 @@ allTests = > > , testOpCodes > > , testQuery_Filter > > , testQuery_Language > > + , testQuery_Network > > , testQuery_Query > > , testRpc > > , testRuntime > > -- > > 1.8.1 > > > > Thanks, > > Guido >
