From: Niklas Hambuechen <[email protected]> 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: Niklas Hambuechen <[email protected]> Reviewed-by: Klaus Aehlig <[email protected]> Conflicts: test/hs/Test/Ganeti/JQScheduler.hs - removed file not present in 2.12 Cherry-picked-from: 4320ba1dcfe49b659abbc46a6cf37e6a4db66f22 Signed-off-by: Petr Pudlak <[email protected]> --- test/hs/Test/Ganeti/HTools/Types.hs | 24 ++++++++++++------------ test/hs/Test/Ganeti/JQueue.hs | 5 +++-- test/hs/Test/Ganeti/JSON.hs | 5 +++-- test/hs/Test/Ganeti/Objects/BitArray.hs | 4 ++-- test/hs/Test/Ganeti/Storage/Drbd/Types.hs | 12 ++++++------ test/hs/Test/Ganeti/TestCommon.hs | 2 +- test/hs/Test/Ganeti/Utils.hs | 8 ++++---- 7 files changed, 31 insertions(+), 29 deletions(-) diff --git a/test/hs/Test/Ganeti/HTools/Types.hs b/test/hs/Test/Ganeti/HTools/Types.hs index af7e426..bf49363 100644 --- a/test/hs/Test/Ganeti/HTools/Types.hs +++ b/test/hs/Test/Ganeti/HTools/Types.hs @@ -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 diff --git a/test/hs/Test/Ganeti/JQueue.hs b/test/hs/Test/Ganeti/JQueue.hs index 09acc88..47c4aaa 100644 --- a/test/hs/Test/Ganeti/JQueue.hs +++ b/test/hs/Test/Ganeti/JQueue.hs @@ -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 diff --git a/test/hs/Test/Ganeti/JSON.hs b/test/hs/Test/Ganeti/JSON.hs index 9e32bd6..394ba9b 100644 --- a/test/hs/Test/Ganeti/JSON.hs +++ b/test/hs/Test/Ganeti/JSON.hs @@ -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 ] diff --git a/test/hs/Test/Ganeti/Objects/BitArray.hs b/test/hs/Test/Ganeti/Objects/BitArray.hs index 05056ad..ae4d177 100644 --- a/test/hs/Test/Ganeti/Objects/BitArray.hs +++ b/test/hs/Test/Ganeti/Objects/BitArray.hs @@ -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) diff --git a/test/hs/Test/Ganeti/Storage/Drbd/Types.hs b/test/hs/Test/Ganeti/Storage/Drbd/Types.hs index 546d438..4dd5ac7 100644 --- a/test/hs/Test/Ganeti/Storage/Drbd/Types.hs +++ b/test/hs/Test/Ganeti/Storage/Drbd/Types.hs @@ -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 diff --git a/test/hs/Test/Ganeti/TestCommon.hs b/test/hs/Test/Ganeti/TestCommon.hs index 792cced..015601f 100644 --- a/test/hs/Test/Ganeti/TestCommon.hs +++ b/test/hs/Test/Ganeti/TestCommon.hs @@ -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. -- diff --git a/test/hs/Test/Ganeti/Utils.hs b/test/hs/Test/Ganeti/Utils.hs index ede6c69..6eea227 100644 --- a/test/hs/Test/Ganeti/Utils.hs +++ b/test/hs/Test/Ganeti/Utils.hs @@ -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 -- 2.4.3.573.g4eafbef
