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

   1 {-# LANGUAGE TemplateHaskell, CPP #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3
   4 {-| Unittests for ganeti-htools.
   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.Utils (testUtils) where
  30
  31 import Test.QuickCheck hiding (Result)
  32 import Test.HUnit
  33
  34 import Data.Char (isSpace)
  35 import Data.List
  36 import System.Time
  37 import qualified Text.JSON as J
  38 #ifndef NO_REGEX_PCRE
  39 import Text.Regex.PCRE
  40 #endif
  41
  42 import Test.Ganeti.TestHelper
  43 import Test.Ganeti.TestCommon
  44
  45 import Ganeti.BasicTypes
  46 import qualified Ganeti.Constants as C
  47 import qualified Ganeti.JSON as JSON
  48 import Ganeti.Utils
  49
  50 -- | Helper to generate a small string that doesn't contain commas.
  51 genNonCommaString :: Gen String
  52 genNonCommaString = do
  53   size <- choose (0, 20) -- arbitrary max size
  54   vectorOf size (arbitrary `suchThat` (/=) ',')
  55
  56 -- | If the list is not just an empty element, and if the elements do
  57 -- not contain commas, then join+split should be idempotent.
  58 prop_commaJoinSplit :: Property
  59 prop_commaJoinSplit =
  60   forAll (choose (0, 20)) $ \llen ->
  61   forAll (vectorOf llen genNonCommaString `suchThat` (/=) [""]) $ \lst ->
  62   sepSplit ',' (commaJoin lst) ==? lst
  63
  64 -- | Split and join should always be idempotent.
  65 prop_commaSplitJoin :: String -> Property
  66 prop_commaSplitJoin s =
  67   commaJoin (sepSplit ',' s) ==? s
  68
  69 -- | fromObjWithDefault, we test using the Maybe monad and an integer
  70 -- value.
  71 prop_fromObjWithDefault :: Integer -> String -> Bool
  72 prop_fromObjWithDefault def_value random_key =
  73   -- a missing key will be returned with the default
  74   JSON.fromObjWithDefault [] random_key def_value == Just def_value &&
  75   -- a found key will be returned as is, not with default
  76   JSON.fromObjWithDefault [(random_key, J.showJSON def_value)]
  77        random_key (def_value+1) == Just def_value
  78
  79 -- | Test that functional if' behaves like the syntactic sugar if.
  80 prop_if'if :: Bool -> Int -> Int -> Gen Prop
  81 prop_if'if cnd a b =
  82   if' cnd a b ==? if cnd then a else b
  83
  84 -- | Test basic select functionality
  85 prop_select :: Int      -- ^ Default result
  86             -> [Int]    -- ^ List of False values
  87             -> [Int]    -- ^ List of True values
  88             -> Gen Prop -- ^ Test result
  89 prop_select def lst1 lst2 =
  90   select def (flist ++ tlist) ==? expectedresult
  91     where expectedresult = if' (null lst2) def (head lst2)
  92           flist = zip (repeat False) lst1
  93           tlist = zip (repeat True)  lst2
  94
  95 -- | Test basic select functionality with undefined default
  96 prop_select_undefd :: [Int]            -- ^ List of False values
  97                    -> NonEmptyList Int -- ^ List of True values
  98                    -> Gen Prop         -- ^ Test result
  99 prop_select_undefd lst1 (NonEmpty lst2) =
 100   select undefined (flist ++ tlist) ==? head lst2
 101     where flist = zip (repeat False) lst1
 102           tlist = zip (repeat True)  lst2
 103
 104 -- | Test basic select functionality with undefined list values
 105 prop_select_undefv :: [Int]            -- ^ List of False values
 106                    -> NonEmptyList Int -- ^ List of True values
 107                    -> Gen Prop         -- ^ Test result
 108 prop_select_undefv lst1 (NonEmpty lst2) =
 109   select undefined cndlist ==? head lst2
 110     where flist = zip (repeat False) lst1
 111           tlist = zip (repeat True)  lst2
 112           cndlist = flist ++ tlist ++ [undefined]
 113
 114 prop_parseUnit :: NonNegative Int -> Property
 115 prop_parseUnit (NonNegative n) =
 116   conjoin
 117   [ parseUnit (show n) ==? (Ok n::Result Int)
 118   , parseUnit (show n ++ "m") ==? (Ok n::Result Int)
 119   , parseUnit (show n ++ "M") ==? (Ok (truncate n_mb)::Result Int)
 120   , parseUnit (show n ++ "g") ==? (Ok (n*1024)::Result Int)
 121   , parseUnit (show n ++ "G") ==? (Ok (truncate n_gb)::Result Int)
 122   , parseUnit (show n ++ "t") ==? (Ok (n*1048576)::Result Int)
 123   , parseUnit (show n ++ "T") ==? (Ok (truncate n_tb)::Result Int)
 124   , printTestCase "Internal error/overflow?"
 125     (n_mb >=0 && n_gb >= 0 && n_tb >= 0)
 126   , property (isBad (parseUnit (show n ++ "x")::Result Int))
 127   ]
 128   where n_mb = (fromIntegral n::Rational) * 1000 * 1000 / 1024 / 1024
 129         n_gb = n_mb * 1000
 130         n_tb = n_gb * 1000
 131
 132 {-# ANN case_niceSort_static "HLint: ignore Use camelCase" #-}
 133
 134 case_niceSort_static :: Assertion
 135 case_niceSort_static = do
 136   assertEqual "empty list" [] $ niceSort []
 137   assertEqual "punctuation" [",", "."] $ niceSort [",", "."]
 138   assertEqual "decimal numbers" ["0.1", "0.2"] $ niceSort ["0.1", "0.2"]
 139   assertEqual "various numbers" ["0,099", "0.1", "0.2", "0;099"] $
 140               niceSort ["0;099", "0,099", "0.1", "0.2"]
 141
 142   assertEqual "simple concat" ["0000", "a0", "a1", "a2", "a20", "a99",
 143                                "b00", "b10", "b70"] $
 144     niceSort ["a0", "a1", "a99", "a20", "a2", "b10", "b70", "b00", "0000"]
 145
 146   assertEqual "ranges" ["A", "Z", "a0-0", "a0-4", "a1-0", "a9-1", "a09-2",
 147                       "a20-3", "a99-3", "a99-10", "b"] $
 148     niceSort ["a0-0", "a1-0", "a99-10", "a20-3", "a0-4", "a99-3", "a09-2",
 149               "Z", "a9-1", "A", "b"]
 150
 151   assertEqual "large"
 152     ["3jTwJPtrXOY22bwL2YoW", "Eegah9ei", "KOt7vn1dWXi",
 153      "KVQqLPDjcPjf8T3oyzjcOsfkb", "WvNJd91OoXvLzdEiEXa6",
 154      "Z8Ljf1Pf5eBfNg171wJR", "a07h8feON165N67PIE", "bH4Q7aCu3PUPjK3JtH",
 155      "cPRi0lM7HLnSuWA2G9", "guKJkXnkULealVC8CyF1xefym",
 156      "pqF8dkU5B1cMnyZuREaSOADYx", "uHXAyYYftCSG1o7qcCqe",
 157      "xij88brTulHYAv8IEOyU", "xpIUJeVT1Rp"] $
 158     niceSort ["Eegah9ei", "xij88brTulHYAv8IEOyU", "3jTwJPtrXOY22bwL2YoW",
 159              "Z8Ljf1Pf5eBfNg171wJR", "WvNJd91OoXvLzdEiEXa6",
 160              "uHXAyYYftCSG1o7qcCqe", "xpIUJeVT1Rp", "KOt7vn1dWXi",
 161              "a07h8feON165N67PIE", "bH4Q7aCu3PUPjK3JtH",
 162              "cPRi0lM7HLnSuWA2G9", "KVQqLPDjcPjf8T3oyzjcOsfkb",
 163              "guKJkXnkULealVC8CyF1xefym", "pqF8dkU5B1cMnyZuREaSOADYx"]
 164
 165 -- | Tests single-string behaviour of 'niceSort'.
 166 prop_niceSort_single :: Property
 167 prop_niceSort_single =
 168   forAll genName $ \name ->
 169   conjoin
 170   [ printTestCase "single string" $ [name] ==? niceSort [name]
 171   , printTestCase "single plus empty" $ ["", name] ==? niceSort [name, ""]
 172   ]
 173
 174 -- | Tests some generic 'niceSort' properties. Note that the last test
 175 -- must add a non-digit prefix; a digit one might change ordering.
 176 prop_niceSort_generic :: Property
 177 prop_niceSort_generic =
 178   forAll (resize 20 arbitrary) $ \names ->
 179   let n_sorted = niceSort names in
 180   conjoin [ printTestCase "length" $ length names ==? length n_sorted
 181           , printTestCase "same strings" $ sort names ==? sort n_sorted
 182           , printTestCase "idempotence" $ n_sorted ==? niceSort n_sorted
 183           , printTestCase "static prefix" $ n_sorted ==?
 184               map tail (niceSort $ map (" "++) names)
 185           ]
 186
 187 -- | Tests that niceSorting numbers is identical to actual sorting
 188 -- them (in numeric form).
 189 prop_niceSort_numbers :: Property
 190 prop_niceSort_numbers =
 191   forAll (listOf (arbitrary::Gen (NonNegative Int))) $ \numbers ->
 192   map show (sort numbers) ==? niceSort (map show numbers)
 193
 194 -- | Tests that 'niceSort' and 'niceSortKey' are equivalent.
 195 prop_niceSortKey_equiv :: Property
 196 prop_niceSortKey_equiv =
 197   forAll (resize 20 arbitrary) $ \names ->
 198   forAll (vectorOf (length names) (arbitrary::Gen Int)) $ \numbers ->
 199   let n_sorted = niceSort names in
 200   conjoin
 201   [ printTestCase "key id" $ n_sorted ==? niceSortKey id names
 202   , printTestCase "key rev" $ niceSort (map reverse names) ==?
 203                               map reverse (niceSortKey reverse names)
 204   , printTestCase "key snd" $ n_sorted ==? map snd (niceSortKey snd $
 205                                                     zip numbers names)
 206   ]
 207
 208 -- | Tests 'rStripSpace'.
 209 prop_rStripSpace :: NonEmptyList Char -> Property
 210 prop_rStripSpace (NonEmpty str) =
 211   forAll (resize 50 $ listOf1 (arbitrary `suchThat` isSpace)) $ \whitespace ->
 212   conjoin [ printTestCase "arb. string last char is not space" $
 213               case rStripSpace str of
 214                 [] -> True
 215                 xs -> not . isSpace $ last xs
 216           , printTestCase "whitespace suffix is stripped" $
 217               rStripSpace str ==? rStripSpace (str ++ whitespace)
 218           , printTestCase "whitespace reduced to null" $
 219               rStripSpace whitespace ==? ""
 220           , printTestCase "idempotent on empty strings" $
 221               rStripSpace "" ==? ""
 222           ]
 223
 224 #ifndef NO_REGEX_PCRE
 225 {-# ANN case_new_uuid "HLint: ignore Use camelCase" #-}
 226
 227 -- | Tests that the newUUID function produces valid UUIDs.
 228 case_new_uuid :: Assertion
 229 case_new_uuid = do
 230   uuid <- newUUID
 231   assertBool "newUUID" $ uuid =~ C.uuidRegex
 232 #endif
 233
 234 prop_clockTimeToString :: Integer -> Integer -> Property
 235 prop_clockTimeToString ts pico =
 236   clockTimeToString (TOD ts pico) ==? show ts
 237
 238 -- | Test normal operation for 'chompPrefix'.
 239 --
 240 -- Any random prefix of a string must be stripped correctly, including the empty
 241 -- prefix, and the whole string.
 242 prop_chompPrefix_normal :: String -> Property
 243 prop_chompPrefix_normal str =
 244   forAll (choose (0, length str)) $ \size ->
 245   chompPrefix (take size str) str ==? (Just $ drop size str)
 246
 247 -- | Test that 'chompPrefix' correctly allows the last char (the separator) to
 248 -- be absent if the string terminates there.
 249 prop_chompPrefix_last :: Property
 250 prop_chompPrefix_last =
 251   forAll (choose (1, 20)) $ \len ->
 252   forAll (vectorOf len arbitrary) $ \pfx ->
 253   chompPrefix pfx pfx ==? Just "" .&&.
 254   chompPrefix pfx (init pfx) ==? Just ""
 255
 256 -- | Test that chompPrefix on the empty string always returns Nothing for
 257 -- prefixes of length 2 or more.
 258 prop_chompPrefix_empty_string :: Property
 259 prop_chompPrefix_empty_string =
 260   forAll (choose (2, 20)) $ \len ->
 261   forAll (vectorOf len arbitrary) $ \pfx ->
 262   chompPrefix pfx "" ==? Nothing
 263
 264 -- | Test 'chompPrefix' returns Nothing when the prefix doesn't match.
 265 prop_chompPrefix_nothing :: Property
 266 prop_chompPrefix_nothing =
 267   forAll (choose (1, 20)) $ \len ->
 268   forAll (vectorOf len arbitrary) $ \pfx ->
 269   forAll (arbitrary `suchThat`
 270           (\s -> not (pfx `isPrefixOf` s) && s /= init pfx)) $ \str ->
 271   chompPrefix pfx str ==? Nothing
 272
 273
 274 -- | Test list for the Utils module.
 275 testSuite "Utils"
 276             [ 'prop_commaJoinSplit
 277             , 'prop_commaSplitJoin
 278             , 'prop_fromObjWithDefault
 279             , 'prop_if'if
 280             , 'prop_select
 281             , 'prop_select_undefd
 282             , 'prop_select_undefv
 283             , 'prop_parseUnit
 284             , 'case_niceSort_static
 285             , 'prop_niceSort_single
 286             , 'prop_niceSort_generic
 287             , 'prop_niceSort_numbers
 288             , 'prop_niceSortKey_equiv
 289             , 'prop_rStripSpace
 290 #ifndef NO_REGEX_PCRE
 291             , 'case_new_uuid
 292 #endif
 293             , 'prop_clockTimeToString
 294             , 'prop_chompPrefix_normal
 295             , 'prop_chompPrefix_last
 296             , 'prop_chompPrefix_empty_string
 297             , 'prop_chompPrefix_nothing
 298             ]