Also add 'genSublist' which picks a random sublist from a given list.
Signed-off-by: Petr Pudlak <[email protected]>
---
test/hs/Test/Ganeti/TestCommon.hs | 17 +++++++++++++++++
test/hs/Test/Ganeti/Utils.hs | 18 ++++++++++++++++++
2 files changed, 35 insertions(+)
diff --git a/test/hs/Test/Ganeti/TestCommon.hs
b/test/hs/Test/Ganeti/TestCommon.hs
index 38a1ab6..bfb1849 100644
--- a/test/hs/Test/Ganeti/TestCommon.hs
+++ b/test/hs/Test/Ganeti/TestCommon.hs
@@ -44,6 +44,7 @@ module Test.Ganeti.TestCommon
, genFQDN
, genUUID
, genMaybe
+ , genSublist
, genTags
, genFields
, genUniquesList
@@ -227,6 +228,22 @@ genUUID = do
genMaybe :: Gen a -> Gen (Maybe a)
genMaybe subgen = frequency [ (1, pure Nothing), (3, Just <$> subgen) ]
+-- | Generates a sublist of a given list, keeping the ordering.
+-- The generated elements are always a subset of the list.
+--
+-- In order to better support corner cases, the size of the sublist is
+-- chosen to have the uniform distribution.
+genSublist :: [a] -> Gen [a]
+genSublist xs = choose (0, l) >>= g xs l
+ where
+ l = length xs
+ g _ _ 0 = return []
+ g [] _ _ = return []
+ g ys n k | k == n = return ys
+ g (y:ys) n k = frequency [ (k, liftM (y :) (g ys (n - 1) (k - 1)))
+ , (n - k, g ys (n - 1) k)
+ ]
+
-- | Defines a tag type.
newtype TagChar = TagChar { tagGetChar :: Char }
diff --git a/test/hs/Test/Ganeti/Utils.hs b/test/hs/Test/Ganeti/Utils.hs
index 5275d5b..b39d3b1 100644
--- a/test/hs/Test/Ganeti/Utils.hs
+++ b/test/hs/Test/Ganeti/Utils.hs
@@ -34,6 +34,8 @@ import Test.HUnit
import Data.Char (isSpace)
import qualified Data.Either as Either
import Data.List
+import Data.Maybe (listToMaybe)
+import qualified Data.Set as S
import System.Time
import qualified Text.JSON as J
#ifndef NO_REGEX_PCRE
@@ -67,6 +69,21 @@ prop_commaSplitJoin :: String -> Property
prop_commaSplitJoin s =
commaJoin (sepSplit ',' s) ==? s
+-- | Test 'findFirst' on several possible inputs.
+prop_findFirst :: Property
+prop_findFirst =
+ forAll (genSublist [0..5 :: Int]) $ \xs ->
+ forAll (choose (-2, 7)) $ \base ->
+ printTestCase "findFirst utility function" $
+ let r = findFirst base (S.fromList xs)
+ (ss, es) = partition (< r) $ dropWhile (< base) xs
+ -- the prefix must be a range of numbers
+ -- and the suffix must not start with 'r'
+ in conjoin [ and $ zipWith ((==) . (+ 1)) ss (drop 1 ss)
+ , maybe True (> r) (listToMaybe es)
+ ]
+
+
-- | fromObjWithDefault, we test using the Maybe monad and an integer
-- value.
prop_fromObjWithDefault :: Integer -> String -> Bool
@@ -328,6 +345,7 @@ prop_splitRecombineEithers es =
testSuite "Utils"
[ 'prop_commaJoinSplit
, 'prop_commaSplitJoin
+ , 'prop_findFirst
, 'prop_fromObjWithDefault
, 'prop_if'if
, 'prop_select
--
1.9.1.423.g4596e3a
