code.grnet.gr Git - ganeti-local/blob - htest/Test/Ganeti/Objects.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.Objects
  30   ( testObjects
  31   , Objects.Hypervisor(..)
  32   , Objects.Node(..)
  33   ) where
  34
  35 import Control.Applicative
  36 import qualified Data.Map as Map
  37 import qualified Data.Set as Set
  38 import Test.QuickCheck
  39
  40 import Test.Ganeti.TestHelper
  41 import Test.Ganeti.TestCommon
  42 import qualified Ganeti.Objects as Objects
  43
  44 instance Arbitrary Objects.Hypervisor where
  45   arbitrary = elements [minBound..maxBound]
  46
  47 instance Arbitrary Objects.PartialNDParams where
  48   arbitrary = Objects.PartialNDParams <$> arbitrary <*> arbitrary
  49
  50 instance Arbitrary Objects.Node where
  51   arbitrary = Objects.Node <$> getFQDN <*> getFQDN <*> getFQDN
  52               <*> arbitrary <*> arbitrary <*> arbitrary <*> getFQDN
  53               <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
  54               <*> arbitrary <*> arbitrary <*> getFQDN <*> arbitrary
  55               <*> (Set.fromList <$> genTags)
  56
  57 -- | Tests that fillDict behaves correctly
  58 prop_Objects_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property
  59 prop_Objects_fillDict defaults custom =
  60   let d_map = Map.fromList defaults
  61       d_keys = map fst defaults
  62       c_map = Map.fromList custom
  63       c_keys = map fst custom
  64   in printTestCase "Empty custom filling"
  65       (Objects.fillDict d_map Map.empty [] == d_map) .&&.
  66      printTestCase "Empty defaults filling"
  67       (Objects.fillDict Map.empty c_map [] == c_map) .&&.
  68      printTestCase "Delete all keys"
  69       (Objects.fillDict d_map c_map (d_keys++c_keys) == Map.empty)
  70
  71 testSuite "Objects"
  72   [ 'prop_Objects_fillDict
  73   ]