Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
29 changes: 15 additions & 14 deletions quickcheck-dynamic/src/Test/QuickCheck/DynamicLogic/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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.
--
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 _) = []
Expand Down Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion quickcheck-dynamic/test/Spec/DynamicLogic/Counters.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
21 changes: 11 additions & 10 deletions quickcheck-dynamic/test/Spec/DynamicLogic/RegistryModel.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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]
Expand All @@ -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
Expand Down Expand Up @@ -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
]
Loading