Synnefo » snf-ganeti

{-# LANGUAGE TemplateHaskell #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-| Unittests for the 'Ganeti.Common' module.

-}

{-

Copyright (C) 2009, 2010, 2011, 2012, 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.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

import Ganeti.HTools.Program.Main (personalities)

{-# ANN module "HLint: ignore Use camelCase" #-}

-- | 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 first_opt = case longs of

                    [] -> error "no long options?"

                    x:_ -> x

      prefix = "--" ++ first_opt ++ "="

      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] -> [ArgCompletion]

               -> Assertion

checkEarlyExit defaults name options arguments =

  mapM_ (\param ->

           case parseOptsInner defaults [param] name options arguments 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

-- | Check that formatCmdUsage works similar to Python _FormatUsage.

case_formatCommands :: Assertion

case_formatCommands =

  assertEqual "proper wrap for HTools Main"

    resCmdTest (formatCommands personalities)

  where resCmdTest :: [String]

        resCmdTest =

          [ " hail    - Ganeti IAllocator plugin that implements the instance\

            \ placement and"

          , "           movement using the same algorithm as hbal(1)"

          , " harep   - auto-repair tool that detects certain kind of problems\

            \ with instances"

          , "           and applies the allowed set of solutions"

          , " hbal    - cluster balancer that looks at the current state of\

            \ the cluster and"

          , "           computes a series of steps designed to bring the\

            \ cluster into a"

          , "           better state"

          , " hcheck  - cluster checker; prints information about cluster's\

            \ health and checks"

          , "           whether a rebalance done using hbal would help"

          , " hinfo   - cluster information printer; it prints information\

            \ about the current"

          , "           cluster state and its residing nodes/instances"

          , " hroller - cluster rolling maintenance helper; it helps\

            \ scheduling node reboots"

          , "           in a manner that doesn't conflict with the instances'\

            \ topology"

          , " hscan   - tool for scanning clusters via RAPI and saving their\

            \ data in the"

          , "           input format used by hbal(1) and hspace(1)"

          , " hspace  - computes how many additional instances can be fit on a\

            \ cluster, while"

          , "           maintaining N+1 status."

          ]

testSuite "Common"

          [ 'prop_parse_yes_no

          , 'case_formatCommands

          ]