Commit e1ee7d5a authored by Iustin Pop's avatar Iustin Pop

Split most HTools test code into separate files

Except for Ganeti.HTools.JSON, which needs rename, we split all the
other test suites into separate files.

We have to add another common test helper, due to import dependencies
(sigh), but otherwise this split is pretty straightforward.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarRené Nussbaumer <rn@google.com>
parent aed2325f
......@@ -64,6 +64,7 @@ HTOOLS_DIRS = \
htest/Test \
htest/Test/Ganeti \
htest/Test/Ganeti/Confd \
htest/Test/Ganeti/HTools \
htest/Test/Ganeti/Query
DIRS = \
......@@ -378,8 +379,9 @@ HPCEXCL = --exclude Main \
--exclude Ganeti.THH \
--exclude Ganeti.HTools.QC \
--exclude Ganeti.HTools.Version \
--exclude Test.Ganeti.TestHelper \
--exclude Test.Ganeti.TestCommon \
--exclude Test.Ganeti.TestHTools \
--exclude Test.Ganeti.TestHelper \
$(patsubst htools.%,--exclude Test.%,$(subst /,.,$(patsubst %.hs,%, $(filter-out htest/%,$(HS_LIB_SRCS)))))
HS_LIB_SRCS = \
......@@ -432,15 +434,27 @@ HS_LIB_SRCS = \
htools/Ganeti/Runtime.hs \
htools/Ganeti/Ssconf.hs \
htools/Ganeti/THH.hs \
htest/Test/Ganeti/TestHelper.hs \
htest/Test/Ganeti/TestCommon.hs \
htest/Test/Ganeti/Confd/Utils.hs \
htest/Test/Ganeti/HTools/CLI.hs \
htest/Test/Ganeti/HTools/Cluster.hs \
htest/Test/Ganeti/HTools/Container.hs \
htest/Test/Ganeti/HTools/Instance.hs \
htest/Test/Ganeti/HTools/Loader.hs \
htest/Test/Ganeti/HTools/Node.hs \
htest/Test/Ganeti/HTools/PeerMap.hs \
htest/Test/Ganeti/HTools/Simu.hs \
htest/Test/Ganeti/HTools/Text.hs \
htest/Test/Ganeti/HTools/Types.hs \
htest/Test/Ganeti/HTools/Utils.hs \
htest/Test/Ganeti/Luxi.hs \
htest/Test/Ganeti/Objects.hs \
htest/Test/Ganeti/OpCodes.hs \
htest/Test/Ganeti/Query/Language.hs \
htest/Test/Ganeti/Rpc.hs \
htest/Test/Ganeti/Ssconf.hs
htest/Test/Ganeti/Ssconf.hs \
htest/Test/Ganeti/TestCommon.hs \
htest/Test/Ganeti/TestHTools.hs \
htest/Test/Ganeti/TestHelper.hs
HS_BUILT_SRCS = htools/Ganeti/HTools/Version.hs htools/Ganeti/Constants.hs
......
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for ganeti-htools.
-}
{-
Copyright (C) 2009, 2010, 2011, 2012 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.HTools.CLI (testCLI) where
import Test.QuickCheck
import Control.Monad
import Data.List
import Text.Printf (printf)
import qualified System.Console.GetOpt as GetOpt
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import qualified Ganeti.HTools.CLI as CLI
import qualified Ganeti.HTools.Program as Program
import qualified Ganeti.HTools.Types as Types
-- | Test correct parsing.
prop_CLI_parseISpec :: String -> Int -> Int -> Int -> Property
prop_CLI_parseISpec descr dsk mem cpu =
let str = printf "%d,%d,%d" dsk mem cpu::String
in CLI.parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk)
-- | Test parsing failure due to wrong section count.
prop_CLI_parseISpecFail :: String -> Property
prop_CLI_parseISpecFail descr =
forAll (choose (0,100) `suchThat` ((/=) 3)) $ \nelems ->
forAll (replicateM nelems arbitrary) $ \values ->
let str = intercalate "," $ map show (values::[Int])
in case CLI.parseISpecString descr str of
Types.Ok v -> failTest $ "Expected failure, got " ++ show v
_ -> property True
-- | Test parseYesNo.
prop_CLI_parseYesNo :: Bool -> Bool -> [Char] -> Property
prop_CLI_parseYesNo def testval val =
forAll (elements [val, "yes", "no"]) $ \actual_val ->
if testval
then CLI.parseYesNo def Nothing ==? Types.Ok def
else let result = CLI.parseYesNo def (Just actual_val)
in if actual_val `elem` ["yes", "no"]
then result ==? Types.Ok (actual_val == "yes")
else property $ Types.isBad result
-- | Helper to check for correct parsing of string arg.
checkStringArg :: [Char]
-> (GetOpt.OptDescr (CLI.Options -> Types.Result CLI.Options),
CLI.Options -> Maybe [Char])
-> Property
checkStringArg val (opt, fn) =
let GetOpt.Option _ longs _ _ = opt
in case longs of
[] -> failTest "no long options?"
cmdarg:_ ->
case CLI.parseOptsInner ["--" ++ cmdarg ++ "=" ++ val] "prog" [opt] of
Left e -> failTest $ "Failed to parse option: " ++ show e
Right (options, _) -> fn options ==? Just val
-- | Test a few string arguments.
prop_CLI_StringArg :: [Char] -> Property
prop_CLI_StringArg argument =
let args = [ (CLI.oDataFile, CLI.optDataFile)
, (CLI.oDynuFile, CLI.optDynuFile)
, (CLI.oSaveCluster, CLI.optSaveCluster)
, (CLI.oReplay, CLI.optReplay)
, (CLI.oPrintCommands, CLI.optShowCmds)
, (CLI.oLuxiSocket, CLI.optLuxi)
]
in conjoin $ map (checkStringArg argument) args
-- | Helper to test that a given option is accepted OK with quick exit.
checkEarlyExit :: String -> [CLI.OptType] -> String -> Property
checkEarlyExit name options param =
case CLI.parseOptsInner [param] name options of
Left (code, _) -> if code == 0
then property True
else failTest $ "Program " ++ name ++
" returns invalid code " ++ show code ++
" for option " ++ param
_ -> failTest $ "Program " ++ name ++ " doesn't consider option " ++
param ++ " as early exit one"
-- | Test that all binaries support some common options. There is
-- nothing actually random about this test...
prop_CLI_stdopts :: Property
prop_CLI_stdopts =
let params = ["-h", "--help", "-V", "--version"]
opts = map (\(name, (_, o)) -> (name, o)) Program.personalities
-- apply checkEarlyExit across the cartesian product of params and opts
in conjoin [checkEarlyExit n o p | p <- params, (n, o) <- opts]
testSuite "CLI"
[ 'prop_CLI_parseISpec
, 'prop_CLI_parseISpecFail
, 'prop_CLI_parseYesNo
, 'prop_CLI_StringArg
, 'prop_CLI_stdopts
]
This diff is collapsed.
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for ganeti-htools.
-}
{-
Copyright (C) 2009, 2010, 2011, 2012 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.HTools.Container (testContainer) where
import Test.QuickCheck
import Data.Maybe
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.TestHTools
import Test.Ganeti.HTools.Node (genNode)
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Node as Node
-- we silence the following due to hlint bug fixed in later versions
{-# ANN prop_Container_addTwo "HLint: ignore Avoid lambda" #-}
prop_Container_addTwo :: [Container.Key] -> Int -> Int -> Bool
prop_Container_addTwo cdata i1 i2 =
fn i1 i2 cont == fn i2 i1 cont &&
fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
where cont = foldl (\c x -> Container.add x x c) Container.empty cdata
fn x1 x2 = Container.addTwo x1 x1 x2 x2
prop_Container_nameOf :: Node.Node -> Property
prop_Container_nameOf node =
let nl = makeSmallCluster node 1
fnode = head (Container.elems nl)
in Container.nameOf nl (Node.idx fnode) ==? Node.name fnode
-- | We test that in a cluster, given a random node, we can find it by
-- its name and alias, as long as all names and aliases are unique,
-- and that we fail to find a non-existing name.
prop_Container_findByName :: Property
prop_Container_findByName =
forAll (genNode (Just 1) Nothing) $ \node ->
forAll (choose (1, 20)) $ \ cnt ->
forAll (choose (0, cnt - 1)) $ \ fidx ->
forAll (genUniquesList (cnt * 2)) $ \ allnames ->
forAll (arbitrary `suchThat` (`notElem` allnames)) $ \ othername ->
let names = zip (take cnt allnames) (drop cnt allnames)
nl = makeSmallCluster node cnt
nodes = Container.elems nl
nodes' = map (\((name, alias), nn) -> (Node.idx nn,
nn { Node.name = name,
Node.alias = alias }))
$ zip names nodes
nl' = Container.fromList nodes'
target = snd (nodes' !! fidx)
in Container.findByName nl' (Node.name target) ==? Just target .&&.
Container.findByName nl' (Node.alias target) ==? Just target .&&.
printTestCase "Found non-existing name"
(isNothing (Container.findByName nl' othername))
testSuite "Container"
[ 'prop_Container_addTwo
, 'prop_Container_nameOf
, 'prop_Container_findByName
]
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for ganeti-htools.
-}
{-
Copyright (C) 2009, 2010, 2011, 2012 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.HTools.Instance
( testInstance
, genInstanceSmallerThanNode
, Instance.Instance(..)
) where
import Test.QuickCheck
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.HTools.Types ()
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Types as Types
-- * Arbitrary instances
-- | Generates a random instance with maximum disk/mem/cpu values.
genInstanceSmallerThan :: Int -> Int -> Int -> Gen Instance.Instance
genInstanceSmallerThan lim_mem lim_dsk lim_cpu = do
name <- getFQDN
mem <- choose (0, lim_mem)
dsk <- choose (0, lim_dsk)
run_st <- arbitrary
pn <- arbitrary
sn <- arbitrary
vcpus <- choose (0, lim_cpu)
dt <- arbitrary
return $ Instance.create name mem dsk vcpus run_st [] True pn sn dt 1
-- | Generates an instance smaller than a node.
genInstanceSmallerThanNode :: Node.Node -> Gen Instance.Instance
genInstanceSmallerThanNode node =
genInstanceSmallerThan (Node.availMem node `div` 2)
(Node.availDisk node `div` 2)
(Node.availCpu node `div` 2)
-- let's generate a random instance
instance Arbitrary Instance.Instance where
arbitrary = genInstanceSmallerThan maxMem maxDsk maxCpu
-- * Test cases
-- Simple instance tests, we only have setter/getters
prop_Instance_creat :: Instance.Instance -> Property
prop_Instance_creat inst =
Instance.name inst ==? Instance.alias inst
prop_Instance_setIdx :: Instance.Instance -> Types.Idx -> Property
prop_Instance_setIdx inst idx =
Instance.idx (Instance.setIdx inst idx) ==? idx
prop_Instance_setName :: Instance.Instance -> String -> Bool
prop_Instance_setName inst name =
Instance.name newinst == name &&
Instance.alias newinst == name
where newinst = Instance.setName inst name
prop_Instance_setAlias :: Instance.Instance -> String -> Bool
prop_Instance_setAlias inst name =
Instance.name newinst == Instance.name inst &&
Instance.alias newinst == name
where newinst = Instance.setAlias inst name
prop_Instance_setPri :: Instance.Instance -> Types.Ndx -> Property
prop_Instance_setPri inst pdx =
Instance.pNode (Instance.setPri inst pdx) ==? pdx
prop_Instance_setSec :: Instance.Instance -> Types.Ndx -> Property
prop_Instance_setSec inst sdx =
Instance.sNode (Instance.setSec inst sdx) ==? sdx
prop_Instance_setBoth :: Instance.Instance -> Types.Ndx -> Types.Ndx -> Bool
prop_Instance_setBoth inst pdx sdx =
Instance.pNode si == pdx && Instance.sNode si == sdx
where si = Instance.setBoth inst pdx sdx
prop_Instance_shrinkMG :: Instance.Instance -> Property
prop_Instance_shrinkMG inst =
Instance.mem inst >= 2 * Types.unitMem ==>
case Instance.shrinkByType inst Types.FailMem of
Types.Ok inst' -> Instance.mem inst' == Instance.mem inst - Types.unitMem
_ -> False
prop_Instance_shrinkMF :: Instance.Instance -> Property
prop_Instance_shrinkMF inst =
forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
let inst' = inst { Instance.mem = mem}
in Types.isBad $ Instance.shrinkByType inst' Types.FailMem
prop_Instance_shrinkCG :: Instance.Instance -> Property
prop_Instance_shrinkCG inst =
Instance.vcpus inst >= 2 * Types.unitCpu ==>
case Instance.shrinkByType inst Types.FailCPU of
Types.Ok inst' ->
Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu
_ -> False
prop_Instance_shrinkCF :: Instance.Instance -> Property
prop_Instance_shrinkCF inst =
forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
let inst' = inst { Instance.vcpus = vcpus }
in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU
prop_Instance_shrinkDG :: Instance.Instance -> Property
prop_Instance_shrinkDG inst =
Instance.dsk inst >= 2 * Types.unitDsk ==>
case Instance.shrinkByType inst Types.FailDisk of
Types.Ok inst' ->
Instance.dsk inst' == Instance.dsk inst - Types.unitDsk
_ -> False
prop_Instance_shrinkDF :: Instance.Instance -> Property
prop_Instance_shrinkDF inst =
forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
let inst' = inst { Instance.dsk = dsk }
in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk
prop_Instance_setMovable :: Instance.Instance -> Bool -> Property
prop_Instance_setMovable inst m =
Instance.movable inst' ==? m
where inst' = Instance.setMovable inst m
testSuite "Instance"
[ 'prop_Instance_creat
, 'prop_Instance_setIdx
, 'prop_Instance_setName
, 'prop_Instance_setAlias
, 'prop_Instance_setPri
, 'prop_Instance_setSec
, 'prop_Instance_setBoth
, 'prop_Instance_shrinkMG
, 'prop_Instance_shrinkMF
, 'prop_Instance_shrinkCG
, 'prop_Instance_shrinkCF
, 'prop_Instance_shrinkDG
, 'prop_Instance_shrinkDF
, 'prop_Instance_setMovable
]
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for ganeti-htools.
-}
{-
Copyright (C) 2009, 2010, 2011, 2012 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.HTools.Loader (testLoader) where
import Test.QuickCheck
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import Data.List
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.HTools.Node ()
import qualified Ganeti.BasicTypes as BasicTypes
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Loader as Loader
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Types as Types
prop_Loader_lookupNode :: [(String, Int)] -> String -> String -> Property
prop_Loader_lookupNode ktn inst node =
Loader.lookupNode nl inst node ==? Map.lookup node nl
where nl = Map.fromList ktn
prop_Loader_lookupInstance :: [(String, Int)] -> String -> Property
prop_Loader_lookupInstance kti inst =
Loader.lookupInstance il inst ==? Map.lookup inst il
where il = Map.fromList kti
prop_Loader_assignIndices :: Property
prop_Loader_assignIndices =
-- generate nodes with unique names
forAll (arbitrary `suchThat`
(\nodes ->
let names = map Node.name nodes
in length names == length (nub names))) $ \nodes ->
let (nassoc, kt) =
Loader.assignIndices (map (\n -> (Node.name n, n)) nodes)
in Map.size nassoc == length nodes &&
Container.size kt == length nodes &&
if not (null nodes)
then maximum (IntMap.keys kt) == length nodes - 1
else True
-- | Checks that the number of primary instances recorded on the nodes
-- is zero.
prop_Loader_mergeData :: [Node.Node] -> Bool
prop_Loader_mergeData ns =
let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns
in case Loader.mergeData [] [] [] []
(Loader.emptyCluster {Loader.cdNodes = na}) of
Types.Bad _ -> False
Types.Ok (Loader.ClusterData _ nl il _ _) ->
let nodes = Container.elems nl
instances = Container.elems il
in (sum . map (length . Node.pList)) nodes == 0 &&
null instances
-- | Check that compareNameComponent on equal strings works.
prop_Loader_compareNameComponent_equal :: String -> Bool
prop_Loader_compareNameComponent_equal s =
BasicTypes.compareNameComponent s s ==
BasicTypes.LookupResult BasicTypes.ExactMatch s
-- | Check that compareNameComponent on prefix strings works.
prop_Loader_compareNameComponent_prefix :: NonEmptyList Char -> String -> Bool
prop_Loader_compareNameComponent_prefix (NonEmpty s1) s2 =
BasicTypes.compareNameComponent (s1 ++ "." ++ s2) s1 ==
BasicTypes.LookupResult BasicTypes.PartialMatch s1
testSuite "Loader"
[ 'prop_Loader_lookupNode
, 'prop_Loader_lookupInstance
, 'prop_Loader_assignIndices
, 'prop_Loader_mergeData
, 'prop_Loader_compareNameComponent_equal
, 'prop_Loader_compareNameComponent_prefix
]
This diff is collapsed.
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for ganeti-htools.
-}
{-
Copyright (C) 2009, 2010, 2011, 2012 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.HTools.PeerMap (testPeerMap) where
import Test.QuickCheck
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import qualified Ganeti.HTools.PeerMap as PeerMap
-- | Make sure add is idempotent.
prop_PeerMap_addIdempotent :: PeerMap.PeerMap
-> PeerMap.Key -> PeerMap.Elem -> Property
prop_PeerMap_addIdempotent pmap key em =
fn puniq ==? fn (fn puniq)
where fn = PeerMap.add key em
puniq = PeerMap.accumArray const pmap
-- | Make sure remove is idempotent.
prop_PeerMap_removeIdempotent :: PeerMap.PeerMap -> PeerMap.Key -> Property
prop_PeerMap_removeIdempotent pmap key =
fn puniq ==? fn (fn puniq)
where fn = PeerMap.remove key
puniq = PeerMap.accumArray const pmap
-- | Make sure a missing item returns 0.
prop_PeerMap_findMissing :: PeerMap.PeerMap -> PeerMap.Key -> Property
prop_PeerMap_findMissing pmap key =
PeerMap.find key (PeerMap.remove key puniq) ==? 0
where puniq = PeerMap.accumArray const pmap
-- | Make sure an added item is found.
prop_PeerMap_addFind :: PeerMap.PeerMap
-> PeerMap.Key -> PeerMap.Elem -> Property
prop_PeerMap_addFind pmap key em =
PeerMap.find key (PeerMap.add key em puniq) ==? em
where puniq = PeerMap.accumArray const pmap
-- | Manual check that maxElem returns the maximum indeed, or 0 for null.
prop_PeerMap_maxElem :: PeerMap.PeerMap -> Property
prop_PeerMap_maxElem pmap =
PeerMap.maxElem puniq ==? if null puniq then 0
else (maximum . snd . unzip) puniq
where puniq = PeerMap.accumArray const pmap
-- | List of tests for the PeerMap module.
testSuite "PeerMap"
[ 'prop_PeerMap_addIdempotent
, 'prop_PeerMap_removeIdempotent
, 'prop_PeerMap_maxElem
, 'prop_PeerMap_addFind
, 'prop_PeerMap_findMissing
]
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for ganeti-htools.
-}
{-