Commit fce81542 authored by Niklas Hambuechen's avatar Niklas Hambuechen Committed by Petr Pudlak

QuickCheck 2.7 compatibility

This makes our test compile with out errors with QuickCheck 2.7.
Warnings about the deprecation of printTestCase remain when using 2.7.

This change is backwards-compatible with all older versions of QuickCheck
that we support.

In 2.7, Property is no longer a monad, but remains a `Gen Prop` inside,
so that we only have to use combinations of `property` and `return`
to become compatible.

See
  https://hackage.haskell.org/package/QuickCheck-2.7.6/changelog

Further, in QuickCheck 2.7, Positive/NonZero/NonNegative are no longer
instances of `Integral` (NonNegative could likely still be one, see
https://github.com/nick8325/quickcheck/issues/31).
Consequently we cannot create them using `fromIntegral` any more,
and switch to `fromEnum` instead, which also is backwards-compatible.
Signed-off-by: default avatarNiklas Hambuechen <niklash@google.com>
Reviewed-by: default avatarKlaus Aehlig <aehlig@google.com>

Conflicts:
	test/hs/Test/Ganeti/JQScheduler.hs - removed file not present in
          2.12

Cherry-picked-from: 4320ba1dSigned-off-by: default avatarPetr Pudlak <pudlak@google.com>
Reviewed-by: default avatarKlaus Aehlig <aehlig@google.com>
parent 21a6f27c
......@@ -83,12 +83,12 @@ instance Arbitrary Types.ISpec where
cpu_c <- arbitrary::Gen (NonNegative Int)
nic_c <- arbitrary::Gen (NonNegative Int)
su <- arbitrary::Gen (NonNegative Int)
return Types.ISpec { Types.iSpecMemorySize = fromIntegral mem_s
, Types.iSpecCpuCount = fromIntegral cpu_c
, Types.iSpecDiskSize = fromIntegral dsk_s
, Types.iSpecDiskCount = fromIntegral dsk_c
, Types.iSpecNicCount = fromIntegral nic_c
, Types.iSpecSpindleUse = fromIntegral su
return Types.ISpec { Types.iSpecMemorySize = fromEnum mem_s
, Types.iSpecCpuCount = fromEnum cpu_c
, Types.iSpecDiskSize = fromEnum dsk_s
, Types.iSpecDiskCount = fromEnum dsk_c
, Types.iSpecNicCount = fromEnum nic_c
, Types.iSpecSpindleUse = fromEnum su
}
-- | Generates an ispec bigger than the given one.
......@@ -100,12 +100,12 @@ genBiggerISpec imin = do
cpu_c <- choose (Types.iSpecCpuCount imin, maxBound)
nic_c <- choose (Types.iSpecNicCount imin, maxBound)
su <- choose (Types.iSpecSpindleUse imin, maxBound)
return Types.ISpec { Types.iSpecMemorySize = fromIntegral mem_s
, Types.iSpecCpuCount = fromIntegral cpu_c
, Types.iSpecDiskSize = fromIntegral dsk_s
, Types.iSpecDiskCount = fromIntegral dsk_c
, Types.iSpecNicCount = fromIntegral nic_c
, Types.iSpecSpindleUse = fromIntegral su
return Types.ISpec { Types.iSpecMemorySize = fromEnum mem_s
, Types.iSpecCpuCount = fromEnum cpu_c
, Types.iSpecDiskSize = fromEnum dsk_s
, Types.iSpecDiskCount = fromEnum dsk_c
, Types.iSpecNicCount = fromEnum nic_c
, Types.iSpecSpindleUse = fromEnum su
}
genMinMaxISpecs :: Gen Types.MinMaxISpecs
......
......@@ -101,10 +101,11 @@ case_JobPriorityDef = do
prop_JobPriority :: Property
prop_JobPriority =
forAll (listOf1 (genQueuedOpCode `suchThat`
(not . opStatusFinalized . qoStatus))) $ \ops -> do
(not . opStatusFinalized . qoStatus)))
$ \ops -> property $ do
jid0 <- makeJobId 0
let job = QueuedJob jid0 ops justNoTs justNoTs justNoTs Nothing Nothing
calcJobPriority job ==? minimum (map qoPriority ops)
return $ calcJobPriority job ==? minimum (map qoPriority ops) :: Gen Property
-- | Tests default job status.
case_JobStatusDef :: Assertion
......
......@@ -87,8 +87,9 @@ prop_arrayMaybeFromObj t xs k =
prop_arrayMaybeFromObjFail :: String -> String -> Property
prop_arrayMaybeFromObjFail t k =
case JSON.tryArrayMaybeFromObj t [] k of
BasicTypes.Ok r -> fail $
"Unexpected result, got: " ++ show (r::[Maybe Int])
BasicTypes.Ok r -> property
(fail $ "Unexpected result, got: " ++ show (r::[Maybe Int])
:: Gen Property)
BasicTypes.Bad e -> conjoin [ Data.List.isInfixOf t e ==? True
, Data.List.isInfixOf k e ==? True
]
......
......@@ -84,14 +84,14 @@ prop_BitArray_or xs ys =
-- | Check that the counts of 1 bits holds.
prop_BitArray_counts :: Property
prop_BitArray_counts = do
prop_BitArray_counts = property $ do
n <- choose (0, 3)
ones <- replicateM n (lst True)
zrs <- replicateM n (lst False)
start <- lst False
let count = sum . map length $ ones
bs = start ++ concat (zipWith (++) ones zrs)
count1 (BA.fromList bs) ==? count
return $ count1 (BA.fromList bs) ==? count
where
lst x = (`replicate` x) `liftM` choose (0, 2)
......
......@@ -72,7 +72,7 @@ wOrderFlag = elements ['b', 'f', 'd', 'n']
-- | Property for testing the JSON serialization of a DeviceInfo.
prop_DeviceInfo :: Property
prop_DeviceInfo = do
prop_DeviceInfo = property $ do
minor <- natural
state <- arbitrary
locRole <- arbitrary
......@@ -117,11 +117,11 @@ prop_DeviceInfo = do
, ("perfIndicators", showJSON perfInd)
, ("instance", maybe JSNull showJSON inst)
]
obtained ==? expected
return $ obtained ==? expected
-- | Property for testing the JSON serialization of a PerfIndicators.
prop_PerfIndicators :: Property
prop_PerfIndicators = do
prop_PerfIndicators = property $ do
ns <- natural
nr <- natural
dw <- natural
......@@ -154,11 +154,11 @@ prop_PerfIndicators = do
, optionalJSField "writeOrder" wo
, optionalJSField "outOfSync" oos
]
obtained ==? expected
return $ obtained ==? expected
-- | Function for testing the JSON serialization of a SyncStatus.
prop_SyncStatus :: Property
prop_SyncStatus = do
prop_SyncStatus = property $ do
perc <- percent
numer <- natural
denom <- natural
......@@ -182,7 +182,7 @@ prop_SyncStatus = do
, optionalJSField "want" wa
, Just ("speedUnit", showJSON $ show sizeU2 ++ "/" ++ show timeU)
]
obtained ==? expected
return $ obtained ==? expected
testSuite "Block/Drbd/Types"
[ 'prop_DeviceInfo
......
......@@ -474,7 +474,7 @@ genPropParser parser s expected =
-- | Generate an arbitrary non negative integer number
genNonNegative :: Gen Int
genNonNegative =
fmap fromIntegral (arbitrary::Gen (Test.QuickCheck.NonNegative Int))
fmap fromEnum (arbitrary::Gen (Test.QuickCheck.NonNegative Int))
-- | Computes the relative error of two 'Double' numbers.
--
......
......@@ -104,7 +104,7 @@ prop_fromObjWithDefault def_value random_key =
random_key (def_value+1) == Just def_value
-- | Test that functional if' behaves like the syntactic sugar if.
prop_if'if :: Bool -> Int -> Int -> Gen Prop
prop_if'if :: Bool -> Int -> Int -> Property
prop_if'if cnd a b =
if' cnd a b ==? if cnd then a else b
......@@ -112,7 +112,7 @@ prop_if'if cnd a b =
prop_select :: Int -- ^ Default result
-> [Int] -- ^ List of False values
-> [Int] -- ^ List of True values
-> Gen Prop -- ^ Test result
-> Property -- ^ Test result
prop_select def lst1 lst2 =
select def (flist ++ tlist) ==? expectedresult
where expectedresult = defaultHead def lst2
......@@ -123,7 +123,7 @@ prop_select def lst1 lst2 =
-- | Test basic select functionality with undefined default
prop_select_undefd :: [Int] -- ^ List of False values
-> NonEmptyList Int -- ^ List of True values
-> Gen Prop -- ^ Test result
-> Property -- ^ Test result
prop_select_undefd lst1 (NonEmpty lst2) =
-- head is fine as NonEmpty "guarantees" a non-empty list, but not
-- via types
......@@ -135,7 +135,7 @@ prop_select_undefd lst1 (NonEmpty lst2) =
-- | Test basic select functionality with undefined list values
prop_select_undefv :: [Int] -- ^ List of False values
-> NonEmptyList Int -- ^ List of True values
-> Gen Prop -- ^ Test result
-> Property -- ^ Test result
prop_select_undefv lst1 (NonEmpty lst2) =
-- head is fine as NonEmpty "guarantees" a non-empty list, but not
-- via types
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment