Commit 51000365 authored by Iustin Pop's avatar Iustin Pop
Browse files

Rework CLI modules and tests

While investigating how we could test the Daemon.hs module, I realised
that we have a very, erm, sub-optimal situation:

- HTools/CLI.hs has a nice IO/pure separation testing in cmdline
  parsing, which allows some basic functionality to be tested, but
  uses direct 'read' in many options, which fails at runtime when
  evaluating the argument, and not when parsing the options
- Daemon.hs lacks that, but has a much nicer 'reqWithConversion'
  helper that can be used for nicer option parsing, and uses that +
  tryRead instead of plain 'read'

Since this situation is very bad, let's clean it up. We introduce yet
another module, Common.hs, that holds functionality common to all
command line programs (daemons or not). We move the parsing to this
module, and introduce a type class to handle option types which
support --help/--version. This allows removal of duplicated code from
CLI.hs and Daemon.hs.

The other part of the patch is cleanup/rework of the tests for this
code: we introduce some helpers (checkOpt, passFailOpt,
checkEarlyExit) that can be used from the much-slimmer now tests for
CLI and Daemon. In the common module, we just test the yes/no helper
we have. Many new tests for boolean options and numeric options are
added.

A side change is the removal of the obsolete `--replay-count',
`--test-size' options (unused since commit 95f6c931

, “Switch Haskell
test harness to test-framework”).
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarRené Nussbaumer <rn@google.com>
parent 3ce788db
......@@ -412,6 +412,7 @@ HS_LIB_SRCS = \
htools/Ganeti/HTools/Program/Hscan.hs \
htools/Ganeti/HTools/Program/Hspace.hs \
htools/Ganeti/BasicTypes.hs \
htools/Ganeti/Common.hs \
htools/Ganeti/Compat.hs \
htools/Ganeti/Confd.hs \
htools/Ganeti/Confd/Server.hs \
......@@ -439,6 +440,8 @@ HS_LIB_SRCS = \
HS_TEST_SRCS = \
htest/Test/Ganeti/BasicTypes.hs \
htest/Test/Ganeti/Common.hs \
htest/Test/Ganeti/Daemon.hs \
htest/Test/Ganeti/Confd/Utils.hs \
htest/Test/Ganeti/HTools/CLI.hs \
htest/Test/Ganeti/HTools/Cluster.hs \
......
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for the 'Ganeti.Common' module.
-}
{-
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.Common
( testCommon
, checkOpt
, passFailOpt
, checkEarlyExit
) where
import Test.QuickCheck hiding (Result)
import Test.HUnit
import qualified System.Console.GetOpt as GetOpt
import System.Exit
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Ganeti.BasicTypes
import Ganeti.Common
-- | Helper to check for correct parsing of an option.
checkOpt :: (StandardOptions b) =>
(a -> Maybe String) -- ^ Converts the value into a cmdline form
-> b -- ^ The default options
-> (String -> c) -- ^ Fail test function
-> (String -> d -> d -> c) -- ^ Check for equality function
-> (a -> d) -- ^ Transforms the value to a compare val
-> (a, GenericOptType b, b -> d) -- ^ Triple of value, the
-- option, function to
-- extract the set value
-- from the options
-> c
checkOpt repr defaults failfn eqcheck valfn
(val, opt@(GetOpt.Option _ longs _ _), fn) =
case longs of
[] -> failfn "no long options?"
cmdarg:_ ->
case parseOptsInner defaults
["--" ++ cmdarg ++ maybe "" ("=" ++) (repr val)]
"prog" [opt] of
Left e -> failfn $ "Failed to parse option '" ++ cmdarg ++ ": " ++
show e
Right (options, _) -> eqcheck ("Wrong value in option " ++
cmdarg ++ "?") (valfn val) (fn options)
-- | Helper to check for correct and incorrect parsing of an option.
passFailOpt :: (StandardOptions b) =>
b -- ^ The default options
-> (String -> c) -- ^ Fail test function
-> c -- ^ Pass function
-> (GenericOptType b, String, String)
-- ^ The list of enabled options, fail value and pass value
-> c
passFailOpt defaults failfn passfn
(opt@(GetOpt.Option _ longs _ _), bad, good) =
let prefix = "--" ++ head longs ++ "="
good_cmd = prefix ++ good
bad_cmd = prefix ++ bad in
case (parseOptsInner defaults [bad_cmd] "prog" [opt],
parseOptsInner defaults [good_cmd] "prog" [opt]) of
(Left _, Right _) -> passfn
(Right _, Right _) -> failfn $ "Command line '" ++ bad_cmd ++
"' succeeded when it shouldn't"
(Left _, Left _) -> failfn $ "Command line '" ++ good_cmd ++
"' failed when it shouldn't"
(Right _, Left _) ->
failfn $ "Command line '" ++ bad_cmd ++
"' succeeded when it shouldn't, while command line '" ++
good_cmd ++ "' failed when it shouldn't"
-- | Helper to test that a given option is accepted OK with quick exit.
checkEarlyExit :: (StandardOptions a) =>
a -> String -> [GenericOptType a] -> Assertion
checkEarlyExit defaults name options =
mapM_ (\param ->
case parseOptsInner defaults [param] name options of
Left (code, _) ->
assertEqual ("Program " ++ name ++
" returns invalid code " ++ show code ++
" for option " ++ param) ExitSuccess code
_ -> assertFailure $ "Program " ++ name ++
" doesn't consider option " ++
param ++ " as early exit one"
) ["-h", "--help", "-V", "--version"]
-- | Test parseYesNo.
prop_parse_yes_no :: Bool -> Bool -> String -> Property
prop_parse_yes_no def testval val =
forAll (elements [val, "yes", "no"]) $ \actual_val ->
if testval
then parseYesNo def Nothing ==? Ok def
else let result = parseYesNo def (Just actual_val)
in if actual_val `elem` ["yes", "no"]
then result ==? Ok (actual_val == "yes")
else property $ isBad result
testSuite "Common"
[ 'prop_parse_yes_no
]
{-# 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.Daemon (testDaemon) where
import Test.QuickCheck hiding (Result)
import Test.HUnit
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.Common
import Ganeti.Common
import Ganeti.Daemon as Daemon
-- | Test a few string arguments.
prop_string_arg :: String -> Property
prop_string_arg argument =
let args = [ (argument, oBindAddress, optBindAddress)
]
in conjoin $
map (checkOpt Just defaultOptions failTest (const (==?)) Just) args
-- | Test a few integer arguments (only one for now).
prop_numeric_arg :: Int -> Property
prop_numeric_arg argument =
checkOpt (Just . show) defaultOptions
failTest (const (==?)) (Just . fromIntegral)
(argument, oPort 0, optPort)
-- | Test a few boolean arguments.
case_bool_arg :: Assertion
case_bool_arg =
mapM_ (checkOpt (const Nothing) defaultOptions assertFailure
assertEqual id)
[ (False, oNoDaemonize, optDaemonize)
, (True, oDebug, optDebug)
, (True, oNoUserChecks, optNoUserChecks)
]
-- | Tests a few invalid arguments.
case_wrong_arg :: Assertion
case_wrong_arg = do
mapM_ (passFailOpt defaultOptions assertFailure (return ()))
[ (oSyslogUsage, "foo", "yes")
, (oPort 0, "x", "10")
]
-- | Test that the option list supports some common options.
case_stdopts :: Assertion
case_stdopts =
checkEarlyExit defaultOptions "prog" [oShowHelp, oShowVer]
testSuite "Daemon"
[ 'prop_string_arg
, 'prop_numeric_arg
, 'case_bool_arg
, 'case_wrong_arg
, 'case_stdopts
]
......@@ -28,17 +28,18 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.HTools.CLI (testHTools_CLI) where
import Test.HUnit
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 Test.Ganeti.Common
import qualified Ganeti.HTools.CLI as CLI
import Ganeti.HTools.CLI as CLI
import qualified Ganeti.HTools.Program as Program
import qualified Ganeti.HTools.Types as Types
......@@ -46,7 +47,7 @@ import qualified Ganeti.HTools.Types as Types
prop_parseISpec :: String -> Int -> Int -> Int -> Property
prop_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)
in parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk)
-- | Test parsing failure due to wrong section count.
prop_parseISpecFail :: String -> Property
......@@ -54,71 +55,76 @@ prop_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
in case parseISpecString descr str of
Types.Ok v -> failTest $ "Expected failure, got " ++ show v
_ -> passTest
-- | Test parseYesNo.
prop_parseYesNo :: Bool -> Bool -> [Char] -> Property
prop_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_StringArg :: [Char] -> Property
prop_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)
prop_string_arg :: String -> Property
prop_string_arg argument =
let args = [ (oDataFile, optDataFile)
, (oDynuFile, optDynuFile)
, (oSaveCluster, optSaveCluster)
, (oPrintCommands, optShowCmds)
, (oLuxiSocket, optLuxi)
, (oIAllocSrc, optIAllocSrc)
]
in conjoin $ map (\(o, opt) ->
checkOpt Just defaultOptions
failTest (const (==?)) Just (argument, o, opt)) args
-- | Test a few positive arguments.
prop_numeric_arg :: Positive Double -> Property
prop_numeric_arg (Positive argument) =
let args = [ (oMaxCpu, optMcpu)
, (oMinDisk, Just . optMdsk)
, (oMinGain, Just . optMinGain)
, (oMinGainLim, Just . optMinGainLim)
, (oMinScore, Just . optMinScore)
]
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, _) ->
printTestCase ("Program " ++ name ++
" returns invalid code " ++ show code ++
" for option " ++ param) (code == 0)
_ -> 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_stdopts :: Property
prop_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]
in conjoin $
map (\(x, y) -> checkOpt (Just . show) defaultOptions
failTest (const (==?)) Just (argument, x, y)) args
-- | Test a few boolean arguments.
case_bool_arg :: Assertion
case_bool_arg =
mapM_ (checkOpt (const Nothing) defaultOptions assertFailure
assertEqual id)
[ (False, oDiskMoves, optDiskMoves)
, (False, oInstMoves, optInstMoves)
, (True, oEvacMode, optEvacMode)
, (True, oExecJobs, optExecJobs)
, (True, oNoHeaders, optNoHeaders)
, (True, oNoSimulation, optNoSimulation)
]
-- | Tests a few invalid arguments.
case_wrong_arg :: Assertion
case_wrong_arg = do
mapM_ (passFailOpt defaultOptions assertFailure (return ()))
[ (oSpindleUse, "-1", "1")
, (oSpindleUse, "a", "1")
, (oMaxCpu, "-1", "1")
, (oMinDisk, "a", "1")
, (oMinGainLim, "a", "1")
, (oMaxSolLength, "x", "10")
, (oStdSpec, "no-such-spec", "1,1,1")
, (oTieredSpec, "no-such-spec", "1,1,1")
]
-- | Test that all binaries support some common options.
case_stdopts :: Assertion
case_stdopts =
mapM_ (\(name, (_, o)) -> checkEarlyExit defaultOptions name o)
Program.personalities
testSuite "HTools/CLI"
[ 'prop_parseISpec
, 'prop_parseISpecFail
, 'prop_parseYesNo
, 'prop_StringArg
, 'prop_stdopts
, 'prop_string_arg
, 'prop_numeric_arg
, 'case_bool_arg
, 'case_wrong_arg
, 'case_stdopts
]
......@@ -32,6 +32,8 @@ import System.Environment (getArgs)
import Test.Ganeti.TestImports ()
import Test.Ganeti.BasicTypes
import Test.Ganeti.Confd.Utils
import Test.Ganeti.Common
import Test.Ganeti.Daemon
import Test.Ganeti.HTools.CLI
import Test.Ganeti.HTools.Cluster
import Test.Ganeti.HTools.Container
......@@ -78,6 +80,8 @@ allTests :: [(Bool, (String, [Test]))]
allTests =
[ (True, testBasicTypes)
, (True, testConfd_Utils)
, (True, testCommon)
, (True, testDaemon)
, (True, testHTools_CLI)
, (True, testHTools_Container)
, (True, testHTools_Instance)
......
{-| Base common functionality.
This module holds common functionality shared across Ganeti daemons,
HTools and any other programs.
-}
{-
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 Ganeti.Common
( GenericOptType
, StandardOptions(..)
, oShowHelp
, oShowVer
, usageHelp
, versionInfo
, reqWithConversion
, parseYesNo
, parseOpts
, parseOptsInner
) where
import Control.Monad (foldM)
import qualified Data.Version
import System.Console.GetOpt
import System.Exit
import System.Info
import System.IO
import Text.Printf (printf)
import Ganeti.BasicTypes
import qualified Ganeti.Version as Version (version)
-- | Abrreviation for the option type.
type GenericOptType a = OptDescr (a -> Result a)
-- | Type class for options which support help and version.
class StandardOptions a where
helpRequested :: a -> Bool
verRequested :: a -> Bool
requestHelp :: a -> a
requestVer :: a -> a
-- | Options to request help output.
oShowHelp :: (StandardOptions a) => GenericOptType a
oShowHelp = Option "h" ["help"] (NoArg (Ok . requestHelp))
"show help"
oShowVer :: (StandardOptions a) => GenericOptType a
oShowVer = Option "V" ["version"] (NoArg (Ok . requestVer))
"show the version of the program"
-- | Usage info.
usageHelp :: String -> [GenericOptType a] -> String
usageHelp progname =
usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
progname Version.version progname)
-- | Show the program version info.
versionInfo :: String -> String
versionInfo progname =
printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
progname Version.version compilerName
(Data.Version.showVersion compilerVersion)
os arch
-- | Helper for parsing a yes\/no command line flag.
parseYesNo :: Bool -- ^ Default value (when we get a @Nothing@)
-> Maybe String -- ^ Parameter value
-> Result Bool -- ^ Resulting boolean value
parseYesNo v Nothing = return v
parseYesNo _ (Just "yes") = return True
parseYesNo _ (Just "no") = return False
parseYesNo _ (Just s) = fail ("Invalid choice '" ++ s ++
"', pass one of 'yes' or 'no'")
-- | Helper function for required arguments which need to be converted
-- as opposed to stored just as string.
reqWithConversion :: (String -> Result a)
-> (a -> b -> Result b)
-> String
-> ArgDescr (b -> Result b)
reqWithConversion conversion_fn updater_fn metavar =
ReqArg (\string_opt opts -> do
parsed_value <- conversion_fn string_opt
updater_fn parsed_value opts) metavar
-- | Command line parser, using a generic 'Options' structure.
parseOpts :: (StandardOptions a) =>
a -- ^ The default options
-> [String] -- ^ The command line arguments
-> String -- ^ The program name
-> [GenericOptType a] -- ^ The supported command line options
-> IO (a, [String]) -- ^ The resulting options and
-- leftover arguments
parseOpts defaults argv progname options =
case parseOptsInner defaults argv progname options of
Left (code, msg) -> do
hPutStr (if code == ExitSuccess then stdout else stderr) msg
exitWith code
Right result ->
return result
-- | Inner parse options. The arguments are similar to 'parseOpts',
-- but it returns either a 'Left' composed of exit code and message,
-- or a 'Right' for the success case.
parseOptsInner :: (StandardOptions a) =>
a
-> [String]
-> String
-> [GenericOptType a]
-> Either (ExitCode, String) (a, [String])
parseOptsInner defaults argv progname options =
case getOpt Permute options argv of
(opts, args, []) ->
case foldM (flip id) defaults opts of
Bad msg -> Left (ExitFailure 1,
"Error while parsing command line arguments:\n"
++ msg ++ "\n")
Ok parsed ->
select (Right (parsed, args))
[ (helpRequested parsed,
Left (ExitSuccess, usageHelp progname options))
, (verRequested parsed,
Left (ExitSuccess, versionInfo progname))
]
(_, _, errs) ->
Left (ExitFailure 2, "Command line error: " ++ concat errs ++ "\n" ++
usageHelp progname options)
......@@ -45,7 +45,6 @@ module Ganeti.Daemon
import Control.Exception
import Control.Monad
import Data.Maybe (fromMaybe)
import qualified Data.Version
import Data.Word
import GHC.IO.Handle (hDuplicateTo)
import qualified Network.Socket as Socket
......@@ -53,7 +52,6 @@ import Prelude hiding (catch)
import System.Console.GetOpt
import System.Exit
import System.Environment
import System.Info
import System.IO
import System.IO.Error (isDoesNotExistError)
import System.Posix.Directory
......@@ -62,13 +60,12 @@ import System.Posix.IO
import System.Posix.Process
import System.Posix.Types
import System.Posix.Signals
import Text.Printf
import Ganeti.Common as Common
import Ganeti.Logging
import Ganeti.Runtime
import Ganeti.BasicTypes
import Ganeti.HTools.Utils
import qualified Ganeti.Version as Version (version)
import qualified Ganeti.Constants as C
import qualified Ganeti.Ssconf as Ssconf
......@@ -105,32 +102,17 @@ defaultOptions = DaemonOptions
, optSyslogUsage = Nothing
}
instance StandardOptions DaemonOptions where
helpRequested = optShowHelp
verRequested = optShowVer
requestHelp = \opts -> opts { optShowHelp = True }
requestVer = \opts -> opts { optShowVer = True }
-- | Abrreviation for the option type.
type OptType = OptDescr (DaemonOptions -> Result DaemonOptions)
-- | Helper function for required arguments which need to be converted
-- as opposed to stored just as string.
reqWithConversion :: (String -> Result a)
-> (a -> DaemonOptions -> Result DaemonOptions)
-> String
-> ArgDescr (DaemonOptions -> Result DaemonOptions)
reqWithConversion conversion_fn updater_fn metavar =
ReqArg (\string_opt opts -> do
parsed_value <- conversion_fn string_opt