quickcheck-lockstep 0.7.0 → 0.8.0
raw patch · 17 files changed
+371/−313 lines, 17 filesdep ~QuickCheckdep ~quickcheck-dynamic
Dependency ranges changed: QuickCheck, quickcheck-dynamic
Files
- CHANGELOG.md +53/−0
- quickcheck-lockstep.cabal +95/−32
- src/Test/QuickCheck/StateModel/Lockstep.hs +4/−4
- src/Test/QuickCheck/StateModel/Lockstep/API.hs +22/−31
- src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs +21/−20
- src/Test/QuickCheck/StateModel/Lockstep/EnvF.hs +6/−6
- src/Test/QuickCheck/StateModel/Lockstep/GVar.hs +19/−16
- src/Test/QuickCheck/StateModel/Lockstep/Op.hs +7/−46
- src/Test/QuickCheck/StateModel/Lockstep/Op/Identity.hs +3/−3
- src/Test/QuickCheck/StateModel/Lockstep/Op/SumProd.hs +6/−15
- src/Test/QuickCheck/StateModel/Lockstep/Run.hs +17/−16
- test-internals/Test/Test/QuickCheck/StateModel/Lockstep/GVar.hs +4/−11
- test/Test/Golden.hs +3/−5
- test/Test/IORef/Full.hs +29/−28
- test/Test/IORef/Simple.hs +24/−23
- test/Test/MockFS.hs +44/−43
- test/Test/MockFS/Mock.hs +14/−14
CHANGELOG.md view
@@ -1,5 +1,58 @@ # Revision history for quickcheck-lockstep +## 0.8.0 -- 2025-07-03++* BREAKING: Support `quickcheck-dynamic-4`. Going from version 3 to 4, some+ breaking changes were introduced in `quickcheck-dynamic`, which cascades into+ changes for `quickcheck-lockstep`. The changes to the latter are listed below+ together with hints as to how to migrate from `quickcheck-lockstep-0.7` to+ `quickcheck-lockstep-0.8`. For migrating from `quickcheck-dynamic-3` to+ `quickcheck-dynamic-4`, see [the `quickcheck-dynamic-4`+ changelog](https://hackage.haskell.org/package/quickcheck-dynamic-4.0.0/changelog).++ - The `Realized` type family is removed.++ + Types of the form `Realized m a` are replaced by `a` everywhere.++ Users should make this change in their own code as well.++ + Types of the form `LookUp m` are replaced by `LookUp` everywhere.++ Users should make this change in their own code as well.++ + The `RealLookUp` type synonym no longer has an `m` type argument, and the+ `Proxy m` type is removed from the right-hand side of the definition.+ Types of the form `RealLookup m op` are replaced by `RealLookup op`+ everywhere.++ Users should make this change in their own code as well. (Any values of)+ the type `Proxy m` that were previously passed to functions of the+ `RealLookup` type can be removed.++ + `WrapRealized m` is replaced by `Identity`. The `WrapRealized m` type and+ its helper functions (`intOpRealizedId`, `intOpTransformer`) are removed+ completely. A new helper function called `intOpIdentity` is added. For the+ `Op` from the `SumProd` module, the instances `InterpretOp Op+ (WrapRealized IO)`, `InterpretOp Op (WrapRealized (StateT s m))`, and+ `InterpretOp Op (WrapRealized (ReaderT r m))` are removed and replaced by+ an `InterpretOp Op Identity` instance.++ Instead of providing an `InterpretOp op (WrapRealized m)` instance, users+ should now provide an `InterpretOp op Identity` instance if `op` is a+ custom type that is not included in `quickcheck-lockstep` (like+ `SumProd.Op`, which comes an instance already defined). Use+ `intOpIdentity` to help define this instance for custom `op` types.++ - The `Error` type family is moved from `StateModel` to `RunModel`, and now+ requires an additional `m` type paramer. For `quickcheck-lockstep`, types of+ the form `Error st` are replaced by `Error st m` everywhere.++ The user should make this change in their own code as well.++* PATCH: enable a bunch of GHC warnings+* PATCH: use GHC2021, and if not available, enable all GHC2021 language+ extensions explicitly.+ ## 0.7.0 -- 2025-05-09 * BREAKING: Rename `lookupGVar` to `realLookupVar`, and add a `RealLookup`
quickcheck-lockstep.cabal view
@@ -1,6 +1,6 @@-cabal-version: 2.4+cabal-version: 3.4 name: quickcheck-lockstep-version: 0.7.0+version: 0.8.0 license: BSD-3-Clause license-file: LICENSE author: Edsko de Vries@@ -34,29 +34,96 @@ type: git location: https://github.com/well-typed/quickcheck-lockstep -common lang+source-repository head+ type: git+ location: https://github.com/well-typed/quickcheck-lockstep+ tag: quickcheck-lockstep-0.8.0++common language+ -- This is at the top-level so that `cabal check` does not complain. default-language: Haskell2010++ -- For newer GHC's, override Haskell2010 with GHC2021+ if impl(ghc >=9.2.1)+ default-language: GHC2021++ -- For older GHC's, manually enable all language extensions that are in+ -- GHC2021+ --+ -- NOTE: FieldSelectors is not supported on ghc-8.10.7, so it is the only+ -- language extension that is missing compared to GHC2021+ else+ default-extensions:+ BangPatterns+ BinaryLiterals+ ConstrainedClassMethods+ ConstraintKinds+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveLift+ DeriveTraversable+ DoAndIfThenElse+ EmptyCase+ EmptyDataDecls+ EmptyDataDeriving+ ExistentialQuantification+ ExplicitForAll+ FlexibleContexts+ FlexibleInstances+ ForeignFunctionInterface+ GADTSyntax+ GeneralisedNewtypeDeriving+ HexFloatLiterals+ ImplicitPrelude+ ImportQualifiedPost+ InstanceSigs+ KindSignatures+ MonomorphismRestriction+ MultiParamTypeClasses+ NamedFieldPuns+ NamedWildCards+ NoExplicitNamespaces+ NumericUnderscores+ PatternGuards+ PolyKinds+ PostfixOperators+ RankNTypes+ RelaxedPolyRec+ ScopedTypeVariables+ StandaloneDeriving+ StandaloneKindSignatures+ StarIsType+ TraditionalRecordSyntax+ TupleSections+ TypeApplications+ TypeOperators+ TypeSynonymInstances++ -- Extensions that we enable by default default-extensions:- FlexibleContexts- FlexibleInstances+ DeriveAnyClass+ DerivingStrategies+ DerivingVia+ ExplicitNamespaces GADTs- ImportQualifiedPost LambdaCase- MultiParamTypeClasses- QuantifiedConstraints- RankNTypes- ScopedTypeVariables- StandaloneDeriving- TupleSections- TypeApplications- TypeFamilies+ RecordWildCards+ RoleAnnotations+ ViewPatterns - other-extensions: UndecidableInstances+common warnings ghc-options:- -Wall -Wprepositive-qualified-module -Wredundant-constraints+ -Wall -Wcompat -Wincomplete-uni-patterns+ -Wincomplete-record-updates -Wpartial-fields -Widentities+ -Wredundant-constraints -Wmissing-export-lists+ -Wno-unticked-promoted-constructors -Wunused-packages + ghc-options: -Werror=missing-deriving-strategies+ library- import: lang+ import: language, warnings exposed-modules: Test.QuickCheck.StateModel.Lockstep Test.QuickCheck.StateModel.Lockstep.Defaults@@ -72,17 +139,17 @@ -- quickcheck-dynamic requires ghc 8.10 minimum build-depends:- , base >=4.14 && <4.22- , constraints ^>=0.13 || ^>=0.14- , containers ^>=0.6 || ^>=0.7 || ^>=0.8- , mtl ^>=2.2 || ^>=2.3- , QuickCheck ^>=2.14 || ^>=2.15- , quickcheck-dynamic ^>=3.4.1+ , base >=4.14 && <4.22+ , constraints ^>=0.13 || ^>=0.14+ , containers ^>=0.6 || ^>=0.7 || ^>=0.8+ , mtl ^>=2.2 || ^>=2.3+ , QuickCheck ^>=2.14 || ^>=2.15+ , quickcheck-dynamic ^>=4.0 hs-source-dirs: src test-suite test-quickcheck-lockstep- import: lang+ import: language, warnings type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs@@ -99,7 +166,7 @@ -- Version bounds determined by main lib build-depends:- , base < 5+ , base <5 , constraints , containers , directory@@ -115,7 +182,7 @@ , temporary test-suite test-internals- import: lang+ import: language, warnings type: exitcode-stdio-1.0 hs-source-dirs: test-internals src main-is: Main.hs@@ -126,14 +193,10 @@ Test.QuickCheck.StateModel.Lockstep.Op.SumProd Test.Test.QuickCheck.StateModel.Lockstep.GVar - ghc-options:- -Wno-prepositive-qualified-module- -- Version bounds determined by main lib build-depends:- , base < 5+ , base <5+ , mtl , quickcheck-dynamic , tasty- , mtl , tasty-quickcheck- , QuickCheck
src/Test/QuickCheck/StateModel/Lockstep.hs view
@@ -39,8 +39,8 @@ , InterpretOp(..) ) where -import Prelude hiding (init)+import Prelude hiding (init) -import Test.QuickCheck.StateModel.Lockstep.API-import Test.QuickCheck.StateModel.Lockstep.Op-import Test.QuickCheck.StateModel.Lockstep.GVar+import Test.QuickCheck.StateModel.Lockstep.API+import Test.QuickCheck.StateModel.Lockstep.GVar+import Test.QuickCheck.StateModel.Lockstep.Op
src/Test/QuickCheck/StateModel/Lockstep/API.hs view
@@ -1,4 +1,5 @@-{- HLINT ignore "Eta reduce" -}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE TypeFamilies #-} -- | Public API --@@ -25,39 +26,29 @@ , realLookupVar ) where -import Data.Constraint (Dict(..))-import Data.Kind-import Data.Typeable+import Control.Monad.Identity (Identity) -import Test.QuickCheck (Gen)-import Test.QuickCheck.StateModel (StateModel, Any, RunModel, Realized, Action, LookUp)+import Data.Constraint (Dict (..))+import Data.Kind+import Data.Typeable -import Test.QuickCheck.StateModel.Lockstep.EnvF (EnvF)-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+import Test.QuickCheck (Gen)+import Test.QuickCheck.StateModel (Action, Any, LookUp, RunModel,+ StateModel) +import qualified Test.QuickCheck.StateModel.Lockstep.EnvF as EnvF+import Test.QuickCheck.StateModel.Lockstep.EnvF (EnvF)+import qualified Test.QuickCheck.StateModel.Lockstep.GVar as EnvF+import Test.QuickCheck.StateModel.Lockstep.GVar (AnyGVar (..), GVar,+ fromVar)+import Test.QuickCheck.StateModel.Lockstep.Op+import qualified Test.QuickCheck.StateModel.Lockstep.Op.Identity as Identity+ {------------------------------------------------------------------------------- Lockstep state @quickcheck-dynamic@ takes care of keeping track of the responses of the system under test, but not the model. We do that here.-- Implementation note: the 'RunModel' class in @quickcheck-dynamic@ uses a type- family 'Realized': for an @Action state a@, the response from the real system- is expected to be of type @Realized m a@. This allows the same tests to be run- against different "test execution backends"; for example, we could run the- tests in the real IO monad, or using an IO monad simulator.-- This is an orthogonal generalization to what Lockstep provides: no matter the- test execution backend, the /model/ will always be the same. We could perhaps- piggy-back on the same abstraction if we introduced a separate monad parameter- @n@ for the model, and then use @Realized n a@ instead of @ModelValue a@. This- might work, but it's less clear how to then also that for 'Observable'.- Overall, it seems cleaner to reserve 'Realized' exclusively for the- parameterization over test execution backends. -------------------------------------------------------------------------------} data Lockstep state = Lockstep {@@ -164,7 +155,7 @@ -- See also 'Observable' observeReal :: Proxy m- -> LockstepAction state a -> Realized m a -> Observable state a+ -> LockstepAction state a -> a -> Observable state a -- | Show responses from the real system --@@ -173,7 +164,7 @@ showRealResponse :: Proxy m -> LockstepAction state a- -> Maybe (Dict (Show (Realized m a)))+ -> Maybe (Dict (Show a)) showRealResponse _ _ = Nothing {-------------------------------------------------------------------------------@@ -195,7 +186,7 @@ type ModelShrinkVar state = forall a. ModelVar state a -> [ModelVar state a] -- | See 'realLookupVar'.-type RealLookUp m op = forall a. Proxy m -> LookUp m -> GVar op a -> Realized m a+type RealLookUp op = forall a. LookUp -> GVar op a -> a -- | Variables with a "functor-esque" instance type ModelVar state = GVar (ModelOp state)@@ -242,8 +233,8 @@ -- | Look up a variable for execution of the real system. -- -- The type of the variable is the type in the /real/ system.-realLookupVar :: InterpretOp op (WrapRealized m) => RealLookUp m op-realLookupVar p lookUp gvar = case EnvF.lookUpGVar p lookUp gvar of+realLookupVar :: InterpretOp op Identity => RealLookUp op+realLookupVar lookUp gvar = case EnvF.lookUpGVar lookUp gvar of Just x -> x Nothing -> error "realLookupVar: the variable (GVar) must be well-defined and evaluable, \
src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs view
@@ -18,21 +18,22 @@ , monitoring ) where -import Prelude hiding (init)+import Prelude hiding (init) -import Data.Constraint (Dict(..))-import Data.Set qualified as Set-import Data.Typeable+import Data.Constraint (Dict (..))+import qualified Data.Set as Set+import Data.Typeable -import Test.QuickCheck (Gen, Property)-import Test.QuickCheck qualified as QC-import Test.QuickCheck.StateModel ( Var, Any(..), LookUp, Realized, PostconditionM- , Action, monitorPost, StateModel (Error))-import Test.QuickCheck.StateModel.Variables (VarContext, HasVariables (..))+import qualified Test.QuickCheck as QC+import Test.QuickCheck (Gen, Property)+import Test.QuickCheck.StateModel (Action, Any (..), LookUp,+ PostconditionM, RunModel (Error), Var, monitorPost)+import Test.QuickCheck.StateModel.Variables (HasVariables (..),+ VarContext) -import Test.QuickCheck.StateModel.Lockstep.API-import Test.QuickCheck.StateModel.Lockstep.EnvF qualified as EnvF-import Test.QuickCheck.StateModel.Lockstep.GVar+import Test.QuickCheck.StateModel.Lockstep.API+import qualified Test.QuickCheck.StateModel.Lockstep.EnvF as EnvF+import Test.QuickCheck.StateModel.Lockstep.GVar {------------------------------------------------------------------------------- Default implementations for members of 'StateModel'@@ -97,8 +98,8 @@ RunLockstep state m => (Lockstep state, Lockstep state) -> LockstepAction state a- -> LookUp m- -> Realized m a+ -> LookUp+ -> a -> PostconditionM m Bool postcondition = postconditionWith True @@ -112,8 +113,8 @@ => Bool -- ^ Verbose output -> (Lockstep state, Lockstep state) -> LockstepAction state a- -> LookUp m- -> Realized m a+ -> LookUp+ -> a -> PostconditionM m Bool postconditionWith verbose (before, _after) action _lookUp a = case checkResponse (Proxy @m) before action a of@@ -127,8 +128,8 @@ => Proxy m -> (Lockstep state, Lockstep state) -> LockstepAction state a- -> LookUp m- -> Either (Error (Lockstep state)) (Realized m a)+ -> LookUp+ -> Either (Error (Lockstep state) m) a -> Property -> Property monitoring _p (before, after) action _lookUp _realResp = QC.counterexample ("State: " ++ show after)@@ -173,7 +174,7 @@ checkResponse :: forall m state a. RunLockstep state m => Proxy m- -> Lockstep state -> LockstepAction state a -> Realized m a -> Either String String+ -> Lockstep state -> LockstepAction state a -> a -> Either String String checkResponse p (Lockstep state env) action a = compareEquality (a , observeReal p action a)@@ -183,7 +184,7 @@ modelResp = fst $ modelNextState action env state compareEquality ::- (Realized m a, Observable state a)+ (a, Observable state a) -> (ModelValue state a, Observable state a) -> Either String String compareEquality (realResp, obsRealResp) (mockResp, obsMockResp) | obsRealResp == obsMockResp = Right $ concat [
src/Test/QuickCheck/StateModel/Lockstep/EnvF.hs view
@@ -20,14 +20,14 @@ , EnvEntry (..) ) where -import Prelude hiding (lookup)+import Prelude hiding (lookup) -import Control.Monad-import Data.Foldable (asum)-import Data.Maybe (mapMaybe)-import Data.Typeable+import Control.Monad+import Data.Foldable (asum)+import Data.Maybe (mapMaybe)+import Data.Typeable -import Test.QuickCheck.StateModel.Variables (Var, unsafeCoerceVar)+import Test.QuickCheck.StateModel.Variables (Var, unsafeCoerceVar) {------------------------------------------------------------------------------- Types
src/Test/QuickCheck/StateModel/Lockstep/GVar.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE UndecidableInstances #-} -- | Generalized variables --@@ -21,19 +22,21 @@ , pattern GVar ) where -import Prelude hiding (map)+import Prelude hiding (map) -import Data.Maybe (isJust)-import Data.Typeable+import Control.Monad.Identity (Identity (..)) -import GHC.Show+import Data.Maybe (isJust)+import Data.Typeable -import Test.QuickCheck.StateModel (Var, LookUp, Realized, HasVariables (..))+import GHC.Show -import Test.QuickCheck.StateModel.Lockstep.EnvF (EnvF)-import Test.QuickCheck.StateModel.Lockstep.EnvF qualified as EnvF-import Test.QuickCheck.StateModel.Lockstep.Op+import Test.QuickCheck.StateModel (HasVariables (..), LookUp, Var) +import qualified Test.QuickCheck.StateModel.Lockstep.EnvF as EnvF+import Test.QuickCheck.StateModel.Lockstep.EnvF (EnvF)+import Test.QuickCheck.StateModel.Lockstep.Op+ {------------------------------------------------------------------------------- Main type -------------------------------------------------------------------------------}@@ -91,18 +94,18 @@ Interop with 'Env' -------------------------------------------------------------------------------} -lookUpWrapped :: Typeable a => Proxy m -> LookUp m -> Var a -> WrapRealized m a-lookUpWrapped _ m v = WrapRealized (m v)+lookUpWrapped :: Typeable a => LookUp -> Var a -> Identity a+lookUpWrapped m v = Identity (m v) -- | Lookup 'GVar' given a lookup function for 'Var' -- -- The result is 'Just' if the variable is in the environment and evaluation -- succeeds. This is normally guaranteed by the default test 'precondition'. lookUpGVar ::- InterpretOp op (WrapRealized m)- => Proxy m -> LookUp m -> GVar op a -> Maybe (Realized m a)-lookUpGVar p lookUp (GVar var op) =- unwrapRealized <$> intOp op (lookUpWrapped p lookUp var)+ InterpretOp op Identity+ => LookUp -> GVar op a -> Maybe a+lookUpGVar lookUp (GVar var op) =+ runIdentity <$> intOp op (lookUpWrapped lookUp var) {------------------------------------------------------------------------------- Interop with EnvF
src/Test/QuickCheck/StateModel/Lockstep/Op.hs view
@@ -1,15 +1,11 @@-{-# LANGUAGE TypeOperators #-}- module Test.QuickCheck.StateModel.Lockstep.Op ( Operation(..) , InterpretOp(..)- , WrapRealized(..)- , intOpRealizedId- , intOpTransformer+ , intOpIdentity ) where -import Test.QuickCheck.StateModel (Realized)-import Data.Coerce+import Control.Monad.Identity (Identity (..))+import Data.Coerce {------------------------------------------------------------------------------- Operations@@ -27,42 +23,7 @@ class Operation op => InterpretOp op f where intOp :: op a b -> f a -> Maybe (f b) -{-------------------------------------------------------------------------------- Interop with 'Realized'-- We want to execute operations against 'Realized' values, but since that is a- type family, we need to wrap and unwrap in order to be able to give the- appropriate 'InterpretOp' instances.--------------------------------------------------------------------------------}--newtype WrapRealized m a = WrapRealized {- unwrapRealized :: Realized m a- }---- | Convenience function for defining 'InterpretOp' instances------ This can be used for monads like @IO@ where @Realized m a@ is just @a@.-intOpRealizedId ::- (Realized m a ~ a, Realized m b ~ b)- => (op a b -> a -> Maybe b)- -> op a b -> WrapRealized m a -> Maybe (WrapRealized m b)-intOpRealizedId = coerce---- | Convenience function for defining 'InterpretOp' instances for monad--- transformer stacks.-intOpTransformer ::- forall t m a b op.- ( Realized (t m) a ~ Realized m a- , Realized (t m) b ~ Realized m b- , InterpretOp op (WrapRealized m)- )- => op a b- -> WrapRealized (t m) a- -> Maybe (WrapRealized (t m) b)-intOpTransformer op wr = coerceOut <$> intOp op (coerceIn wr)- where- coerceIn :: WrapRealized (t m) a -> WrapRealized m a- coerceIn = coerce-- coerceOut :: WrapRealized m b -> WrapRealized (t m) b- coerceOut = coerce+intOpIdentity ::+ (op a b -> a -> Maybe b)+ -> op a b -> Identity a -> Maybe (Identity b)+intOpIdentity = coerce
src/Test/QuickCheck/StateModel/Lockstep/Op/Identity.hs view
@@ -1,6 +1,6 @@ module Test.QuickCheck.StateModel.Lockstep.Op.Identity (Op(..)) where -import Test.QuickCheck.StateModel.Lockstep.Op+import Test.QuickCheck.StateModel.Lockstep.Op -- | Very simple operation type that supports identity only --@@ -10,8 +10,8 @@ data Op a b where OpId :: Op a a -deriving instance Show (Op a b)-deriving instance Eq (Op a b)+deriving stock instance Show (Op a b)+deriving stock instance Eq (Op a b) instance Operation Op where opIdentity = OpId instance InterpretOp Op f where intOp OpId = Just
src/Test/QuickCheck/StateModel/Lockstep/Op/SumProd.hs view
@@ -1,11 +1,10 @@ module Test.QuickCheck.StateModel.Lockstep.Op.SumProd (Op(..), intOpId) where -import Control.Monad ((<=<))-import Control.Monad.Reader (ReaderT)-import Control.Monad.State (StateT)-import GHC.Show (appPrec)+import Control.Monad ((<=<))+import Control.Monad.Identity (Identity)+import GHC.Show (appPrec) -import Test.QuickCheck.StateModel.Lockstep.Op+import Test.QuickCheck.StateModel.Lockstep.Op {------------------------------------------------------------------------------- Example (but very useful) 'Operation' example@@ -44,16 +43,8 @@ instance Operation Op where opIdentity = OpId -instance InterpretOp Op (WrapRealized IO) where- intOp = intOpRealizedId intOpId--instance InterpretOp Op (WrapRealized m)- => InterpretOp Op (WrapRealized (StateT s m)) where- intOp = intOpTransformer--instance InterpretOp Op (WrapRealized m)- => InterpretOp Op (WrapRealized (ReaderT r m)) where- intOp = intOpTransformer+instance InterpretOp Op Identity where+ intOp = intOpIdentity intOpId {------------------------------------------------------------------------------- 'Show' and 'Eq' instances
src/Test/QuickCheck/StateModel/Lockstep/Run.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE TypeOperators #-} -- | Run lockstep tests --@@ -14,22 +15,22 @@ , runActionsBracket ) where -import Prelude hiding (init)+import Prelude hiding (init) -import Control.Exception-import Control.Monad (void)-import Data.Set (Set)-import Data.Set qualified as Set-import Data.Typeable-import Test.QuickCheck.Monadic+import Control.Exception+import Control.Monad (void)+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Typeable+import Test.QuickCheck.Monadic -import Test.QuickCheck (Property, Testable)-import Test.QuickCheck qualified as QC-import Test.QuickCheck.StateModel hiding (runActions)-import Test.QuickCheck.StateModel qualified as StateModel+import qualified Test.QuickCheck as QC+import Test.QuickCheck (Property, Testable)+import qualified Test.QuickCheck.StateModel as StateModel+import Test.QuickCheck.StateModel hiding (runActions) -import Test.QuickCheck.StateModel.Lockstep.API-import Test.QuickCheck.StateModel.Lockstep.EnvF qualified as EnvF+import Test.QuickCheck.StateModel.Lockstep.API+import qualified Test.QuickCheck.StateModel.Lockstep.EnvF as EnvF {------------------------------------------------------------------------------- Finding labelled examples@@ -93,7 +94,7 @@ runActions :: ( RunLockstep state IO- , e ~ Error (Lockstep state)+ , e ~ Error (Lockstep state) IO , forall a. IsPerformResult e a ) => Proxy state@@ -110,7 +111,7 @@ -- is a reasonable choice. runActionsBracket :: ( RunLockstep state m- , e ~ Error (Lockstep state)+ , e ~ Error (Lockstep state) m , forall a. IsPerformResult e a ) => Proxy state
test-internals/Test/Test/QuickCheck/StateModel/Lockstep/GVar.hs view
@@ -2,18 +2,14 @@ {-# OPTIONS_GHC -Wno-orphans #-} -module Test.Test.QuickCheck.StateModel.Lockstep.GVar where+module Test.Test.QuickCheck.StateModel.Lockstep.GVar (tests) where -import Data.Data (eqT,- (:~:) (Refl))+import Data.Data (eqT, (:~:) (Refl)) import Data.Functor.Identity-import Test.QuickCheck.StateModel.Lockstep.EnvF hiding- (shrinkVar)+import Test.QuickCheck.StateModel.Lockstep.EnvF hiding (shrinkVar) import Test.QuickCheck.StateModel.Lockstep.GVar-import Test.QuickCheck.StateModel.Lockstep.Op import Test.QuickCheck.StateModel.Lockstep.Op.SumProd-import Test.QuickCheck.StateModel.Variables hiding- (shrinkVar)+import Test.QuickCheck.StateModel.Variables hiding (shrinkVar) import Test.Tasty import Test.Tasty.QuickCheck @@ -49,9 +45,6 @@ {------------------------------------------------------------------------------- Well-defined and evaluable shrinks: generators, shrinkers, printers -------------------------------------------------------------------------------}--instance InterpretOp Op Identity where- intOp op = traverse (intOpId op) -- NOTE: both the environment and variables contain/are existential types, which -- can get a little bit complicated when writing generators, shrinkers and
test/Test/Golden.hs view
@@ -1,11 +1,9 @@-{- HLINT ignore "Use camelCase" -}--module Test.Golden where+module Test.Golden (Test.Golden.tests) where -import Control.Exception (bracket_)+import Control.Exception (bracket_) import System.Directory import System.FilePath-import Test.MockFS as MockFS+import Test.MockFS as MockFS import Test.QuickCheck import Test.QuickCheck.Random (mkQCGen) import Test.Tasty
test/Test/IORef/Full.hs view
@@ -1,28 +1,29 @@ {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} module Test.IORef.Full (tests) where -import Control.Monad.Reader-import Data.Bifunctor-import Data.Constraint (Dict(..))-import Data.IORef-import Data.Map (Map)-import Data.Map qualified as Map-import Data.Proxy-import Test.QuickCheck-import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck (testProperty)+import Control.Monad.Reader+import Data.Bifunctor+import Data.Constraint (Dict (..))+import Data.IORef+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Proxy+import Test.QuickCheck+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck qualified as QC+import qualified Test.QuickCheck as QC -import Test.QuickCheck.StateModel-import Test.QuickCheck.StateModel.Lockstep-import Test.QuickCheck.StateModel.Lockstep.Defaults qualified as Lockstep-import Test.QuickCheck.StateModel.Lockstep.Run qualified as Lockstep-import Test.QuickCheck.StateModel.Lockstep.Run (labelActions)+import Test.QuickCheck.StateModel+import Test.QuickCheck.StateModel.Lockstep+import qualified Test.QuickCheck.StateModel.Lockstep.Defaults as Lockstep+import qualified Test.QuickCheck.StateModel.Lockstep.Run as Lockstep+import Test.QuickCheck.StateModel.Lockstep.Run (labelActions) {------------------------------------------------------------------------------- Model "M"@@ -39,7 +40,7 @@ -- This is used for tagging. , mWrites :: Map (MRef, Int) Int }- deriving (Show)+ deriving stock (Show) initModel :: M initModel = M {@@ -174,20 +175,20 @@ Write{} -> Just Dict Read{} -> Just Dict -deriving instance Show (Action (Lockstep M) a)-deriving instance Show (Observable M a)-deriving instance Show (ModelValue M a)+deriving stock instance Show (Action (Lockstep M) a)+deriving stock instance Show (Observable M a)+deriving stock instance Show (ModelValue M a) -deriving instance Eq (Action (Lockstep M) a)-deriving instance Eq (Observable M a)-deriving instance Eq (ModelValue M a)+deriving stock instance Eq (Action (Lockstep M) a)+deriving stock instance Eq (Observable M a)+deriving stock instance Eq (ModelValue M a) {------------------------------------------------------------------------------- Interpreters against the real system and against the model -------------------------------------------------------------------------------} data Buggy = Buggy | NotBuggy- deriving (Show, Eq)+ deriving stock (Show, Eq) instance Arbitrary Buggy where arbitrary = elements [Buggy, NotBuggy]@@ -200,7 +201,7 @@ type RealMonad = ReaderT (Buggy, IORef BrokenRef) IO -runIO :: Action (Lockstep M) a -> LookUp RealMonad -> RealMonad a+runIO :: Action (Lockstep M) a -> LookUp -> RealMonad a runIO action lookUp = ReaderT $ \(buggy, brokenRef) -> case action of New -> newIORef 0@@ -208,11 +209,11 @@ Read v -> readIORef (lookUpRef v) where lookUpRef :: ModelVar M (IORef Int) -> IORef Int- lookUpRef = realLookupVar (Proxy @RealMonad) lookUp+ lookUpRef = realLookupVar lookUp lookUpInt :: Either Int (ModelVar M Int) -> Int lookUpInt (Left x) = x- lookUpInt (Right v) = realLookupVar (Proxy @RealMonad) lookUp v+ lookUpInt (Right v) = realLookupVar lookUp v -- | The second write to the same variable will be broken brokenWrite :: Buggy -> IORef BrokenRef -> IORef Int -> Int -> IO Int
test/Test/IORef/Simple.hs view
@@ -1,23 +1,24 @@ {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} module Test.IORef.Simple (tests) where -import Data.Bifunctor-import Data.Constraint (Dict(..))-import Data.IORef-import Data.Map (Map)-import Data.Map qualified as Map-import Data.Proxy-import Test.QuickCheck-import Test.Tasty-import Test.Tasty.QuickCheck (testProperty)+import Data.Bifunctor+import Data.Constraint (Dict (..))+import Data.IORef+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Proxy+import Test.QuickCheck+import Test.Tasty+import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck.StateModel-import Test.QuickCheck.StateModel.Lockstep-import Test.QuickCheck.StateModel.Lockstep.Defaults qualified as Lockstep-import Test.QuickCheck.StateModel.Lockstep.Run qualified as Lockstep+import Test.QuickCheck.StateModel+import Test.QuickCheck.StateModel.Lockstep+import qualified Test.QuickCheck.StateModel.Lockstep.Defaults as Lockstep+import qualified Test.QuickCheck.StateModel.Lockstep.Run as Lockstep {------------------------------------------------------------------------------- Model "M"@@ -25,11 +26,11 @@ type MRef = Int -data M = M {+newtype M = M { -- | Value of every var mValues :: Map MRef Int }- deriving (Show)+ deriving stock (Show) initModel :: M initModel = M { mValues = Map.empty }@@ -133,13 +134,13 @@ Write{} -> Just Dict Read{} -> Just Dict -deriving instance Show (Action (Lockstep M) a)-deriving instance Show (Observable M a)-deriving instance Show (ModelValue M a)+deriving stock instance Show (Action (Lockstep M) a)+deriving stock instance Show (Observable M a)+deriving stock instance Show (ModelValue M a) -deriving instance Eq (Action (Lockstep M) a)-deriving instance Eq (Observable M a)-deriving instance Eq (ModelValue M a)+deriving stock instance Eq (Action (Lockstep M) a)+deriving stock instance Eq (Observable M a)+deriving stock instance Eq (ModelValue M a) {------------------------------------------------------------------------------- Interpreters against the real system and against the model@@ -147,7 +148,7 @@ type RealMonad = IO -runIO :: Action (Lockstep M) a -> LookUp RealMonad -> RealMonad a+runIO :: Action (Lockstep M) a -> LookUp -> RealMonad a runIO action lookUp = case action of New -> newIORef 0@@ -155,7 +156,7 @@ Read v -> readIORef (lookUpRef v) where lookUpRef :: ModelVar M (IORef Int) -> IORef Int- lookUpRef = realLookupVar (Proxy @RealMonad) lookUp+ lookUpRef = realLookupVar lookUp runModel :: Action (Lockstep M) a
test/Test/MockFS.hs view
@@ -23,38 +23,39 @@ , setPostconditionVerbose ) where -import Prelude hiding (init)+import Prelude hiding (init) -import Control.Exception (catch, throwIO)-import Control.Monad (replicateM, (<=<))-import Control.Monad.Reader (ReaderT (..))-import Control.Monad.Trans (lift)-import Data.Bifunctor-import Data.Constraint-import Data.IORef-import Data.Set (Set)-import Data.Set qualified as Set-import Data.Typeable-import System.Directory (removeDirectoryRecursive)-import System.Directory qualified as IO-import System.IO qualified as IO-import System.IO.Temp (createTempDirectory, getCanonicalTemporaryDirectory)-import System.IO.Unsafe (unsafePerformIO)-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck (testProperty)+import Control.Exception (catch, throwIO)+import Control.Monad (replicateM, (<=<))+import Control.Monad.Reader (ReaderT (..))+import Control.Monad.Trans (lift)+import Data.Bifunctor+import Data.Constraint+import Data.IORef+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Typeable+import qualified System.Directory as IO+import System.Directory (removeDirectoryRecursive)+import qualified System.IO as IO+import System.IO.Temp (createTempDirectory,+ getCanonicalTemporaryDirectory)+import System.IO.Unsafe (unsafePerformIO)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck (testProperty) -import Test.QuickCheck (Gen)-import Test.QuickCheck qualified as QC-import Test.QuickCheck.StateModel hiding (vars)+import qualified Test.QuickCheck as QC+import Test.QuickCheck (Gen)+import Test.QuickCheck.StateModel hiding (vars) -import Test.QuickCheck.StateModel.Lockstep-import Test.QuickCheck.StateModel.Lockstep.Defaults qualified as Lockstep-import Test.QuickCheck.StateModel.Lockstep.Op.SumProd-import Test.QuickCheck.StateModel.Lockstep.Run qualified as Lockstep+import Test.QuickCheck.StateModel.Lockstep+import qualified Test.QuickCheck.StateModel.Lockstep.Defaults as Lockstep+import Test.QuickCheck.StateModel.Lockstep.Op.SumProd+import qualified Test.QuickCheck.StateModel.Lockstep.Run as Lockstep -import Test.MockFS.Mock (Mock, Dir(..), File(..), Err)-import Test.MockFS.Mock qualified as Mock+import qualified Test.MockFS.Mock as Mock+import Test.MockFS.Mock (Dir (..), Err, File (..), Mock) {------------------------------------------------------------------------------- Model state@@ -64,7 +65,7 @@ fsStateMock :: Mock , fsStateStats :: Stats }- deriving (Show)+ deriving stock (Show) initState :: FsState initState = FsState {@@ -102,8 +103,8 @@ runPostcondition pc states action lookUp result monitoring = Lockstep.monitoring (Proxy @RealMonad) -deriving instance Show (Action (Lockstep FsState) a)-deriving instance Eq (Action (Lockstep FsState) a)+deriving stock instance Show (Action (Lockstep FsState) a)+deriving stock instance Eq (Action (Lockstep FsState) a) {------------------------------------------------------------------------------- InLockstep instance@@ -199,10 +200,10 @@ tagStep (_, FsState _ after) act = map show . tagFsAction after act -deriving instance Show (Observable FsState a)-deriving instance Eq (Observable FsState a)+deriving stock instance Show (Observable FsState a)+deriving stock instance Eq (Observable FsState a) -deriving instance Show (FsVal a)+deriving stock instance Show (FsVal a) {------------------------------------------------------------------------------- RunLockstep instance@@ -211,7 +212,7 @@ instance RunLockstep FsState RealMonad where observeReal :: Proxy RealMonad- -> LockstepAction FsState a -> Realized RealMonad a -> FsObs a+ -> LockstepAction FsState a -> a -> FsObs a observeReal _ = \case MkDir{} -> OEither . bimap OId OId Open{} -> OEither . bimap OId (OPair . bimap (const OHandle) OId)@@ -330,7 +331,7 @@ Interpreter for IO -------------------------------------------------------------------------------} -runIO :: LockstepAction FsState a -> LookUp RealMonad -> RealMonad (Realized RealMonad a)+runIO :: LockstepAction FsState a -> LookUp -> RealMonad a runIO action lookUp = ReaderT $ \root -> aux root action where aux :: FilePath -> LockstepAction FsState a -> IO a@@ -351,7 +352,7 @@ _ -> pure s where lookUp' :: FsVar x -> x- lookUp' = realLookupVar (Proxy @RealMonad) lookUp+ lookUp' = realLookupVar lookUp catchErr :: forall a. IO a -> IO (Either Err a) catchErr act = catch (Right <$> act) handler@@ -376,7 +377,7 @@ _otherwise -> id data Tag = OpenTwo | SuccessfulRead- deriving (Show)+ deriving stock (Show) tagFsAction :: Stats -> LockstepAction FsState a -> FsVal a -> [Tag] tagFsAction openedFiles = \case@@ -412,7 +413,7 @@ -------------------------------------------------------------------------------} data Fault = Fault | NoFault- deriving Eq+ deriving stock Eq {-# NOINLINE faultRef #-} -- | A mutable variable that can be set globally to induce test failures in@@ -450,12 +451,12 @@ Postcondition -> (Lockstep FsState, Lockstep FsState) -> Action (Lockstep FsState) a- -> LookUp RealMonad- -> Realized RealMonad a+ -> LookUp+ -> a -> PostconditionM RealMonad Bool-runPostcondition DefaultPostcondition = Lockstep.postcondition+runPostcondition DefaultPostcondition = Lockstep.postcondition runPostcondition NonVerbosePostcondition = Lockstep.postconditionWith False-runPostcondition VerbosePostcondition = Lockstep.postconditionWith True+runPostcondition VerbosePostcondition = Lockstep.postconditionWith True {-# NOINLINE postconditionRef #-} postconditionRef :: IORef Postcondition
test/Test/MockFS/Mock.hs view
@@ -18,28 +18,28 @@ , mRead ) where -import Data.List qualified as List-import Data.Map (Map)-import Data.Map qualified as Map-import Data.Set (Set)-import Data.Set qualified as Set-import GHC.Generics (Generic)-import GHC.IO.Exception qualified as GHC-import System.FilePath ((</>))-import System.IO.Error+import qualified Data.List as List+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set+import GHC.Generics (Generic)+import qualified GHC.IO.Exception as GHC+import System.FilePath ((</>))+import System.IO.Error {------------------------------------------------------------------------------- Paths -------------------------------------------------------------------------------} -data Dir = Dir [String]- deriving (Show, Eq, Ord, Generic)+newtype Dir = Dir [String]+ deriving stock (Show, Eq, Ord, Generic) parent :: Dir -> Dir parent (Dir fp) = Dir (init fp) data File = File {dir :: Dir, name :: String}- deriving (Show, Eq, Ord, Generic)+ deriving stock (Show, Eq, Ord, Generic) dirFP :: FilePath -> Dir -> FilePath dirFP root (Dir d) = List.foldl' (</>) root d@@ -56,7 +56,7 @@ | DoesNotExist | HandleClosed | Busy- deriving (Show, Eq)+ deriving stock (Show, Eq) fromIOError :: IOError -> Maybe Err@@ -80,7 +80,7 @@ , open :: Map MHandle File , next :: MHandle }- deriving (Show, Generic)+ deriving stock (Show, Generic) emptyMock :: Mock emptyMock = M (Set.singleton (Dir [])) Map.empty Map.empty 0