1 {-# LANGUAGE TemplateHaskell, CPP #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
4 {-| Unittests for ganeti-htools.
10 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
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.
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.
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
29 module Test.Ganeti.Utils (testUtils) where
31 import Test.QuickCheck hiding (Result)
34 import Data.Char (isSpace)
36 import qualified Text.JSON as J
38 import Text.Regex.PCRE
41 import Test.Ganeti.TestHelper
42 import Test.Ganeti.TestCommon
44 import Ganeti.BasicTypes
45 import qualified Ganeti.Constants as C
46 import qualified Ganeti.JSON as JSON
49 -- | Helper to generate a small string that doesn't contain commas.
50 genNonCommaString :: Gen String
51 genNonCommaString = do
52 size <- choose (0, 20) -- arbitrary max size
53 vectorOf size (arbitrary `suchThat` (/=) ',')
55 -- | If the list is not just an empty element, and if the elements do
56 -- not contain commas, then join+split should be idempotent.
57 prop_commaJoinSplit :: Property
59 forAll (choose (0, 20)) $ \llen ->
60 forAll (vectorOf llen genNonCommaString `suchThat` (/=) [""]) $ \lst ->
61 sepSplit ',' (commaJoin lst) ==? lst
63 -- | Split and join should always be idempotent.
64 prop_commaSplitJoin :: String -> Property
65 prop_commaSplitJoin s =
66 commaJoin (sepSplit ',' s) ==? s
68 -- | fromObjWithDefault, we test using the Maybe monad and an integer
70 prop_fromObjWithDefault :: Integer -> String -> Bool
71 prop_fromObjWithDefault def_value random_key =
72 -- a missing key will be returned with the default
73 JSON.fromObjWithDefault [] random_key def_value == Just def_value &&
74 -- a found key will be returned as is, not with default
75 JSON.fromObjWithDefault [(random_key, J.showJSON def_value)]
76 random_key (def_value+1) == Just def_value
78 -- | Test that functional if' behaves like the syntactic sugar if.
79 prop_if'if :: Bool -> Int -> Int -> Gen Prop
81 if' cnd a b ==? if cnd then a else b
83 -- | Test basic select functionality
84 prop_select :: Int -- ^ Default result
85 -> [Int] -- ^ List of False values
86 -> [Int] -- ^ List of True values
87 -> Gen Prop -- ^ Test result
88 prop_select def lst1 lst2 =
89 select def (flist ++ tlist) ==? expectedresult
90 where expectedresult = if' (null lst2) def (head lst2)
91 flist = zip (repeat False) lst1
92 tlist = zip (repeat True) lst2
94 -- | Test basic select functionality with undefined default
95 prop_select_undefd :: [Int] -- ^ List of False values
96 -> NonEmptyList Int -- ^ List of True values
97 -> Gen Prop -- ^ Test result
98 prop_select_undefd lst1 (NonEmpty lst2) =
99 select undefined (flist ++ tlist) ==? head lst2
100 where flist = zip (repeat False) lst1
101 tlist = zip (repeat True) lst2
103 -- | Test basic select functionality with undefined list values
104 prop_select_undefv :: [Int] -- ^ List of False values
105 -> NonEmptyList Int -- ^ List of True values
106 -> Gen Prop -- ^ Test result
107 prop_select_undefv lst1 (NonEmpty lst2) =
108 select undefined cndlist ==? head lst2
109 where flist = zip (repeat False) lst1
110 tlist = zip (repeat True) lst2
111 cndlist = flist ++ tlist ++ [undefined]
113 prop_parseUnit :: NonNegative Int -> Property
114 prop_parseUnit (NonNegative n) =
116 [ parseUnit (show n) ==? (Ok n::Result Int)
117 , parseUnit (show n ++ "m") ==? (Ok n::Result Int)
118 , parseUnit (show n ++ "M") ==? (Ok (truncate n_mb)::Result Int)
119 , parseUnit (show n ++ "g") ==? (Ok (n*1024)::Result Int)
120 , parseUnit (show n ++ "G") ==? (Ok (truncate n_gb)::Result Int)
121 , parseUnit (show n ++ "t") ==? (Ok (n*1048576)::Result Int)
122 , parseUnit (show n ++ "T") ==? (Ok (truncate n_tb)::Result Int)
123 , printTestCase "Internal error/overflow?"
124 (n_mb >=0 && n_gb >= 0 && n_tb >= 0)
125 , property (isBad (parseUnit (show n ++ "x")::Result Int))
127 where n_mb = (fromIntegral n::Rational) * 1000 * 1000 / 1024 / 1024
131 {-# ANN case_niceSort_static "HLint: ignore Use camelCase" #-}
133 case_niceSort_static :: Assertion
134 case_niceSort_static = do
135 assertEqual "empty list" [] $ niceSort []
136 assertEqual "punctuation" [",", "."] $ niceSort [",", "."]
137 assertEqual "decimal numbers" ["0.1", "0.2"] $ niceSort ["0.1", "0.2"]
138 assertEqual "various numbers" ["0,099", "0.1", "0.2", "0;099"] $
139 niceSort ["0;099", "0,099", "0.1", "0.2"]
141 assertEqual "simple concat" ["0000", "a0", "a1", "a2", "a20", "a99",
142 "b00", "b10", "b70"] $
143 niceSort ["a0", "a1", "a99", "a20", "a2", "b10", "b70", "b00", "0000"]
145 assertEqual "ranges" ["A", "Z", "a0-0", "a0-4", "a1-0", "a9-1", "a09-2",
146 "a20-3", "a99-3", "a99-10", "b"] $
147 niceSort ["a0-0", "a1-0", "a99-10", "a20-3", "a0-4", "a99-3", "a09-2",
148 "Z", "a9-1", "A", "b"]
151 ["3jTwJPtrXOY22bwL2YoW", "Eegah9ei", "KOt7vn1dWXi",
152 "KVQqLPDjcPjf8T3oyzjcOsfkb", "WvNJd91OoXvLzdEiEXa6",
153 "Z8Ljf1Pf5eBfNg171wJR", "a07h8feON165N67PIE", "bH4Q7aCu3PUPjK3JtH",
154 "cPRi0lM7HLnSuWA2G9", "guKJkXnkULealVC8CyF1xefym",
155 "pqF8dkU5B1cMnyZuREaSOADYx", "uHXAyYYftCSG1o7qcCqe",
156 "xij88brTulHYAv8IEOyU", "xpIUJeVT1Rp"] $
157 niceSort ["Eegah9ei", "xij88brTulHYAv8IEOyU", "3jTwJPtrXOY22bwL2YoW",
158 "Z8Ljf1Pf5eBfNg171wJR", "WvNJd91OoXvLzdEiEXa6",
159 "uHXAyYYftCSG1o7qcCqe", "xpIUJeVT1Rp", "KOt7vn1dWXi",
160 "a07h8feON165N67PIE", "bH4Q7aCu3PUPjK3JtH",
161 "cPRi0lM7HLnSuWA2G9", "KVQqLPDjcPjf8T3oyzjcOsfkb",
162 "guKJkXnkULealVC8CyF1xefym", "pqF8dkU5B1cMnyZuREaSOADYx"]
164 -- | Tests single-string behaviour of 'niceSort'. Last test is special
165 -- in the sense that /0/ is before any other non-empty string (except
167 prop_niceSort_single :: Property
168 prop_niceSort_single =
169 forAll genName $ \name ->
171 [ printTestCase "single string" $ [name] ==? niceSort [name]
172 , printTestCase "single plus empty" $ ["", name] ==? niceSort [name, ""]
173 , printTestCase "single plus 0-digit" $ ["0", name] ==? niceSort [name, "0"]
176 -- | Tests some generic 'niceSort' properties. Note that the last test
177 -- must add a non-digit prefix; a digit one might change ordering.
178 prop_niceSort_generic :: Property
179 prop_niceSort_generic =
180 forAll (resize 20 arbitrary) $ \names ->
181 let n_sorted = niceSort names in
182 conjoin [ printTestCase "length" $ length names ==? length n_sorted
183 , printTestCase "same strings" $ sort names ==? sort n_sorted
184 , printTestCase "idempotence" $ n_sorted ==? niceSort n_sorted
185 , printTestCase "static prefix" $ n_sorted ==?
186 map tail (niceSort $ map (" "++) names)
189 -- | Tests that niceSorting numbers is identical to actual sorting
190 -- them (in numeric form).
191 prop_niceSort_numbers :: Property
192 prop_niceSort_numbers =
193 forAll (listOf (arbitrary::Gen (NonNegative Int))) $ \numbers ->
194 map show (sort numbers) ==? niceSort (map show numbers)
196 -- | Tests that 'niceSort' and 'niceSortKey' are equivalent.
197 prop_niceSortKey_equiv :: Property
198 prop_niceSortKey_equiv =
199 forAll (resize 20 arbitrary) $ \names ->
200 forAll (vectorOf (length names) (arbitrary::Gen Int)) $ \numbers ->
201 let n_sorted = niceSort names in
203 [ printTestCase "key id" $ n_sorted ==? niceSortKey id names
204 , printTestCase "key rev" $ niceSort (map reverse names) ==?
205 map reverse (niceSortKey reverse names)
206 , printTestCase "key snd" $ n_sorted ==? map snd (niceSortKey snd $
210 -- | Tests 'rstripSpace'.
211 prop_rStripSpace :: NonEmptyList Char -> Property
212 prop_rStripSpace (NonEmpty str) =
213 forAll (resize 50 $ listOf1 (arbitrary `suchThat` isSpace)) $ \whitespace ->
214 conjoin [ printTestCase "arb. string last char is not space" $
215 case rStripSpace str of
217 xs -> not . isSpace $ last xs
218 , printTestCase "whitespace suffix is stripped" $
219 rStripSpace str ==? rStripSpace (str ++ whitespace)
220 , printTestCase "whitespace reduced to null" $
221 rStripSpace whitespace ==? ""
222 , printTestCase "idempotent on empty strings" $
223 rStripSpace "" ==? ""
226 #ifndef NO_REGEX_PCRE
227 -- | Tests that the newUUID function produces valid UUIDs.
228 case_new_uuid :: Assertion
231 assertBool "newUUID" $ uuid =~ C.uuidRegex
234 -- | Test list for the Utils module.
236 [ 'prop_commaJoinSplit
237 , 'prop_commaSplitJoin
238 , 'prop_fromObjWithDefault
241 , 'prop_select_undefd
242 , 'prop_select_undefv
244 , 'case_niceSort_static
245 , 'prop_niceSort_single
246 , 'prop_niceSort_generic
247 , 'prop_niceSort_numbers
248 , 'prop_niceSortKey_equiv
250 #ifndef NO_REGEX_PCRE