Revision 51000365 htest/Test/Ganeti/HTools/CLI.hs
| b/htest/Test/Ganeti/HTools/CLI.hs | ||
|---|---|---|
| 28 | 28 |
|
| 29 | 29 |
module Test.Ganeti.HTools.CLI (testHTools_CLI) where |
| 30 | 30 |
|
| 31 |
import Test.HUnit |
|
| 31 | 32 |
import Test.QuickCheck |
| 32 | 33 |
|
| 33 | 34 |
import Control.Monad |
| 34 | 35 |
import Data.List |
| 35 | 36 |
import Text.Printf (printf) |
| 36 |
import qualified System.Console.GetOpt as GetOpt |
|
| 37 | 37 |
|
| 38 | 38 |
import Test.Ganeti.TestHelper |
| 39 | 39 |
import Test.Ganeti.TestCommon |
| 40 |
import Test.Ganeti.Common |
|
| 40 | 41 |
|
| 41 |
import qualified Ganeti.HTools.CLI as CLI
|
|
| 42 |
import Ganeti.HTools.CLI as CLI |
|
| 42 | 43 |
import qualified Ganeti.HTools.Program as Program |
| 43 | 44 |
import qualified Ganeti.HTools.Types as Types |
| 44 | 45 |
|
| ... | ... | |
| 46 | 47 |
prop_parseISpec :: String -> Int -> Int -> Int -> Property |
| 47 | 48 |
prop_parseISpec descr dsk mem cpu = |
| 48 | 49 |
let str = printf "%d,%d,%d" dsk mem cpu::String |
| 49 |
in CLI.parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk)
|
|
| 50 |
in parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk) |
|
| 50 | 51 |
|
| 51 | 52 |
-- | Test parsing failure due to wrong section count. |
| 52 | 53 |
prop_parseISpecFail :: String -> Property |
| ... | ... | |
| 54 | 55 |
forAll (choose (0,100) `suchThat` ((/=) 3)) $ \nelems -> |
| 55 | 56 |
forAll (replicateM nelems arbitrary) $ \values -> |
| 56 | 57 |
let str = intercalate "," $ map show (values::[Int]) |
| 57 |
in case CLI.parseISpecString descr str of
|
|
| 58 |
in case parseISpecString descr str of |
|
| 58 | 59 |
Types.Ok v -> failTest $ "Expected failure, got " ++ show v |
| 59 | 60 |
_ -> passTest |
| 60 | 61 |
|
| 61 |
-- | Test parseYesNo. |
|
| 62 |
prop_parseYesNo :: Bool -> Bool -> [Char] -> Property |
|
| 63 |
prop_parseYesNo def testval val = |
|
| 64 |
forAll (elements [val, "yes", "no"]) $ \actual_val -> |
|
| 65 |
if testval |
|
| 66 |
then CLI.parseYesNo def Nothing ==? Types.Ok def |
|
| 67 |
else let result = CLI.parseYesNo def (Just actual_val) |
|
| 68 |
in if actual_val `elem` ["yes", "no"] |
|
| 69 |
then result ==? Types.Ok (actual_val == "yes") |
|
| 70 |
else property $ Types.isBad result |
|
| 71 |
|
|
| 72 |
-- | Helper to check for correct parsing of string arg. |
|
| 73 |
checkStringArg :: [Char] |
|
| 74 |
-> (GetOpt.OptDescr (CLI.Options -> Types.Result CLI.Options), |
|
| 75 |
CLI.Options -> Maybe [Char]) |
|
| 76 |
-> Property |
|
| 77 |
checkStringArg val (opt, fn) = |
|
| 78 |
let GetOpt.Option _ longs _ _ = opt |
|
| 79 |
in case longs of |
|
| 80 |
[] -> failTest "no long options?" |
|
| 81 |
cmdarg:_ -> |
|
| 82 |
case CLI.parseOptsInner ["--" ++ cmdarg ++ "=" ++ val] "prog" [opt] of |
|
| 83 |
Left e -> failTest $ "Failed to parse option: " ++ show e |
|
| 84 |
Right (options, _) -> fn options ==? Just val |
|
| 85 |
|
|
| 86 | 62 |
-- | Test a few string arguments. |
| 87 |
prop_StringArg :: [Char] -> Property |
|
| 88 |
prop_StringArg argument = |
|
| 89 |
let args = [ (CLI.oDataFile, CLI.optDataFile) |
|
| 90 |
, (CLI.oDynuFile, CLI.optDynuFile) |
|
| 91 |
, (CLI.oSaveCluster, CLI.optSaveCluster) |
|
| 92 |
, (CLI.oReplay, CLI.optReplay) |
|
| 93 |
, (CLI.oPrintCommands, CLI.optShowCmds) |
|
| 94 |
, (CLI.oLuxiSocket, CLI.optLuxi) |
|
| 63 |
prop_string_arg :: String -> Property |
|
| 64 |
prop_string_arg argument = |
|
| 65 |
let args = [ (oDataFile, optDataFile) |
|
| 66 |
, (oDynuFile, optDynuFile) |
|
| 67 |
, (oSaveCluster, optSaveCluster) |
|
| 68 |
, (oPrintCommands, optShowCmds) |
|
| 69 |
, (oLuxiSocket, optLuxi) |
|
| 70 |
, (oIAllocSrc, optIAllocSrc) |
|
| 71 |
] |
|
| 72 |
in conjoin $ map (\(o, opt) -> |
|
| 73 |
checkOpt Just defaultOptions |
|
| 74 |
failTest (const (==?)) Just (argument, o, opt)) args |
|
| 75 |
|
|
| 76 |
-- | Test a few positive arguments. |
|
| 77 |
prop_numeric_arg :: Positive Double -> Property |
|
| 78 |
prop_numeric_arg (Positive argument) = |
|
| 79 |
let args = [ (oMaxCpu, optMcpu) |
|
| 80 |
, (oMinDisk, Just . optMdsk) |
|
| 81 |
, (oMinGain, Just . optMinGain) |
|
| 82 |
, (oMinGainLim, Just . optMinGainLim) |
|
| 83 |
, (oMinScore, Just . optMinScore) |
|
| 95 | 84 |
] |
| 96 |
in conjoin $ map (checkStringArg argument) args |
|
| 97 |
|
|
| 98 |
-- | Helper to test that a given option is accepted OK with quick exit. |
|
| 99 |
checkEarlyExit :: String -> [CLI.OptType] -> String -> Property |
|
| 100 |
checkEarlyExit name options param = |
|
| 101 |
case CLI.parseOptsInner [param] name options of |
|
| 102 |
Left (code, _) -> |
|
| 103 |
printTestCase ("Program " ++ name ++
|
|
| 104 |
" returns invalid code " ++ show code ++ |
|
| 105 |
" for option " ++ param) (code == 0) |
|
| 106 |
_ -> failTest $ "Program " ++ name ++ " doesn't consider option " ++ |
|
| 107 |
param ++ " as early exit one" |
|
| 108 |
|
|
| 109 |
-- | Test that all binaries support some common options. There is |
|
| 110 |
-- nothing actually random about this test... |
|
| 111 |
prop_stdopts :: Property |
|
| 112 |
prop_stdopts = |
|
| 113 |
let params = ["-h", "--help", "-V", "--version"] |
|
| 114 |
opts = map (\(name, (_, o)) -> (name, o)) Program.personalities |
|
| 115 |
-- apply checkEarlyExit across the cartesian product of params and opts |
|
| 116 |
in conjoin [checkEarlyExit n o p | p <- params, (n, o) <- opts] |
|
| 85 |
in conjoin $ |
|
| 86 |
map (\(x, y) -> checkOpt (Just . show) defaultOptions |
|
| 87 |
failTest (const (==?)) Just (argument, x, y)) args |
|
| 88 |
|
|
| 89 |
-- | Test a few boolean arguments. |
|
| 90 |
case_bool_arg :: Assertion |
|
| 91 |
case_bool_arg = |
|
| 92 |
mapM_ (checkOpt (const Nothing) defaultOptions assertFailure |
|
| 93 |
assertEqual id) |
|
| 94 |
[ (False, oDiskMoves, optDiskMoves) |
|
| 95 |
, (False, oInstMoves, optInstMoves) |
|
| 96 |
, (True, oEvacMode, optEvacMode) |
|
| 97 |
, (True, oExecJobs, optExecJobs) |
|
| 98 |
, (True, oNoHeaders, optNoHeaders) |
|
| 99 |
, (True, oNoSimulation, optNoSimulation) |
|
| 100 |
] |
|
| 101 |
|
|
| 102 |
-- | Tests a few invalid arguments. |
|
| 103 |
case_wrong_arg :: Assertion |
|
| 104 |
case_wrong_arg = do |
|
| 105 |
mapM_ (passFailOpt defaultOptions assertFailure (return ())) |
|
| 106 |
[ (oSpindleUse, "-1", "1") |
|
| 107 |
, (oSpindleUse, "a", "1") |
|
| 108 |
, (oMaxCpu, "-1", "1") |
|
| 109 |
, (oMinDisk, "a", "1") |
|
| 110 |
, (oMinGainLim, "a", "1") |
|
| 111 |
, (oMaxSolLength, "x", "10") |
|
| 112 |
, (oStdSpec, "no-such-spec", "1,1,1") |
|
| 113 |
, (oTieredSpec, "no-such-spec", "1,1,1") |
|
| 114 |
] |
|
| 115 |
|
|
| 116 |
-- | Test that all binaries support some common options. |
|
| 117 |
case_stdopts :: Assertion |
|
| 118 |
case_stdopts = |
|
| 119 |
mapM_ (\(name, (_, o)) -> checkEarlyExit defaultOptions name o) |
|
| 120 |
Program.personalities |
|
| 117 | 121 |
|
| 118 | 122 |
testSuite "HTools/CLI" |
| 119 | 123 |
[ 'prop_parseISpec |
| 120 | 124 |
, 'prop_parseISpecFail |
| 121 |
, 'prop_parseYesNo |
|
| 122 |
, 'prop_StringArg |
|
| 123 |
, 'prop_stdopts |
|
| 125 |
, 'prop_string_arg |
|
| 126 |
, 'prop_numeric_arg |
|
| 127 |
, 'case_bool_arg |
|
| 128 |
, 'case_wrong_arg |
|
| 129 |
, 'case_stdopts |
|
| 124 | 130 |
] |
Also available in: Unified diff