Hi! thanks for the reviews.
On Thu, Feb 14, 2013 at 11:31 AM, Michele Tartara <[email protected]>wrote: > 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. :) >> > Oops. ;) > >> > +-} >> > + >> > +{- >> > + >> > +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) >> > Sure. > >> > +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. > I was not happy about this either. I will take care of that. > > >> >> > +-- | 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? >> > See above, I will consolidate it. > >> >> > +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? >> > The way the getGroupConnection is invoked in the code, this should not happen, but it is a valid failure case of this particular function of course. >> > +-- | 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 >> > > I also found a small bug in the tests. I will resend the patch when I have fixed all issues. Cheers, Helga
