Skip to content

Commit 23ead38

Browse files
fraser-iohkcoot
authored andcommitted
support QuickCheck-2.16
1 parent 3187fd0 commit 23ead38

File tree

5 files changed

+30
-27
lines changed

5 files changed

+30
-27
lines changed

quickcheck-dynamic/src/Test/QuickCheck/DynamicLogic/Internal.hs

Lines changed: 15 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,8 @@ import Control.Applicative
44
import Control.Arrow (second)
55
import Control.Monad
66
import Data.Typeable
7-
import Test.QuickCheck hiding (generate)
7+
import Test.QuickCheck (Gen, Property, Testable)
8+
import Test.QuickCheck qualified as QC
89
import Test.QuickCheck.DynamicLogic.CanGenerate
910
import Test.QuickCheck.DynamicLogic.Quantify
1011
import Test.QuickCheck.DynamicLogic.SmartShrinking
@@ -360,8 +361,8 @@ forAllUniqueScripts s f k =
360361
let d = unDynFormula f sz
361362
n = unsafeNextVarIndex $ vars s
362363
in case generate chooseUniqueNextStep d n s 500 of
363-
Nothing -> counterexample "Generating Non-unique script in forAllUniqueScripts" False
364-
Just test -> validDLTest d test . applyMonitoring d test . property $ k (scriptFromDL test)
364+
Nothing -> QC.counterexample "Generating Non-unique script in forAllUniqueScripts" False
365+
Just test -> validDLTest d test . applyMonitoring d test . QC.property $ k (scriptFromDL test)
365366

366367
-- | Creates a `Property` from `DynFormula` with some specialised isomorphism for shrinking purpose.
367368
forAllMappedScripts
@@ -374,22 +375,22 @@ forAllMappedScripts
374375
forAllMappedScripts to from f k =
375376
QC.withSize $ \n ->
376377
let d = unDynFormula f n
377-
in forAllShrinkBlind
378-
(Smart 0 <$> sized ((from <$>) . generateDLTest d))
378+
in QC.forAllShrinkBlind
379+
(QC.Smart 0 <$> QC.sized ((from <$>) . generateDLTest d))
379380
(shrinkSmart ((from <$>) . shrinkDLTest d . to))
380-
$ \(Smart _ script) ->
381+
$ \(QC.Smart _ script) ->
381382
withDLScript d k (to script)
382383

383384
withDLScript :: (DynLogicModel s, Testable a) => DynLogic s -> (Actions s -> a) -> DynLogicTest s -> Property
384385
withDLScript d k test =
385-
validDLTest d test . applyMonitoring d test . property $ k (scriptFromDL test)
386+
validDLTest d test . applyMonitoring d test . QC.property $ k (scriptFromDL test)
386387

387388
withDLScriptPrefix :: (DynLogicModel s, Testable a) => DynFormula s -> (Actions s -> a) -> DynLogicTest s -> Property
388389
withDLScriptPrefix f k test =
389390
QC.withSize $ \n ->
390391
let d = unDynFormula f n
391392
test' = unfailDLTest d test
392-
in validDLTest d test' . applyMonitoring d test' . property $ k (scriptFromDL test')
393+
in validDLTest d test' . applyMonitoring d test' . QC.property $ k (scriptFromDL test')
393394

394395
generateDLTest :: DynLogicModel s => DynLogic s -> Int -> Gen (DynLogicTest s)
395396
generateDLTest d size = generate chooseNextStep d 0 (initialStateFor d) size
@@ -502,7 +503,7 @@ nextSteps' gen (ForAll q f) = do
502503
nextSteps' gen (Monitor _f d) = nextSteps' gen d
503504

504505
chooseOneOf :: [(Double, a)] -> Gen a
505-
chooseOneOf steps = frequency [(round (w / never), return s) | (w, s) <- steps]
506+
chooseOneOf steps = QC.frequency [(round (w / never), return s) | (w, s) <- steps]
506507

507508
never :: Double
508509
never = 1.0e-9
@@ -572,7 +573,7 @@ keepTryingUntil :: Int -> Gen a -> (a -> Bool) -> Gen (Maybe a)
572573
keepTryingUntil 0 _ _ = return Nothing
573574
keepTryingUntil n g p = do
574575
x <- g
575-
if p x then return $ Just x else scale (+ 1) $ keepTryingUntil (n - 1) g p
576+
if p x then return $ Just x else QC.scale (+ 1) $ keepTryingUntil (n - 1) g p
576577

577578
shrinkDLTest :: DynLogicModel s => DynLogic s -> DynLogicTest s -> [DynLogicTest s]
578579
shrinkDLTest _ (Looping _) = []
@@ -696,7 +697,7 @@ demonicAlt ds = foldr1 (Alt Demonic) ds
696697

697698
propPruningGeneratedScriptIsNoop :: DynLogicModel s => DynLogic s -> Property
698699
propPruningGeneratedScriptIsNoop d =
699-
forAll (sized $ \n -> choose (1, max 1 n) >>= generateDLTest d) $ \test ->
700+
QC.forAll (QC.sized $ \n -> QC.choose (1, max 1 n) >>= generateDLTest d) $ \test ->
700701
let script = case test of
701702
BadPrecondition s _ _ -> s
702703
Looping s -> s
@@ -764,9 +765,9 @@ stuck (ForAll _ _) _ = False
764765
stuck (Monitor _ d) s = stuck d s
765766

766767
validDLTest :: StateModel s => DynLogic s -> DynLogicTest s -> Property -> Property
767-
validDLTest _ Stuck{} _ = False ==> False
768-
validDLTest _ test@DLScript{} p = counterexample (show test) p
769-
validDLTest _ test _ = counterexample (show test) False
768+
validDLTest _ Stuck{} _ = False QC.==> False
769+
validDLTest _ test@DLScript{} p = QC.counterexample (show test) p
770+
validDLTest _ test _ = QC.counterexample (show test) False
770771

771772
scriptFromDL :: DynLogicTest s -> Actions s
772773
scriptFromDL (DLScript s) = Actions $ sequenceSteps s

quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,8 @@ import Data.Monoid (Endo (..))
5252
import Data.Set qualified as Set
5353
import Data.Void
5454
import GHC.Generics
55-
import Test.QuickCheck as QC
55+
import Test.QuickCheck (Arbitrary, Gen, Property, Smart (..), Testable, counterexample, forAllShrink, frequency, property, resize, shrinkList, sized, tabulate)
56+
import Test.QuickCheck qualified as QC
5657
import Test.QuickCheck.DynamicLogic.SmartShrinking
5758
import Test.QuickCheck.Monadic
5859
import Test.QuickCheck.StateModel.Variables

quickcheck-dynamic/src/Test/QuickCheck/StateModel/Variables.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ import Data.Set qualified as Set
3131
import GHC.Generics
3232
import GHC.TypeLits
3333
import GHC.Word
34-
import Test.QuickCheck as QC
34+
import Test.QuickCheck (Gen, Smart (..), elements)
3535

3636
-- | A symbolic variable for a value of type `a`
3737
newtype Var a = Var Int

quickcheck-dynamic/test/Spec/DynamicLogic/Counters.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ module Spec.DynamicLogic.Counters where
66

77
import Control.Monad.Reader
88
import Data.IORef
9-
import Test.QuickCheck
9+
import Test.QuickCheck (frequency)
1010
import Test.QuickCheck.StateModel
1111

1212
-- A very simple model with a single action that always succeed in

quickcheck-dynamic/test/Spec/DynamicLogic/RegistryModel.hs

Lines changed: 11 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,8 @@ import Data.Either
1010
import Data.List
1111
import Data.Map (Map)
1212
import Data.Map qualified as Map
13-
import Test.QuickCheck
13+
import Test.QuickCheck (Gen, Property)
14+
import Test.QuickCheck qualified as QC
1415
import Test.QuickCheck.Monadic hiding (assert)
1516
import Test.QuickCheck.Monadic qualified as QC
1617
import Test.Tasty hiding (after)
@@ -57,7 +58,7 @@ instance StateModel RegState where
5758
validFailingAction _ _ = True
5859

5960
arbitraryAction ctx s =
60-
frequency $
61+
QC.frequency $
6162
[
6263
( max 1 $ 10 - length (ctxAtType @ThreadId ctx)
6364
, return $ Some Spawn
@@ -134,15 +135,15 @@ instance RunModel RegState RegM where
134135

135136
postconditionOnFailure (s, _) act@Register{} _ res = do
136137
monitorPost $
137-
tabulate
138+
QC.tabulate
138139
"Reason for -Register"
139140
[why s act]
140141
pure $ isLeft res
141142
postconditionOnFailure _s _ _ _ = pure True
142143

143144
monitoring (_s, s') act@(showDictAction -> ShowDict) _ res =
144-
counterexample (show res ++ " <- " ++ show act ++ "\n -- State: " ++ show s')
145-
. tabulate "Registry size" [show $ Map.size (regs s')]
145+
QC.counterexample (show res ++ " <- " ++ show act ++ "\n -- State: " ++ show s')
146+
. QC.tabulate "Registry size" [show $ Map.size (regs s')]
146147

147148
data ShowDict a where
148149
ShowDict :: Show (Realized RegM a) => ShowDict a
@@ -166,13 +167,13 @@ why s (Register name tid) =
166167
why _ _ = "(impossible)"
167168

168169
arbitraryName :: Gen String
169-
arbitraryName = elements allNames
170+
arbitraryName = QC.elements allNames
170171

171172
probablyRegistered :: RegState -> Gen String
172-
probablyRegistered s = oneof $ map pure (Map.keys $ regs s) ++ [arbitraryName]
173+
probablyRegistered s = QC.oneof $ map pure (Map.keys $ regs s) ++ [arbitraryName]
173174

174175
probablyUnregistered :: RegState -> Gen String
175-
probablyUnregistered s = elements $ allNames ++ (allNames \\ Map.keys (regs s))
176+
probablyUnregistered s = QC.elements $ allNames ++ (allNames \\ Map.keys (regs s))
176177

177178
shrinkName :: String -> [String]
178179
shrinkName name = [n | n <- allNames, n < name]
@@ -183,7 +184,7 @@ allNames = ["a", "b", "c", "d", "e"]
183184
prop_Registry :: Actions RegState -> Property
184185
prop_Registry s =
185186
monadicIO $ do
186-
monitor $ counterexample "\nExecution\n"
187+
monitor $ QC.counterexample "\nExecution\n"
187188
reg <- lift setupRegistry
188189
runPropertyReaderT (runActions s) reg
189190
QC.assert True
@@ -268,5 +269,5 @@ tests =
268269
"registry model example"
269270
[ testProperty "prop_Registry" $ prop_Registry
270271
, testProperty "canRegister" $ propDL canRegister
271-
, testProperty "canRegisterNoUnregister" $ expectFailure $ propDL canRegisterNoUnregister
272+
, testProperty "canRegisterNoUnregister" $ QC.expectFailure $ propDL canRegisterNoUnregister
272273
]

0 commit comments

Comments
 (0)