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

   1 {-# LANGUAGE TemplateHaskell #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3
   4 {-| Unittests for ganeti-htools.
   5
   6 -}
   7
   8 {-
   9
  10 Copyright (C) 2009, 2010, 2011, 2012 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
  32 import Test.HUnit
  33
  34 import Data.List
  35 import qualified Text.JSON as J
  36
  37 import Test.Ganeti.TestHelper
  38 import Test.Ganeti.TestCommon
  39
  40 import qualified Ganeti.JSON as JSON
  41 import qualified Ganeti.HTools.Types as Types
  42 import Ganeti.Utils
  43
  44 -- | Helper to generate a small string that doesn't contain commas.
  45 genNonCommaString :: Gen String
  46 genNonCommaString = do
  47   size <- choose (0, 20) -- arbitrary max size
  48   vectorOf size (arbitrary `suchThat` (/=) ',')
  49
  50 -- | If the list is not just an empty element, and if the elements do
  51 -- not contain commas, then join+split should be idempotent.
  52 prop_commaJoinSplit :: Property
  53 prop_commaJoinSplit =
  54   forAll (choose (0, 20)) $ \llen ->
  55   forAll (vectorOf llen genNonCommaString `suchThat` (/=) [""]) $ \lst ->
  56   sepSplit ',' (commaJoin lst) ==? lst
  57
  58 -- | Split and join should always be idempotent.
  59 prop_commaSplitJoin :: String -> Property
  60 prop_commaSplitJoin s =
  61   commaJoin (sepSplit ',' s) ==? s
  62
  63 -- | fromObjWithDefault, we test using the Maybe monad and an integer
  64 -- value.
  65 prop_fromObjWithDefault :: Integer -> String -> Bool
  66 prop_fromObjWithDefault def_value random_key =
  67   -- a missing key will be returned with the default
  68   JSON.fromObjWithDefault [] random_key def_value == Just def_value &&
  69   -- a found key will be returned as is, not with default
  70   JSON.fromObjWithDefault [(random_key, J.showJSON def_value)]
  71        random_key (def_value+1) == Just def_value
  72
  73 -- | Test that functional if' behaves like the syntactic sugar if.
  74 prop_if'if :: Bool -> Int -> Int -> Gen Prop
  75 prop_if'if cnd a b =
  76   if' cnd a b ==? if cnd then a else b
  77
  78 -- | Test basic select functionality
  79 prop_select :: Int      -- ^ Default result
  80             -> [Int]    -- ^ List of False values
  81             -> [Int]    -- ^ List of True values
  82             -> Gen Prop -- ^ Test result
  83 prop_select def lst1 lst2 =
  84   select def (flist ++ tlist) ==? expectedresult
  85     where expectedresult = if' (null lst2) def (head lst2)
  86           flist = zip (repeat False) lst1
  87           tlist = zip (repeat True)  lst2
  88
  89 -- | Test basic select functionality with undefined default
  90 prop_select_undefd :: [Int]            -- ^ List of False values
  91                    -> NonEmptyList Int -- ^ List of True values
  92                    -> Gen Prop         -- ^ Test result
  93 prop_select_undefd lst1 (NonEmpty lst2) =
  94   select undefined (flist ++ tlist) ==? head lst2
  95     where flist = zip (repeat False) lst1
  96           tlist = zip (repeat True)  lst2
  97
  98 -- | Test basic select functionality with undefined list values
  99 prop_select_undefv :: [Int]            -- ^ List of False values
 100                    -> NonEmptyList Int -- ^ List of True values
 101                    -> Gen Prop         -- ^ Test result
 102 prop_select_undefv lst1 (NonEmpty lst2) =
 103   select undefined cndlist ==? head lst2
 104     where flist = zip (repeat False) lst1
 105           tlist = zip (repeat True)  lst2
 106           cndlist = flist ++ tlist ++ [undefined]
 107
 108 prop_parseUnit :: NonNegative Int -> Property
 109 prop_parseUnit (NonNegative n) =
 110   parseUnit (show n) ==? Types.Ok n .&&.
 111   parseUnit (show n ++ "m") ==? Types.Ok n .&&.
 112   parseUnit (show n ++ "M") ==? Types.Ok (truncate n_mb::Int) .&&.
 113   parseUnit (show n ++ "g") ==? Types.Ok (n*1024) .&&.
 114   parseUnit (show n ++ "G") ==? Types.Ok (truncate n_gb::Int) .&&.
 115   parseUnit (show n ++ "t") ==? Types.Ok (n*1048576) .&&.
 116   parseUnit (show n ++ "T") ==? Types.Ok (truncate n_tb::Int) .&&.
 117   printTestCase "Internal error/overflow?"
 118     (n_mb >=0 && n_gb >= 0 && n_tb >= 0) .&&.
 119   property (Types.isBad (parseUnit (show n ++ "x")::Types.Result Int))
 120   where n_mb = (fromIntegral n::Rational) * 1000 * 1000 / 1024 / 1024
 121         n_gb = n_mb * 1000
 122         n_tb = n_gb * 1000
 123
 124 {-# ANN case_niceSort_static "HLint: ignore Use camelCase" #-}
 125
 126 case_niceSort_static :: Assertion
 127 case_niceSort_static = do
 128   assertEqual "empty list" [] $ niceSort []
 129   assertEqual "punctuation" [",", "."] $ niceSort [",", "."]
 130   assertEqual "decimal numbers" ["0.1", "0.2"] $ niceSort ["0.1", "0.2"]
 131   assertEqual "various numbers" ["0,099", "0.1", "0.2", "0;099"] $
 132               niceSort ["0;099", "0,099", "0.1", "0.2"]
 133
 134   assertEqual "simple concat" ["0000", "a0", "a1", "a2", "a20", "a99",
 135                                "b00", "b10", "b70"] $
 136     niceSort ["a0", "a1", "a99", "a20", "a2", "b10", "b70", "b00", "0000"]
 137
 138   assertEqual "ranges" ["A", "Z", "a0-0", "a0-4", "a1-0", "a9-1", "a09-2",
 139                       "a20-3", "a99-3", "a99-10", "b"] $
 140     niceSort ["a0-0", "a1-0", "a99-10", "a20-3", "a0-4", "a99-3", "a09-2",
 141               "Z", "a9-1", "A", "b"]
 142
 143   assertEqual "large"
 144     ["3jTwJPtrXOY22bwL2YoW", "Eegah9ei", "KOt7vn1dWXi",
 145      "KVQqLPDjcPjf8T3oyzjcOsfkb", "WvNJd91OoXvLzdEiEXa6",
 146      "Z8Ljf1Pf5eBfNg171wJR", "a07h8feON165N67PIE", "bH4Q7aCu3PUPjK3JtH",
 147      "cPRi0lM7HLnSuWA2G9", "guKJkXnkULealVC8CyF1xefym",
 148      "pqF8dkU5B1cMnyZuREaSOADYx", "uHXAyYYftCSG1o7qcCqe",
 149      "xij88brTulHYAv8IEOyU", "xpIUJeVT1Rp"] $
 150     niceSort ["Eegah9ei", "xij88brTulHYAv8IEOyU", "3jTwJPtrXOY22bwL2YoW",
 151              "Z8Ljf1Pf5eBfNg171wJR", "WvNJd91OoXvLzdEiEXa6",
 152              "uHXAyYYftCSG1o7qcCqe", "xpIUJeVT1Rp", "KOt7vn1dWXi",
 153              "a07h8feON165N67PIE", "bH4Q7aCu3PUPjK3JtH",
 154              "cPRi0lM7HLnSuWA2G9", "KVQqLPDjcPjf8T3oyzjcOsfkb",
 155              "guKJkXnkULealVC8CyF1xefym", "pqF8dkU5B1cMnyZuREaSOADYx"]
 156
 157 -- | Tests single-string behaviour of 'niceSort'. Last test is special
 158 -- in the sense that /0/ is before any other non-empty string (except
 159 -- itself, etc.).
 160 prop_niceSort_single :: Property
 161 prop_niceSort_single =
 162   forAll getName $ \name ->
 163   conjoin
 164   [ printTestCase "single string" $ [name] ==? niceSort [name]
 165   , printTestCase "single plus empty" $ ["", name] ==? niceSort [name, ""]
 166   , printTestCase "single plus 0-digit" $ ["0", name] ==? niceSort [name, "0"]
 167   ]
 168
 169 -- | Tests some generic 'niceSort' properties. Note that the last test
 170 -- must add a non-digit prefix; a digit one might change ordering.
 171 prop_niceSort_generic :: Property
 172 prop_niceSort_generic =
 173   forAll (resize 20 arbitrary) $ \names ->
 174   let n_sorted = niceSort names in
 175   conjoin [ printTestCase "length" $ length names ==? length n_sorted
 176           , printTestCase "same strings" $ sort names ==? sort n_sorted
 177           , printTestCase "idempotence" $ n_sorted ==? niceSort n_sorted
 178           , printTestCase "static prefix" $ n_sorted ==?
 179               map tail (niceSort $ map (" "++) names)
 180           ]
 181
 182 -- | Tests that niceSorting numbers is identical to actual sorting
 183 -- them (in numeric form).
 184 prop_niceSort_numbers :: Property
 185 prop_niceSort_numbers =
 186   forAll (listOf (arbitrary::Gen (NonNegative Int))) $ \numbers ->
 187   map show (sort numbers) ==? niceSort (map show numbers)
 188
 189 -- | Tests that 'niceSort' and 'niceSortKey' are equivalent.
 190 prop_niceSortKey_equiv :: Property
 191 prop_niceSortKey_equiv =
 192   forAll (resize 20 arbitrary) $ \names ->
 193   forAll (vectorOf (length names) (arbitrary::Gen Int)) $ \numbers ->
 194   let n_sorted = niceSort names in
 195   conjoin
 196   [ printTestCase "key id" $ n_sorted ==? niceSortKey id names
 197   , printTestCase "key rev" $ niceSort (map reverse names) ==?
 198                               map reverse (niceSortKey reverse names)
 199   , printTestCase "key snd" $ n_sorted ==? map snd (niceSortKey snd $
 200                                                     zip numbers names)
 201   ]
 202
 203 -- | Test list for the Utils module.
 204 testSuite "Utils"
 205             [ 'prop_commaJoinSplit
 206             , 'prop_commaSplitJoin
 207             , 'prop_fromObjWithDefault
 208             , 'prop_if'if
 209             , 'prop_select
 210             , 'prop_select_undefd
 211             , 'prop_select_undefv
 212             , 'prop_parseUnit
 213             , 'case_niceSort_static
 214             , 'prop_niceSort_single
 215             , 'prop_niceSort_generic
 216             , 'prop_niceSort_numbers
 217             , 'prop_niceSortKey_equiv
 218             ]