commit b2b1a897c546fe7ea4efb29bf844bc2a5c9721ca
Merge: fce1b94 9fa8438
Author: Petr Pudlak <[email protected]>
Date: Mon Jun 29 16:25:27 2015 +0200
Merge branch 'stable-2.12' into stable-2.13
* stable-2.12
Update design doc with solution for Issue 1094
Prevent multiple communication nics for one instance
Remove outdated reference to ganeti-masterd
Update ganeti-luxid man page
Add a man page for ganeti-wconfd
Make htools tolerate missing "dtotal" and "dfree" on luxi
Get QuickCheck 2.7 compatibility
TestCommon: Fix QuickCheck import warnings
Full QuickCheck 2.7 compatibility
Add a CPP macro for checking the version of QuickCheck
QuickCheck 2.7 compatibility
* stable-2.11
Downgrade log-message for rereading job
Dowgrade log-level for successful requests
Conflicts:
test/hs/Test/Ganeti/TestCommon.hs
Resolution:
test/hs/Test/Ganeti/TestCommon.hs: keep additions from both
versions
Signed-off-by: Petr Pudlak <[email protected]>
diff --cc test/hs/Test/Ganeti/HTools/Backend/Text.hs
index 19cfa60,5500ba2..e0f20fd
--- a/test/hs/Test/Ganeti/HTools/Backend/Text.hs
+++ b/test/hs/Test/Ganeti/HTools/Backend/Text.hs
@@@ -212,13 -211,11 +212,13 @@@ prop_CreateSerialise
forAll (genInstanceSmallerThanNode node) $ \inst ->
let nl = makeSmallCluster node count
reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
+ opts = Alg.defaultOptions
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= \allocn ->
- Cluster.iterateAlloc nl Container.empty (Just maxiter) inst allocn [] []
+ Cluster.iterateAlloc opts nl Container.empty (Just maxiter) inst allocn
+ [] []
of
Bad msg -> failTest $ "Failed to allocate: " ++ msg
- Ok (_, _, _, [], _) -> printTestCase
+ Ok (_, _, _, [], _) -> counterexample
"Failed to allocate: no allocations" False
Ok (_, nl', il', _, _) ->
let cdata = Loader.ClusterData defGroupList nl' il' ctags
diff --cc test/hs/Test/Ganeti/TestCommon.hs
index aa7647e,9ab434b..59be1cf
--- a/test/hs/Test/Ganeti/TestCommon.hs
+++ b/test/hs/Test/Ganeti/TestCommon.hs
@@@ -87,9 -84,17 +88,18 @@@ module Test.Ganeti.TestCommo
, genNonNegative
, relativeError
, getTempFileName
+ , listOfUniqueBy
+ , counterexample
) where
+ -- The following macro is just a temporary solution for 2.12 and 2.13.
+ -- Since 2.14 cabal creates proper macros for all dependencies.
+ #define MIN_VERSION_QuickCheck(maj,min,rev) \
+ (((maj)<QUICKCHECK_MAJOR)|| \
+ (((maj)==QUICKCHECK_MAJOR)&&((min)<=QUICKCHECK_MINOR))|| \
+ (((maj)==QUICKCHECK_MAJOR)&&((min)==QUICKCHECK_MINOR)&& \
+ ((rev)<=QUICKCHECK_REV)))
+
import Control.Applicative
import Control.Exception (catchJust)
import Control.Monad
@@@ -547,35 -517,7 +560,40 @@@ getTempFileName filename = d
return fpath
+-- | @listOfUniqueBy gen keyFun forbidden@: Generates a list of random length,
+-- where all generated elements will be unique by the keying function
+-- @keyFun@. They will also be distinct from all elements in @forbidden@ by
+-- the keying function.
+--
+-- As for 'listOf', the maximum output length depends on the size parameter.
+--
+-- Example:
+--
+-- > listOfUniqueBy (arbitrary :: Gen String) (length) ["hey"]
+-- > -- Generates a list of strings of different length, but not of length 3.
+--
+-- The passed @gen@ should not make key collisions too likely, since the
+-- implementation uses `suchThat`, looping until enough unique elements
+-- have been generated. If the @gen@ makes collisions likely, this function
+-- will consequently be slow, or not terminate if it is not possible to
+-- generate enough elements, like in:
+--
+-- > listOfUniqueBy (arbitrary :: Gen Int) (`mod` 2) []
+-- > -- May not terminate depending on the size parameter of the Gen,
+-- > -- since there are only 2 unique keys (0 and 1).
+listOfUniqueBy :: (Ord b) => Gen a -> (a -> b) -> [a] -> Gen [a]
+listOfUniqueBy gen keyFun forbidden = do
+ let keysOf = Set.fromList . map keyFun
+
+ k <- sized $ \n -> choose (0, n)
+ flip unfoldrM (0, keysOf forbidden) $ \(i, usedKeys) ->
+ if i == k
+ then return Nothing
+ else do
+ x <- gen `suchThat` ((`Set.notMember` usedKeys) . keyFun)
+ return $ Just (x, (i + 1, Set.insert (keyFun x) usedKeys))
++
+ #if !MIN_VERSION_QuickCheck(2,7,0)
+ counterexample :: Testable prop => String -> prop -> Property
+ counterexample = QC.printTestCase
+ #endif
