quickcheck-lockstep 0.5.1 → 0.6.0
raw patch · 10 files changed
+98/−45 lines, 10 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +21/−0
- README.md +6/−1
- quickcheck-lockstep.cabal +1/−1
- src/Test/QuickCheck/StateModel/Lockstep.hs +4/−0
- src/Test/QuickCheck/StateModel/Lockstep/API.hs +36/−6
- src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs +5/−11
- src/Test/QuickCheck/StateModel/Lockstep/Run.hs +1/−2
- test/Test/IORef/Full.hs +5/−5
- test/Test/IORef/Simple.hs +3/−3
- test/Test/MockFS.hs +16/−16
CHANGELOG.md view
@@ -1,5 +1,26 @@ # Revision history for quickcheck-lockstep +## 0.6.0 -- 2024-12-03++* BREAKING: Generalise `ModelFindVariables` and `ModelLookup` to+ `ModelVarContext`. Occurrences of `ModelFindVariables` and `ModelLookup` in+ the `InLockstep` class are replaced by the newly exposed `ModelVarContext`. A+ `ModelFindVariables` can be recovered from a `ModelVarContext` using the new+ `findVars` functions. A `ModelLookup` can be recovered from a+ `ModelVarContext` using the new `lookupVars` function. Since these functions+ can be recovered from `ModelVarContext`, existing tests are guaranteed to be+ adaptable to the new `InLockstep` API. This breaking changes means that, for+ example ...+ ```haskell+ arbitraryWithVars lookupVars = ...+ (lookupVars ...)+ ```+ ... should be changed to ...+ ```haskell+ arbitraryWithVars vctx = ...+ (lookupVars vctx ...)+ ```+ ## 0.5.1 -- 2024-08-27 * PATCH: allow building with `ghc-9.10`
README.md view
@@ -1,4 +1,9 @@-# Library for lockstep-style testing with `quickcheck-dynamic`+# quickcheck-lockstep++[](https://hackage.haskell.org/package/quickcheck-lockstep)+[](https://github.com/well-typed/quickcheck-lockstep/actions/workflows/haskell.yml)++`quickcheck-lockstep` is a library for lockstep-style testing with `quickcheck-dynamic` See https://well-typed.com/blog/2022/09/lockstep-with-quickcheck-dynamic/ for a tutorial.
quickcheck-lockstep.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: quickcheck-lockstep-version: 0.5.1+version: 0.6.0 license: BSD-3-Clause license-file: LICENSE author: Edsko de Vries
src/Test/QuickCheck/StateModel/Lockstep.hs view
@@ -21,6 +21,10 @@ , ModelFindVariables , ModelLookUp , ModelVar+ -- * Variable context+ , ModelVarContext+ , lookupVar+ , findVars -- * Variables , GVar -- opaque , AnyGVar(..)
src/Test/QuickCheck/StateModel/Lockstep/API.hs view
@@ -1,3 +1,5 @@+{- HLINT ignore "Eta reduce" -}+ -- | Public API -- -- This is re-exported through "Test.QuickCheck.StateModel.Lockstep".@@ -13,6 +15,10 @@ , ModelFindVariables , ModelLookUp , ModelVar+ -- * Variable context+ , ModelVarContext+ , findVars+ , lookupVar ) where import Data.Constraint (Dict(..))@@ -23,9 +29,11 @@ import Test.QuickCheck.StateModel (StateModel, Any, RunModel, Realized, Action) import Test.QuickCheck.StateModel.Lockstep.EnvF (EnvF)-import Test.QuickCheck.StateModel.Lockstep.GVar (GVar, AnyGVar(..))+import Test.QuickCheck.StateModel.Lockstep.GVar (GVar, AnyGVar(..), fromVar) import Test.QuickCheck.StateModel.Lockstep.Op import Test.QuickCheck.StateModel.Lockstep.Op.Identity qualified as Identity+import Test.QuickCheck.StateModel.Lockstep.EnvF qualified as EnvF+import Test.QuickCheck.StateModel.Lockstep.GVar qualified as EnvF {------------------------------------------------------------------------------- Lockstep state@@ -114,22 +122,22 @@ -- The order of the arguments mimicks 'perform'. modelNextState :: LockstepAction state a- -> ModelLookUp state+ -> ModelVarContext state -> state -> (ModelValue state a, state) - -- | Generate an arbitrary action, given a way to find variables+ -- | Generate an arbitrary action, given a variable context arbitraryWithVars ::- ModelFindVariables state+ ModelVarContext state -> state -> Gen (Any (LockstepAction state)) - -- | Shrink an action, given a way to find variables+ -- | Shrink an action, given a variable context -- -- This is optional; without an implementation of 'shrinkWithVars', lists of -- actions will still be pruned, but /individual/ actions will not be shrunk. shrinkWithVars ::- ModelFindVariables state+ ModelVarContext state -> state -> LockstepAction state a -> [Any (LockstepAction state)]@@ -188,3 +196,25 @@ -- | Variables with a "functor-esque" instance type ModelVar state = GVar (ModelOp state) +{-------------------------------------------------------------------------------+ Variable context+-------------------------------------------------------------------------------}++-- | The environment of known variables and their (model) values.+--+-- This environment can be queried for information about known variables through+-- 'findVars' and 'lookupVar'. This environment is updated automically by the+-- lockstep framework.+type ModelVarContext state = EnvF (ModelValue state)++-- | See 'ModelFindVariables'.+findVars ::+ InLockstep state+ => ModelVarContext state -> ModelFindVariables state+findVars env _ = map fromVar $ EnvF.keysOfType env++-- | See 'ModelLookUp'.+lookupVar ::+ InLockstep state+ => ModelVarContext state -> ModelLookUp state+lookupVar env = EnvF.lookUpEnvF env
src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs view
@@ -30,7 +30,6 @@ import Test.QuickCheck.StateModel.Variables (VarContext, HasVariables (..)) import Test.QuickCheck.StateModel.Lockstep.API-import Test.QuickCheck.StateModel.Lockstep.EnvF (EnvF) import Test.QuickCheck.StateModel.Lockstep.EnvF qualified as EnvF import Test.QuickCheck.StateModel.Lockstep.GVar @@ -57,7 +56,7 @@ where modelResp :: ModelValue state a state' :: state- (modelResp, state') = modelNextState action (lookUpEnvF env) state+ (modelResp, state') = modelNextState action env state -- | Default implementation for 'Test.QuickCheck.StateModel.precondition' --@@ -74,7 +73,7 @@ InLockstep state => VarContext -> Lockstep state -> Gen (Any (LockstepAction state)) arbitraryAction _ (Lockstep state env) =- arbitraryWithVars (varsOfType env) state+ arbitraryWithVars env state -- | Default implementation for 'Test.QuickCheck.StateModel.shrinkAction' shrinkAction ::@@ -83,7 +82,7 @@ -> Lockstep state -> LockstepAction state a -> [Any (LockstepAction state)] shrinkAction _ (Lockstep state env) =- shrinkWithVars (varsOfType env) state+ shrinkWithVars env state {------------------------------------------------------------------------------- Default implementations for methods of 'RunModel'@@ -123,7 +122,7 @@ modelResp :: ModelValue state a modelResp = fst $ modelNextState action- (lookUpEnvF $ lockstepEnv before)+ (lockstepEnv before) (lockstepModel before) {-------------------------------------------------------------------------------@@ -149,11 +148,6 @@ Internal auxiliary -------------------------------------------------------------------------------} -varsOfType ::- InLockstep state- => EnvF (ModelValue state) -> ModelFindVariables state-varsOfType env _ = map fromVar $ EnvF.keysOfType env- -- | Check the response of the system under test against the model -- -- This is used in 'postcondition', where we can however only return a 'Bool',@@ -168,7 +162,7 @@ (modelResp , observeModel modelResp) where modelResp :: ModelValue state a- modelResp = fst $ modelNextState action (lookUpEnvF env) state+ modelResp = fst $ modelNextState action env state compareEquality :: (Realized m a, Observable state a)
src/Test/QuickCheck/StateModel/Lockstep/Run.hs view
@@ -30,7 +30,6 @@ import Test.QuickCheck.StateModel.Lockstep.API import Test.QuickCheck.StateModel.Lockstep.EnvF qualified as EnvF-import Test.QuickCheck.StateModel.Lockstep.GVar {------------------------------------------------------------------------------- Finding labelled examples@@ -83,7 +82,7 @@ modelResp :: ModelValue state a after :: state- (modelResp, after) = modelNextState action (lookUpEnvF env) before+ (modelResp, after) = modelNextState action env before tags' :: [String] tags' = tagStep (before, after) action modelResp
test/Test/IORef/Full.hs view
@@ -124,11 +124,11 @@ usedVars (Write v (Right v')) = [SomeGVar v, SomeGVar v'] usedVars (Read v) = [SomeGVar v] - modelNextState = runModel+ modelNextState action ctx = runModel action (lookupVar ctx) - arbitraryWithVars findVars _mock = oneof $ concat [+ arbitraryWithVars ctx _mock = oneof $ concat [ withoutVars- , case findVars (Proxy @(IORef Int)) of+ , case findVars ctx (Proxy @(IORef Int)) of [] -> [] vars -> withVars (elements vars) ]@@ -144,11 +144,11 @@ , fmap Some $ Read <$> genVar ] - shrinkWithVars findVars _mock = \case+ shrinkWithVars ctx _mock = \case New -> [] Write v (Left x) -> concat [ Some . Write v . Left <$> shrink x- , Some . Write v . Right <$> findVars (Proxy @Int)+ , Some . Write v . Right <$> findVars ctx (Proxy @Int) ] Write _ (Right _) -> [] Read _ -> []
test/Test/IORef/Simple.hs view
@@ -101,11 +101,11 @@ usedVars (Write v _) = [SomeGVar v] usedVars (Read v) = [SomeGVar v] - modelNextState = runModel+ modelNextState action ctx = runModel action (lookupVar ctx) - arbitraryWithVars findVars _mock = oneof $ concat [+ arbitraryWithVars ctx _mock = oneof $ concat [ withoutVars- , case findVars (Proxy @(IORef Int)) of+ , case findVars ctx (Proxy @(IORef Int)) of [] -> [] vars -> withVars (elements vars) ]
test/Test/MockFS.hs view
@@ -150,10 +150,10 @@ modelNextState :: forall a. LockstepAction FsState a- -> ModelLookUp FsState+ -> ModelVarContext FsState -> FsState -> (FsVal a, FsState)- modelNextState action lookUp (FsState mock stats) =- auxStats $ runMock lookUp action mock+ modelNextState action ctx (FsState mock stats) =+ auxStats $ runMock ctx action mock where auxStats :: (FsVal a, Mock) -> (FsVal a, FsState) auxStats (result, state') =@@ -178,8 +178,8 @@ -- Generation, shrinking and labelling -- - arbitraryWithVars findVars _mock = arbitraryFsAction findVars- shrinkWithVars findVars _mock = shrinkFsAction findVars+ arbitraryWithVars env _mock = arbitraryFsAction env+ shrinkWithVars env _mock = shrinkFsAction env tagStep (_, FsState _ after) act = map show . tagFsAction after act @@ -208,15 +208,15 @@ -------------------------------------------------------------------------------} runMock ::- ModelLookUp FsState+ ModelVarContext FsState -> Action (Lockstep FsState) a -> Mock -> (FsVal a, Mock)-runMock lookUp = \case+runMock ctx = \case MkDir d -> wrap MUnit . Mock.mMkDir d Open f -> wrap (mOpen f) . Mock.mOpen f- Write h s -> wrap MUnit . Mock.mWrite (getHandle $ lookUp h) s- Close h -> wrap MUnit . Mock.mClose (getHandle $ lookUp h)- Read f -> wrap MString . Mock.mRead (either (getFile . lookUp) id f)+ Write h s -> wrap MUnit . Mock.mWrite (getHandle $ lookupVar ctx h) s+ Close h -> wrap MUnit . Mock.mClose (getHandle $ lookupVar ctx h)+ Read f -> wrap MString . Mock.mRead (either (getFile . lookupVar ctx) id f) where wrap :: (a -> FsVal b) -> (Either Err a, Mock) -> (FsVal (Either Err b), Mock) wrap f = first (MEither . bimap MErr f)@@ -235,11 +235,11 @@ -------------------------------------------------------------------------------} arbitraryFsAction ::- ModelFindVariables FsState+ ModelVarContext FsState -> Gen (Any (LockstepAction FsState))-arbitraryFsAction findVars = QC.oneof $ concat [+arbitraryFsAction ctx = QC.oneof $ concat [ withoutVars- , case findVars (Proxy @((Either Err (IO.Handle, File)))) of+ , case findVars ctx (Proxy @((Either Err (IO.Handle, File)))) of [] -> [] vars -> withVars (QC.elements vars) ]@@ -274,16 +274,16 @@ genString = QC.sized $ \n -> replicateM n (QC.elements "ABC") shrinkFsAction ::- ModelFindVariables FsState+ ModelVarContext FsState -> Action (Lockstep FsState) a -> [Any (LockstepAction FsState)]-shrinkFsAction findVars = \case+shrinkFsAction ctx = \case Open (File (Dir []) ('t' : n)) -> [openTemp n' | n' <- QC.shrink (read n)] Open _ -> [openTemp 100] Read (Right _) -> [ Some $ Read (Left $ mapGVar (\op -> OpSnd `OpComp` OpRight `OpComp` op) v)- | v <- findVars (Proxy @((Either Err (IO.Handle, File))))+ | v <- findVars ctx (Proxy @((Either Err (IO.Handle, File)))) ] _otherwise -> []