From e033b7bdc6f5d59a31313b06625d4b5915737ea9 Mon Sep 17 00:00:00 2001 From: Fraser Murray Date: Wed, 9 Jul 2025 17:24:34 +0100 Subject: [PATCH] support QuickCheck-2.16 --- .../Test/QuickCheck/DynamicLogic/Internal.hs | 29 ++++++++++--------- .../src/Test/QuickCheck/StateModel.hs | 3 +- .../Test/QuickCheck/StateModel/Variables.hs | 2 +- .../test/Spec/DynamicLogic/Counters.hs | 2 +- .../test/Spec/DynamicLogic/RegistryModel.hs | 21 +++++++------- 5 files changed, 30 insertions(+), 27 deletions(-) diff --git a/quickcheck-dynamic/src/Test/QuickCheck/DynamicLogic/Internal.hs b/quickcheck-dynamic/src/Test/QuickCheck/DynamicLogic/Internal.hs index d8388927..0b41933e 100644 --- a/quickcheck-dynamic/src/Test/QuickCheck/DynamicLogic/Internal.hs +++ b/quickcheck-dynamic/src/Test/QuickCheck/DynamicLogic/Internal.hs @@ -4,7 +4,8 @@ import Control.Applicative import Control.Arrow (second) import Control.Monad import Data.Typeable -import Test.QuickCheck hiding (generate) +import Test.QuickCheck (Gen, Property, Testable) +import Test.QuickCheck qualified as QC import Test.QuickCheck.DynamicLogic.CanGenerate import Test.QuickCheck.DynamicLogic.Quantify import Test.QuickCheck.DynamicLogic.SmartShrinking @@ -359,8 +360,8 @@ forAllUniqueScripts s f k = let d = unDynFormula f sz n = unsafeNextVarIndex $ vars s in case generate chooseUniqueNextStep d n s 500 of - Nothing -> counterexample "Generating Non-unique script in forAllUniqueScripts" False - Just test -> validDLTest test . applyMonitoring d test . property $ k (scriptFromDL test) + Nothing -> QC.counterexample "Generating Non-unique script in forAllUniqueScripts" False + Just test -> validDLTest test . applyMonitoring d test . QC.property $ k (scriptFromDL test) -- | Creates a `Property` from `DynFormula` with some specialised isomorphism for shrinking purpose. forAllMappedScripts @@ -373,22 +374,22 @@ forAllMappedScripts forAllMappedScripts to from f k = QC.withSize $ \n -> let d = unDynFormula f n - in forAllShrinkBlind - (Smart 0 <$> sized ((from <$>) . generateDLTest d)) + in QC.forAllShrinkBlind + (QC.Smart 0 <$> QC.sized ((from <$>) . generateDLTest d)) (shrinkSmart ((from <$>) . shrinkDLTest d . to)) - $ \(Smart _ script) -> + $ \(QC.Smart _ script) -> withDLScript d k (to script) withDLScript :: (DynLogicModel s, Testable a) => DynLogic s -> (Actions s -> a) -> DynLogicTest s -> Property withDLScript d k test = - validDLTest test . applyMonitoring d test . property $ k (scriptFromDL test) + validDLTest test . applyMonitoring d test . QC.property $ k (scriptFromDL test) withDLScriptPrefix :: (DynLogicModel s, Testable a) => DynFormula s -> (Actions s -> a) -> DynLogicTest s -> Property withDLScriptPrefix f k test = QC.withSize $ \n -> let d = unDynFormula f n test' = unfailDLTest d test - in validDLTest test' . applyMonitoring d test' . property $ k (scriptFromDL test') + in validDLTest test' . applyMonitoring d test' . QC.property $ k (scriptFromDL test') -- | Validate generated test case. -- @@ -401,9 +402,9 @@ withDLScriptPrefix f k test = validDLTest :: StateModel s => DynLogicTest s -> Property -> Property validDLTest test prop = case test of - DLScript{} -> counterexample (show test) prop - Stuck{} -> property Discard - _other -> counterexample (show test) False + DLScript{} -> QC.counterexample (show test) prop + Stuck{} -> QC.property QC.Discard + _other -> QC.counterexample (show test) False generateDLTest :: DynLogicModel s => DynLogic s -> Int -> Gen (DynLogicTest s) generateDLTest d size = generate chooseNextStep d 0 (initialStateFor d) size @@ -516,7 +517,7 @@ nextSteps' gen (ForAll q f) = do nextSteps' gen (Monitor _f d) = nextSteps' gen d chooseOneOf :: [(Double, a)] -> Gen a -chooseOneOf steps = frequency [(round (w / never), return s) | (w, s) <- steps] +chooseOneOf steps = QC.frequency [(round (w / never), return s) | (w, s) <- steps] never :: Double never = 1.0e-9 @@ -586,7 +587,7 @@ keepTryingUntil :: Int -> Gen a -> (a -> Bool) -> Gen (Maybe a) keepTryingUntil 0 _ _ = return Nothing keepTryingUntil n g p = do x <- g - if p x then return $ Just x else scale (+ 1) $ keepTryingUntil (n - 1) g p + if p x then return $ Just x else QC.scale (+ 1) $ keepTryingUntil (n - 1) g p shrinkDLTest :: DynLogicModel s => DynLogic s -> DynLogicTest s -> [DynLogicTest s] shrinkDLTest _ (Looping _) = [] @@ -710,7 +711,7 @@ demonicAlt ds = foldr1 (Alt Demonic) ds propPruningGeneratedScriptIsNoop :: DynLogicModel s => DynLogic s -> Property propPruningGeneratedScriptIsNoop d = - forAll (sized $ \n -> choose (1, max 1 n) >>= generateDLTest d) $ \test -> + QC.forAll (QC.sized $ \n -> QC.choose (1, max 1 n) >>= generateDLTest d) $ \test -> let script = case test of BadPrecondition s _ _ -> s Looping s -> s diff --git a/quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs b/quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs index a67507de..daccbbcf 100644 --- a/quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs +++ b/quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs @@ -56,7 +56,8 @@ import Data.Monoid (Endo (..)) import Data.Set qualified as Set import Data.Void import GHC.Generics -import Test.QuickCheck as QC +import Test.QuickCheck (Arbitrary, Gen, Property, Smart (..), Testable, counterexample, forAllShrink, frequency, property, resize, shrinkList, sized, tabulate) +import Test.QuickCheck qualified as QC import Test.QuickCheck.DynamicLogic.SmartShrinking import Test.QuickCheck.Monadic import Test.QuickCheck.StateModel.Variables diff --git a/quickcheck-dynamic/src/Test/QuickCheck/StateModel/Variables.hs b/quickcheck-dynamic/src/Test/QuickCheck/StateModel/Variables.hs index 620c98f5..a42a8b5c 100644 --- a/quickcheck-dynamic/src/Test/QuickCheck/StateModel/Variables.hs +++ b/quickcheck-dynamic/src/Test/QuickCheck/StateModel/Variables.hs @@ -31,7 +31,7 @@ import Data.Set qualified as Set import GHC.Generics import GHC.TypeLits import GHC.Word -import Test.QuickCheck as QC +import Test.QuickCheck (Gen, Smart (..), elements) -- | A symbolic variable for a value of type `a` newtype Var a = Var Int diff --git a/quickcheck-dynamic/test/Spec/DynamicLogic/Counters.hs b/quickcheck-dynamic/test/Spec/DynamicLogic/Counters.hs index aa68c99b..e842be62 100644 --- a/quickcheck-dynamic/test/Spec/DynamicLogic/Counters.hs +++ b/quickcheck-dynamic/test/Spec/DynamicLogic/Counters.hs @@ -6,7 +6,7 @@ module Spec.DynamicLogic.Counters where import Control.Monad.Reader import Data.IORef -import Test.QuickCheck +import Test.QuickCheck (frequency) import Test.QuickCheck.StateModel -- A very simple model with a single action that always succeed in diff --git a/quickcheck-dynamic/test/Spec/DynamicLogic/RegistryModel.hs b/quickcheck-dynamic/test/Spec/DynamicLogic/RegistryModel.hs index 22315321..2ede548c 100644 --- a/quickcheck-dynamic/test/Spec/DynamicLogic/RegistryModel.hs +++ b/quickcheck-dynamic/test/Spec/DynamicLogic/RegistryModel.hs @@ -10,7 +10,8 @@ import Data.Either import Data.List import Data.Map (Map) import Data.Map qualified as Map -import Test.QuickCheck +import Test.QuickCheck (Gen, Property) +import Test.QuickCheck qualified as QC import Test.QuickCheck.Monadic hiding (assert) import Test.QuickCheck.Monadic qualified as QC import Test.Tasty hiding (after) @@ -56,7 +57,7 @@ instance StateModel RegState where arbitraryAction ctx s = let threadIdCtx = ctxAtType @ThreadId ctx - in frequency $ + in QC.frequency $ [ ( max 1 $ 10 - length threadIdCtx , return $ Some Spawn @@ -135,15 +136,15 @@ instance RunModel RegState RegM where postconditionOnFailure (s, _) act@Register{} _ res = do monitorPost $ - tabulate + QC.tabulate "Reason for -Register" [why s act] pure $ isLeft res postconditionOnFailure _s _ _ _ = pure True monitoring (_s, s') act@(showDictAction -> ShowDict) _ res = - counterexample (show res ++ " <- " ++ show act ++ "\n -- State: " ++ show s') - . tabulate "Registry size" [show $ Map.size (regs s')] + QC.counterexample (show res ++ " <- " ++ show act ++ "\n -- State: " ++ show s') + . QC.tabulate "Registry size" [show $ Map.size (regs s')] data ShowDict a where ShowDict :: Show a => ShowDict a @@ -167,13 +168,13 @@ why s (Register name tid) = why _ _ = "(impossible)" arbitraryName :: Gen String -arbitraryName = elements allNames +arbitraryName = QC.elements allNames probablyRegistered :: RegState -> Gen String -probablyRegistered s = oneof $ map pure (Map.keys $ regs s) ++ [arbitraryName] +probablyRegistered s = QC.oneof $ map pure (Map.keys $ regs s) ++ [arbitraryName] probablyUnregistered :: RegState -> Gen String -probablyUnregistered s = elements $ allNames ++ (allNames \\ Map.keys (regs s)) +probablyUnregistered s = QC.elements $ allNames ++ (allNames \\ Map.keys (regs s)) shrinkName :: String -> [String] shrinkName name = [n | n <- allNames, n < name] @@ -184,7 +185,7 @@ allNames = ["a", "b", "c", "d", "e"] prop_Registry :: Actions RegState -> Property prop_Registry s = monadicIO $ do - monitor $ counterexample "\nExecution\n" + monitor $ QC.counterexample "\nExecution\n" reg <- lift setupRegistry runPropertyReaderT (runActions s) reg QC.assert True @@ -270,5 +271,5 @@ tests = [ testProperty "prop_Registry" $ prop_Registry , testProperty "moreActions 10 $ prop_Registry" $ moreActions 10 prop_Registry , testProperty "canRegister" $ propDL canRegister - , testProperty "canRegisterNoUnregister" $ expectFailure $ propDL canRegisterNoUnregister + , testProperty "canRegisterNoUnregister" $ QC.expectFailure $ propDL canRegisterNoUnregister ]