code.grnet.gr Git - ganeti-local/blob - test/hs/Test/Ganeti/Common.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3
   4 {-| Unittests for the 'Ganeti.Common' module.
   5
   6 -}
   7
   8 {-
   9
  10 Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
  11
  12 This program is free software; you can redistribute it and/or modify
  13 it under the terms of the GNU General Public License as published by
  14 the Free Software Foundation; either version 2 of the License, or
  15 (at your option) any later version.
  16
  17 This program is distributed in the hope that it will be useful, but
  18 WITHOUT ANY WARRANTY; without even the implied warranty of
  19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 General Public License for more details.
  21
  22 You should have received a copy of the GNU General Public License
  23 along with this program; if not, write to the Free Software
  24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  25 02110-1301, USA.
  26
  27 -}
  28
  29 module Test.Ganeti.Common
  30   ( testCommon
  31   , checkOpt
  32   , passFailOpt
  33   , checkEarlyExit
  34   ) where
  35
  36 import Test.QuickCheck hiding (Result)
  37 import Test.HUnit
  38
  39 import qualified System.Console.GetOpt as GetOpt
  40 import System.Exit
  41
  42 import Test.Ganeti.TestHelper
  43 import Test.Ganeti.TestCommon
  44
  45 import Ganeti.BasicTypes
  46 import Ganeti.Common
  47 import Ganeti.HTools.Program.Main (personalities)
  48
  49 {-# ANN module "HLint: ignore Use camelCase" #-}
  50
  51 -- | Helper to check for correct parsing of an option.
  52 checkOpt :: (StandardOptions b) =>
  53             (a -> Maybe String) -- ^ Converts the value into a cmdline form
  54          -> b                   -- ^ The default options
  55          -> (String -> c)       -- ^ Fail test function
  56          -> (String -> d -> d -> c) -- ^ Check for equality function
  57          -> (a -> d)            -- ^ Transforms the value to a compare val
  58          -> (a, GenericOptType b, b -> d) -- ^ Triple of value, the
  59                                           -- option, function to
  60                                           -- extract the set value
  61                                           -- from the options
  62          -> c
  63 checkOpt repr defaults failfn eqcheck valfn
  64          (val, opt@(GetOpt.Option _ longs _ _, _), fn) =
  65   case longs of
  66     [] -> failfn "no long options?"
  67     cmdarg:_ ->
  68       case parseOptsInner defaults
  69              ["--" ++ cmdarg ++ maybe "" ("=" ++) (repr val)]
  70              "prog" [opt] [] of
  71         Left e -> failfn $ "Failed to parse option '" ++ cmdarg ++ ": " ++
  72                   show e
  73         Right (options, _) -> eqcheck ("Wrong value in option " ++
  74                                        cmdarg ++ "?") (valfn val) (fn options)
  75
  76 -- | Helper to check for correct and incorrect parsing of an option.
  77 passFailOpt :: (StandardOptions b) =>
  78                b                 -- ^ The default options
  79             -> (String -> c)     -- ^ Fail test function
  80             -> c                 -- ^ Pass function
  81             -> (GenericOptType b, String, String)
  82             -- ^ The list of enabled options, fail value and pass value
  83             -> c
  84 passFailOpt defaults failfn passfn
  85               (opt@(GetOpt.Option _ longs _ _, _), bad, good) =
  86   let first_opt = case longs of
  87                     [] -> error "no long options?"
  88                     x:_ -> x
  89       prefix = "--" ++ first_opt ++ "="
  90       good_cmd = prefix ++ good
  91       bad_cmd = prefix ++ bad in
  92   case (parseOptsInner defaults [bad_cmd]  "prog" [opt] [],
  93         parseOptsInner defaults [good_cmd] "prog" [opt] []) of
  94     (Left _,  Right _) -> passfn
  95     (Right _, Right _) -> failfn $ "Command line '" ++ bad_cmd ++
  96                           "' succeeded when it shouldn't"
  97     (Left  _, Left  _) -> failfn $ "Command line '" ++ good_cmd ++
  98                           "' failed when it shouldn't"
  99     (Right _, Left  _) ->
 100       failfn $ "Command line '" ++ bad_cmd ++
 101                "' succeeded when it shouldn't, while command line '" ++
 102                good_cmd ++ "' failed when it shouldn't"
 103
 104 -- | Helper to test that a given option is accepted OK with quick exit.
 105 checkEarlyExit :: (StandardOptions a) =>
 106                   a -> String -> [GenericOptType a] -> [ArgCompletion]
 107                -> Assertion
 108 checkEarlyExit defaults name options arguments =
 109   mapM_ (\param ->
 110            case parseOptsInner defaults [param] name options arguments of
 111              Left (code, _) ->
 112                assertEqual ("Program " ++ name ++
 113                             " returns invalid code " ++ show code ++
 114                             " for option " ++ param) ExitSuccess code
 115              _ -> assertFailure $ "Program " ++ name ++
 116                   " doesn't consider option " ++
 117                   param ++ " as early exit one"
 118         ) ["-h", "--help", "-V", "--version"]
 119
 120 -- | Test parseYesNo.
 121 prop_parse_yes_no :: Bool -> Bool -> String -> Property
 122 prop_parse_yes_no def testval val =
 123   forAll (elements [val, "yes", "no"]) $ \actual_val ->
 124   if testval
 125     then parseYesNo def Nothing ==? Ok def
 126     else let result = parseYesNo def (Just actual_val)
 127          in if actual_val `elem` ["yes", "no"]
 128               then result ==? Ok (actual_val == "yes")
 129               else property $ isBad result
 130
 131 -- | Check that formatCmdUsage works similar to Python _FormatUsage.
 132 case_formatCommands :: Assertion
 133 case_formatCommands =
 134   assertEqual "proper wrap for HTools Main"
 135     resCmdTest (formatCommands personalities)
 136   where resCmdTest :: [String]
 137         resCmdTest =
 138           [ " hail    - Ganeti IAllocator plugin that implements the instance\
 139             \ placement and"
 140           , "           movement using the same algorithm as hbal(1)"
 141           , " harep   - auto-repair tool that detects certain kind of problems\
 142             \ with instances"
 143           , "           and applies the allowed set of solutions"
 144           , " hbal    - cluster balancer that looks at the current state of\
 145             \ the cluster and"
 146           , "           computes a series of steps designed to bring the\
 147             \ cluster into a"
 148           , "           better state"
 149           , " hcheck  - cluster checker; prints information about cluster's\
 150             \ health and checks"
 151           , "           whether a rebalance done using hbal would help"
 152           , " hinfo   - cluster information printer; it prints information\
 153             \ about the current"
 154           , "           cluster state and its residing nodes/instances"
 155           , " hroller - cluster rolling maintenance helper; it helps\
 156             \ scheduling node reboots"
 157           , "           in a manner that doesn't conflict with the instances'\
 158             \ topology"
 159           , " hscan   - tool for scanning clusters via RAPI and saving their\
 160             \ data in the"
 161           , "           input format used by hbal(1) and hspace(1)"
 162           , " hspace  - computes how many additional instances can be fit on a\
 163             \ cluster, while"
 164           , "           maintaining N+1 status."
 165           ]
 166
 167 testSuite "Common"
 168           [ 'prop_parse_yes_no
 169           , 'case_formatCommands
 170           ]