code.grnet.gr Git - ganeti-local/blob - htest/Test/Ganeti/Query/Language.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.Query.Language
  30   ( testQlang
  31   , genFilter
  32   ) where
  33
  34 import Test.QuickCheck
  35
  36 import Control.Applicative
  37 import qualified Text.JSON as J
  38
  39 import Test.Ganeti.TestHelper
  40 import Test.Ganeti.TestCommon
  41
  42 import qualified Ganeti.Query.Language as Qlang
  43
  44 -- | Custom 'Qlang.Filter' generator (top-level), which enforces a
  45 -- (sane) limit on the depth of the generated filters.
  46 genFilter :: Gen (Qlang.Filter Qlang.FilterField)
  47 genFilter = choose (0, 10) >>= genFilter'
  48
  49 -- | Custom generator for filters that correctly halves the state of
  50 -- the generators at each recursive step, per the QuickCheck
  51 -- documentation, in order not to run out of memory.
  52 genFilter' :: Int -> Gen (Qlang.Filter Qlang.FilterField)
  53 genFilter' 0 =
  54   oneof [ return Qlang.EmptyFilter
  55         , Qlang.TrueFilter     <$> getName
  56         , Qlang.EQFilter       <$> getName <*> value
  57         , Qlang.LTFilter       <$> getName <*> value
  58         , Qlang.GTFilter       <$> getName <*> value
  59         , Qlang.LEFilter       <$> getName <*> value
  60         , Qlang.GEFilter       <$> getName <*> value
  61         , Qlang.RegexpFilter   <$> getName <*> arbitrary
  62         , Qlang.ContainsFilter <$> getName <*> value
  63         ]
  64     where value = oneof [ Qlang.QuotedString <$> getName
  65                         , Qlang.NumericValue <$> arbitrary
  66                         ]
  67 genFilter' n = do
  68   oneof [ Qlang.AndFilter  <$> vectorOf n'' (genFilter' n')
  69         , Qlang.OrFilter   <$> vectorOf n'' (genFilter' n')
  70         , Qlang.NotFilter  <$> genFilter' n'
  71         ]
  72   where n' = n `div` 2 -- sub-filter generator size
  73         n'' = max n' 2 -- but we don't want empty or 1-element lists,
  74                        -- so use this for and/or filter list length
  75
  76 instance Arbitrary Qlang.ItemType where
  77   arbitrary = elements [minBound..maxBound]
  78
  79 instance Arbitrary Qlang.FilterRegex where
  80   arbitrary = getName >>= Qlang.mkRegex -- a name should be a good regex
  81
  82 -- | Tests that serialisation/deserialisation of filters is
  83 -- idempotent.
  84 prop_Qlang_Serialisation :: Property
  85 prop_Qlang_Serialisation =
  86   forAll genFilter $ \flt ->
  87   J.readJSON (J.showJSON flt) ==? J.Ok flt
  88
  89 prop_Qlang_FilterRegex_instances :: Qlang.FilterRegex -> Property
  90 prop_Qlang_FilterRegex_instances rex =
  91   printTestCase "failed JSON encoding"
  92     (J.readJSON (J.showJSON rex) ==? J.Ok rex) .&&.
  93   printTestCase "failed read/show instances" (read (show rex) ==? rex)
  94
  95 testSuite "Qlang"
  96   [ 'prop_Qlang_Serialisation
  97   , 'prop_Qlang_FilterRegex_instances
  98   ]