code.grnet.gr Git - ganeti-local/blob - test/hs/Test/Ganeti/HTools/Container.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, 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.HTools.Container (testHTools_Container) where
  30
  31 import Test.QuickCheck
  32
  33 import Data.Maybe
  34
  35 import Test.Ganeti.TestHelper
  36 import Test.Ganeti.TestCommon
  37 import Test.Ganeti.TestHTools
  38 import Test.Ganeti.HTools.Node (genNode)
  39
  40 import qualified Ganeti.HTools.Container as Container
  41 import qualified Ganeti.HTools.Node as Node
  42
  43 -- we silence the following due to hlint bug fixed in later versions
  44 {-# ANN prop_addTwo "HLint: ignore Avoid lambda" #-}
  45 prop_addTwo :: [Container.Key] -> Int -> Int -> Bool
  46 prop_addTwo cdata i1 i2 =
  47   fn i1 i2 cont == fn i2 i1 cont &&
  48   fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
  49     where cont = foldl (\c x -> Container.add x x c) Container.empty cdata
  50           fn x1 x2 = Container.addTwo x1 x1 x2 x2
  51
  52 prop_nameOf :: Node.Node -> Property
  53 prop_nameOf node =
  54   let nl = makeSmallCluster node 1
  55   in case Container.elems nl of
  56        [] -> failTest "makeSmallCluster 1 returned empty cluster?"
  57        _:_:_ -> failTest "makeSmallCluster 1 returned >1 node?"
  58        fnode:_ -> Container.nameOf nl (Node.idx fnode) ==? Node.name fnode
  59
  60 -- | We test that in a cluster, given a random node, we can find it by
  61 -- its name and alias, as long as all names and aliases are unique,
  62 -- and that we fail to find a non-existing name.
  63 prop_findByName :: Property
  64 prop_findByName =
  65   forAll (genNode (Just 1) Nothing) $ \node ->
  66   forAll (choose (1, 20)) $ \ cnt ->
  67   forAll (choose (0, cnt - 1)) $ \ fidx ->
  68   forAll (genUniquesList (cnt * 2) arbitrary) $ \ allnames ->
  69   forAll (arbitrary `suchThat` (`notElem` allnames)) $ \ othername ->
  70   let names = zip (take cnt allnames) (drop cnt allnames)
  71       nl = makeSmallCluster node cnt
  72       nodes = Container.elems nl
  73       nodes' = map (\((name, alias), nn) -> (Node.idx nn,
  74                                              nn { Node.name = name,
  75                                                   Node.alias = alias }))
  76                $ zip names nodes
  77       nl' = Container.fromList nodes'
  78       target = snd (nodes' !! fidx)
  79   in conjoin
  80        [ Container.findByName nl' (Node.name target) ==? Just target
  81        , Container.findByName nl' (Node.alias target) ==? Just target
  82        , printTestCase "Found non-existing name"
  83          (isNothing (Container.findByName nl' othername))
  84        ]
  85
  86 testSuite "HTools/Container"
  87             [ 'prop_addTwo
  88             , 'prop_nameOf
  89             , 'prop_findByName
  90             ]