From: Niklas Hambuechen <[email protected]> This renames the deprecated `printTestCase` to its replacement `counterexample`, add provides a CPP-guarded fallback for QuickCheck < 2.7.
Signed-off-by: Niklas Hambuechen <[email protected]> Reviewed-by: Klaus Aehlig <[email protected]> Conflicts: test/hs/Test/Ganeti/TestCommon.hs test/hs/Test/Ganeti/Utils/Statistics.hs Resolution: test/hs/TeGst/Ganeti/TestCommon.hs: keep changes introduced in 2.12 after the previous cherry-picking of this patch test/hs/Test/Ganeti/Utils/Statistics.hs: keep the current limit 1e-10 in prop_stddev_update Cherry-picked-from: 077c415a09f8c381ce788ebe6c065d8ccab60564 Signed-off-by: Petr Pudlak <[email protected]> --- test/hs/Test/Ganeti/JQScheduler.hs | 8 ++++---- test/hs/Test/Ganeti/SlotMap.hs | 8 ++++---- test/hs/Test/Ganeti/TestCommon.hs | 1 + test/hs/Test/Ganeti/Utils/Statistics.hs | 4 ++-- 4 files changed, 11 insertions(+), 10 deletions(-) diff --git a/test/hs/Test/Ganeti/JQScheduler.hs b/test/hs/Test/Ganeti/JQScheduler.hs index 9430495..a05a879 100644 --- a/test/hs/Test/Ganeti/JQScheduler.hs +++ b/test/hs/Test/Ganeti/JQScheduler.hs @@ -238,11 +238,11 @@ prop_reasonRateLimit = "queued jobs cannot be started because of rate limiting" $ conjoin - [ printTestCase "scheduled jobs must be subsequence" $ + [ counterexample "scheduled jobs must be subsequence" $ toRun `isSubsequenceOf` enqueued -- This is the key property: - , printTestCase "no job may exceed its bucket limits, except from\ + , counterexample "no job may exceed its bucket limits, except from\ \ jobs that were already running with exceeded\ \ limits; those must not increase" $ conjoin @@ -557,10 +557,10 @@ prop_jobFiltering = -- bugs 25 and 27). in (enqueued /= []) ==> actionCovers $ conjoin - [ printTestCase "scheduled jobs must be subsequence" $ + [ counterexample "scheduled jobs must be subsequence" $ toRun `isSubsequenceOf` enqueued - , printTestCase "a reason for each job (not) being scheduled" . + , counterexample "a reason for each job (not) being scheduled" . -- All enqueued jobs must have a reason why they were (not) -- scheduled, determined by the filter that applies. diff --git a/test/hs/Test/Ganeti/SlotMap.hs b/test/hs/Test/Ganeti/SlotMap.hs index 53580dc..295240d 100644 --- a/test/hs/Test/Ganeti/SlotMap.hs +++ b/test/hs/Test/Ganeti/SlotMap.hs @@ -182,9 +182,9 @@ prop_occupySlots = forAll arbitrary $ \(sm :: SlotMap Int, cm :: CountMap Int) -> let smOcc = sm `occupySlots` cm in conjoin - [ printTestCase "input keys are preserved" $ + [ counterexample "input keys are preserved" $ all (`member` smOcc) (keyUnion sm cm) - , printTestCase "all keys must come from the input keys" $ + , counterexample "all keys must come from the input keys" $ all (`Set.member` keyUnion sm cm) (keys smOcc) ] @@ -251,12 +251,12 @@ prop_hasSlotsFor = oldOverfullBucks = overfullKeys sm1 newOverfullBucks = overfullKeys smOcc in conjoin - [ printTestCase "if there's enough extra space, then the new\ + [ counterexample "if there's enough extra space, then the new\ \ overfull keys must be as before" $ fits ==> (newOverfullBucks ==? oldOverfullBucks) -- Note that the other way around does not hold: -- (newOverfullBucks == oldOverfullBucks) ==> fits - , printTestCase "joining SlotMaps must not change the number of\ + , counterexample "joining SlotMaps must not change the number of\ \ overfull keys (but may change their slot\ \ counts" . property $ size newOverfullBucks >= size oldOverfullBucks diff --git a/test/hs/Test/Ganeti/TestCommon.hs b/test/hs/Test/Ganeti/TestCommon.hs index 59be1cf..3991e5e 100644 --- a/test/hs/Test/Ganeti/TestCommon.hs +++ b/test/hs/Test/Ganeti/TestCommon.hs @@ -593,6 +593,7 @@ listOfUniqueBy gen keyFun forbidden = 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 diff --git a/test/hs/Test/Ganeti/Utils/Statistics.hs b/test/hs/Test/Ganeti/Utils/Statistics.hs index 90fd8bd..a74d6e4 100644 --- a/test/hs/Test/Ganeti/Utils/Statistics.hs +++ b/test/hs/Test/Ganeti/Utils/Statistics.hs @@ -58,8 +58,8 @@ prop_stddev_update = $ updateStatistics (getStdDevStatistics original) (a,b) direct = stdDev modified in counterexample ("Value computed by update " ++ show with_update - ++ " differs too much from correct value " ++ show direct) - (abs (with_update - direct) < 1e-10) + ++ " differs too much from correct value " ++ show direct) + (abs (with_update - direct) < 1e-10) testSuite "Utils/Statistics" [ 'prop_stddev_update -- 2.4.3.573.g4eafbef
