Merge pull request #91 from fraser-iohk/fraser-iohk/support-QuickCheck-2.16

support QuickCheck-2.16

Author: ch1bo

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

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

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

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

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
     ]