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: Niklas Hambuechen <niklash@google.com>
Reviewed-by: Klaus Aehlig <aehlig@google.com>

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

Cherry-picked-from: 4320ba1dcfe49b659abbc46a6cf37e6a4db66f22
Signed-off-by: Petr Pudlak <pudlak@google.com>
Reviewed-by: Klaus Aehlig <aehlig@google.com>

diff --git a/test/hs/Test/Ganeti/HTools/Types.hs b/test/hs/Test/Ganeti/HTools/Types.hs
index af7e426..bf49363 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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