root / test / hs / Test / Ganeti / Common.hs @ f1f6f117
History | View | Annotate | Download (4.8 kB)
1 | 51000365 | Iustin Pop | {-# LANGUAGE TemplateHaskell #-} |
---|---|---|---|
2 | 51000365 | Iustin Pop | {-# OPTIONS_GHC -fno-warn-orphans #-} |
3 | 51000365 | Iustin Pop | |
4 | 51000365 | Iustin Pop | {-| Unittests for the 'Ganeti.Common' module. |
5 | 51000365 | Iustin Pop | |
6 | 51000365 | Iustin Pop | -} |
7 | 51000365 | Iustin Pop | |
8 | 51000365 | Iustin Pop | {- |
9 | 51000365 | Iustin Pop | |
10 | 51000365 | Iustin Pop | Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
11 | 51000365 | Iustin Pop | |
12 | 51000365 | Iustin Pop | This program is free software; you can redistribute it and/or modify |
13 | 51000365 | Iustin Pop | it under the terms of the GNU General Public License as published by |
14 | 51000365 | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
15 | 51000365 | Iustin Pop | (at your option) any later version. |
16 | 51000365 | Iustin Pop | |
17 | 51000365 | Iustin Pop | This program is distributed in the hope that it will be useful, but |
18 | 51000365 | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | 51000365 | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 | 51000365 | Iustin Pop | General Public License for more details. |
21 | 51000365 | Iustin Pop | |
22 | 51000365 | Iustin Pop | You should have received a copy of the GNU General Public License |
23 | 51000365 | Iustin Pop | along with this program; if not, write to the Free Software |
24 | 51000365 | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 | 51000365 | Iustin Pop | 02110-1301, USA. |
26 | 51000365 | Iustin Pop | |
27 | 51000365 | Iustin Pop | -} |
28 | 51000365 | Iustin Pop | |
29 | 51000365 | Iustin Pop | module Test.Ganeti.Common |
30 | 51000365 | Iustin Pop | ( testCommon |
31 | 51000365 | Iustin Pop | , checkOpt |
32 | 51000365 | Iustin Pop | , passFailOpt |
33 | 51000365 | Iustin Pop | , checkEarlyExit |
34 | 51000365 | Iustin Pop | ) where |
35 | 51000365 | Iustin Pop | |
36 | 51000365 | Iustin Pop | import Test.QuickCheck hiding (Result) |
37 | 51000365 | Iustin Pop | import Test.HUnit |
38 | 51000365 | Iustin Pop | |
39 | 51000365 | Iustin Pop | import qualified System.Console.GetOpt as GetOpt |
40 | 51000365 | Iustin Pop | import System.Exit |
41 | 51000365 | Iustin Pop | |
42 | 51000365 | Iustin Pop | import Test.Ganeti.TestHelper |
43 | 51000365 | Iustin Pop | import Test.Ganeti.TestCommon |
44 | 51000365 | Iustin Pop | |
45 | 51000365 | Iustin Pop | import Ganeti.BasicTypes |
46 | 51000365 | Iustin Pop | import Ganeti.Common |
47 | 51000365 | Iustin Pop | |
48 | 51000365 | Iustin Pop | -- | Helper to check for correct parsing of an option. |
49 | 51000365 | Iustin Pop | checkOpt :: (StandardOptions b) => |
50 | 51000365 | Iustin Pop | (a -> Maybe String) -- ^ Converts the value into a cmdline form |
51 | 51000365 | Iustin Pop | -> b -- ^ The default options |
52 | 51000365 | Iustin Pop | -> (String -> c) -- ^ Fail test function |
53 | 51000365 | Iustin Pop | -> (String -> d -> d -> c) -- ^ Check for equality function |
54 | 51000365 | Iustin Pop | -> (a -> d) -- ^ Transforms the value to a compare val |
55 | 51000365 | Iustin Pop | -> (a, GenericOptType b, b -> d) -- ^ Triple of value, the |
56 | 51000365 | Iustin Pop | -- option, function to |
57 | 51000365 | Iustin Pop | -- extract the set value |
58 | 51000365 | Iustin Pop | -- from the options |
59 | 51000365 | Iustin Pop | -> c |
60 | 51000365 | Iustin Pop | checkOpt repr defaults failfn eqcheck valfn |
61 | ce207617 | Iustin Pop | (val, opt@(GetOpt.Option _ longs _ _, _), fn) = |
62 | 51000365 | Iustin Pop | case longs of |
63 | 51000365 | Iustin Pop | [] -> failfn "no long options?" |
64 | 51000365 | Iustin Pop | cmdarg:_ -> |
65 | 51000365 | Iustin Pop | case parseOptsInner defaults |
66 | 51000365 | Iustin Pop | ["--" ++ cmdarg ++ maybe "" ("=" ++) (repr val)] |
67 | 22278fa7 | Iustin Pop | "prog" [opt] [] of |
68 | 51000365 | Iustin Pop | Left e -> failfn $ "Failed to parse option '" ++ cmdarg ++ ": " ++ |
69 | 51000365 | Iustin Pop | show e |
70 | 51000365 | Iustin Pop | Right (options, _) -> eqcheck ("Wrong value in option " ++ |
71 | 51000365 | Iustin Pop | cmdarg ++ "?") (valfn val) (fn options) |
72 | 51000365 | Iustin Pop | |
73 | 51000365 | Iustin Pop | -- | Helper to check for correct and incorrect parsing of an option. |
74 | 51000365 | Iustin Pop | passFailOpt :: (StandardOptions b) => |
75 | 51000365 | Iustin Pop | b -- ^ The default options |
76 | 51000365 | Iustin Pop | -> (String -> c) -- ^ Fail test function |
77 | 51000365 | Iustin Pop | -> c -- ^ Pass function |
78 | 51000365 | Iustin Pop | -> (GenericOptType b, String, String) |
79 | 51000365 | Iustin Pop | -- ^ The list of enabled options, fail value and pass value |
80 | 51000365 | Iustin Pop | -> c |
81 | 51000365 | Iustin Pop | passFailOpt defaults failfn passfn |
82 | ce207617 | Iustin Pop | (opt@(GetOpt.Option _ longs _ _, _), bad, good) = |
83 | 51000365 | Iustin Pop | let prefix = "--" ++ head longs ++ "=" |
84 | 51000365 | Iustin Pop | good_cmd = prefix ++ good |
85 | 51000365 | Iustin Pop | bad_cmd = prefix ++ bad in |
86 | 22278fa7 | Iustin Pop | case (parseOptsInner defaults [bad_cmd] "prog" [opt] [], |
87 | 22278fa7 | Iustin Pop | parseOptsInner defaults [good_cmd] "prog" [opt] []) of |
88 | 51000365 | Iustin Pop | (Left _, Right _) -> passfn |
89 | 51000365 | Iustin Pop | (Right _, Right _) -> failfn $ "Command line '" ++ bad_cmd ++ |
90 | 51000365 | Iustin Pop | "' succeeded when it shouldn't" |
91 | 51000365 | Iustin Pop | (Left _, Left _) -> failfn $ "Command line '" ++ good_cmd ++ |
92 | 51000365 | Iustin Pop | "' failed when it shouldn't" |
93 | 51000365 | Iustin Pop | (Right _, Left _) -> |
94 | 51000365 | Iustin Pop | failfn $ "Command line '" ++ bad_cmd ++ |
95 | 51000365 | Iustin Pop | "' succeeded when it shouldn't, while command line '" ++ |
96 | 51000365 | Iustin Pop | good_cmd ++ "' failed when it shouldn't" |
97 | 51000365 | Iustin Pop | |
98 | 51000365 | Iustin Pop | -- | Helper to test that a given option is accepted OK with quick exit. |
99 | 51000365 | Iustin Pop | checkEarlyExit :: (StandardOptions a) => |
100 | 22278fa7 | Iustin Pop | a -> String -> [GenericOptType a] -> [ArgCompletion] |
101 | 22278fa7 | Iustin Pop | -> Assertion |
102 | 22278fa7 | Iustin Pop | checkEarlyExit defaults name options arguments = |
103 | 51000365 | Iustin Pop | mapM_ (\param -> |
104 | 22278fa7 | Iustin Pop | case parseOptsInner defaults [param] name options arguments of |
105 | 51000365 | Iustin Pop | Left (code, _) -> |
106 | 51000365 | Iustin Pop | assertEqual ("Program " ++ name ++ |
107 | 51000365 | Iustin Pop | " returns invalid code " ++ show code ++ |
108 | 51000365 | Iustin Pop | " for option " ++ param) ExitSuccess code |
109 | 51000365 | Iustin Pop | _ -> assertFailure $ "Program " ++ name ++ |
110 | 51000365 | Iustin Pop | " doesn't consider option " ++ |
111 | 51000365 | Iustin Pop | param ++ " as early exit one" |
112 | 51000365 | Iustin Pop | ) ["-h", "--help", "-V", "--version"] |
113 | 51000365 | Iustin Pop | |
114 | 51000365 | Iustin Pop | -- | Test parseYesNo. |
115 | 51000365 | Iustin Pop | prop_parse_yes_no :: Bool -> Bool -> String -> Property |
116 | 51000365 | Iustin Pop | prop_parse_yes_no def testval val = |
117 | 51000365 | Iustin Pop | forAll (elements [val, "yes", "no"]) $ \actual_val -> |
118 | 51000365 | Iustin Pop | if testval |
119 | 51000365 | Iustin Pop | then parseYesNo def Nothing ==? Ok def |
120 | 51000365 | Iustin Pop | else let result = parseYesNo def (Just actual_val) |
121 | 51000365 | Iustin Pop | in if actual_val `elem` ["yes", "no"] |
122 | 51000365 | Iustin Pop | then result ==? Ok (actual_val == "yes") |
123 | 51000365 | Iustin Pop | else property $ isBad result |
124 | 51000365 | Iustin Pop | |
125 | 51000365 | Iustin Pop | |
126 | 51000365 | Iustin Pop | testSuite "Common" |
127 | 51000365 | Iustin Pop | [ 'prop_parse_yes_no |
128 | 51000365 | Iustin Pop | ] |