From 60d7474c6fb023d22e4944d6c5663cf778a7aef8 Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Wed, 15 Jan 2025 10:23:28 +0100 Subject: [PATCH 1/6] Add a new `postconditionWith` function with more verbose counterexamples In particular, if verbose counterexamples are enabled all the responses from the system under test and model will be printed. --- .../StateModel/Lockstep/Defaults.hs | 67 +++++++++++++------ 1 file changed, 48 insertions(+), 19 deletions(-) diff --git a/src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs b/src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs index f8104c6..28c14b9 100644 --- a/src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs +++ b/src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs @@ -14,6 +14,7 @@ module Test.QuickCheck.StateModel.Lockstep.Defaults ( , shrinkAction -- * Default implementations for methods of 'RunModel' , postcondition + , postconditionWith , monitoring ) where @@ -99,10 +100,27 @@ postcondition :: forall m state a. -> LookUp m -> Realized m a -> PostconditionM m Bool -postcondition (before, _after) action _lookUp a = +postcondition = postconditionWith False + +-- | Like 'postcondition', but with configurable verbosity. +-- +-- By default, all states of the model are printed when a property +-- counterexample is printed. If verbose output is enabled, the counterexample +-- will also print all responses from the real system and the model. +postconditionWith :: forall m state a. + RunLockstep state m + => Bool -- ^ Verbose output + -> (Lockstep state, Lockstep state) + -> LockstepAction state a + -> LookUp m + -> Realized m a + -> PostconditionM m Bool +postconditionWith verbose (before, _after) action _lookUp a = case checkResponse (Proxy @m) before action a of - Nothing -> pure True - Just s -> monitorPost (QC.counterexample s) >> pure False + Right s + | verbose -> monitorPost (QC.counterexample s) >> pure True + | otherwise -> pure True + Left s -> monitorPost (QC.counterexample s) >> pure False monitoring :: forall m state a. RunLockstep state m @@ -155,7 +173,7 @@ instance InLockstep state => HasVariables (Action (Lockstep state) a) where checkResponse :: forall m state a. RunLockstep state m => Proxy m - -> Lockstep state -> LockstepAction state a -> Realized m a -> Maybe String + -> Lockstep state -> LockstepAction state a -> Realized m a -> Either String String checkResponse p (Lockstep state env) action a = compareEquality (a , observeReal p action a) @@ -166,23 +184,34 @@ checkResponse p (Lockstep state env) action a = compareEquality :: (Realized m a, Observable state a) - -> (ModelValue state a, Observable state a) -> Maybe String + -> (ModelValue state a, Observable state a) -> Either String String compareEquality (realResp, obsRealResp) (mockResp, obsMockResp) - | obsRealResp == obsMockResp = Nothing - | otherwise = Just $ concat [ + | obsRealResp == obsMockResp = Right $ concat [ + "System under test returned: " + , sutReturned + , "\nModel returned: " + , modelReturned + ] + | otherwise = Left $ concat [ "System under test returned: " - , case showRealResponse (Proxy @m) action of - Nothing -> show obsRealResp - Just Dict -> concat [ - show obsRealResp - , " (" - , show realResp - , ")" - ] + , sutReturned , "\nbut model returned: " - , show obsMockResp - , " (" - , show mockResp - , ")" + , modelReturned ] + where + sutReturned = case showRealResponse (Proxy @m) action of + Nothing -> show obsRealResp + Just Dict -> concat [ + show obsRealResp + , " (" + , show realResp + , ")" + ] + + modelReturned = concat [ + show obsMockResp + , " (" + , show mockResp + , ")" + ] \ No newline at end of file From c5b81f8a9df2d013777c2ba020146619c1b57b06 Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Wed, 15 Jan 2025 10:37:58 +0100 Subject: [PATCH 2/6] Enable verbose counterexamples by default in `postcondition` --- CHANGELOG.md | 10 ++++++++++ src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs | 2 +- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a541a0d..23c233e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,15 @@ # Revision history for quickcheck-lockstep +## ?.?.? -- ????-??-?? + +* BREAKING: Enable verbose counterexamples by default in the 'postcondition' + function using 'postconditionWith'. +* NON-BREAKING: Add a new 'postconditionWith' function that can be configured to + produce more verbose counterexamples. With verbosity disabled, all states of + the model are printed in a counterexample. If verbosity is enabled, the + counterexample will also include all responses from the real system and the + model. + ## 0.6.0 -- 2024-12-03 * BREAKING: Generalise `ModelFindVariables` and `ModelLookup` to diff --git a/src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs b/src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs index 28c14b9..160e387 100644 --- a/src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs +++ b/src/Test/QuickCheck/StateModel/Lockstep/Defaults.hs @@ -100,7 +100,7 @@ postcondition :: forall m state a. -> LookUp m -> Realized m a -> PostconditionM m Bool -postcondition = postconditionWith False +postcondition = postconditionWith True -- | Like 'postcondition', but with configurable verbosity. -- From 6a13899bc86fc6a0284a74e655685c802c3cdd6b Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Wed, 15 Jan 2025 10:39:55 +0100 Subject: [PATCH 3/6] Extract `propLockstep` from the `Test.MockFS` test tree We'll use this property directly in the next commits. Also: implement `showRealResponse` for the `Test.MockFS` lockstep state machine. --- test/Test/MockFS.hs | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/test/Test/MockFS.hs b/test/Test/MockFS.hs index fccc68d..3bd6695 100644 --- a/test/Test/MockFS.hs +++ b/test/Test/MockFS.hs @@ -11,7 +11,10 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -module Test.MockFS (tests) where +module Test.MockFS ( + tests + , propLockstep + ) where import Prelude hiding (init) @@ -19,6 +22,7 @@ import Control.Exception (catch, throwIO) import Control.Monad (replicateM, (<=<)) import Control.Monad.Reader (ReaderT (..)) import Data.Bifunctor +import Data.Constraint import Data.Set (Set) import Data.Set qualified as Set import Data.Typeable @@ -203,6 +207,13 @@ instance RunLockstep FsState RealMonad where Close{} -> OEither . bimap OId OId Read{} -> OEither . bimap OId OId + showRealResponse _ = \case + MkDir{} -> Just Dict + Open{} -> Nothing + Write{} -> Just Dict + Close{} -> Just Dict + Read{} -> Just Dict + {------------------------------------------------------------------------------- Interpreter against the model -------------------------------------------------------------------------------} @@ -365,13 +376,16 @@ tests :: TestTree tests = testGroup "Test.MockFS" [ testCase "labelledExamples" $ QC.labelledExamples $ Lockstep.tagActions (Proxy @FsState) - , testProperty "propLockstep" $ - Lockstep.runActionsBracket (Proxy @FsState) - (createSystemTempDirectory "QSM") - removeDirectoryRecursive - runReaderT + , testProperty "propLockstep" propLockstep ] +propLockstep :: Actions (Lockstep FsState) -> QC.Property +propLockstep = + Lockstep.runActionsBracket (Proxy @FsState) + (createSystemTempDirectory "QSM") + removeDirectoryRecursive + runReaderT + createSystemTempDirectory :: [Char] -> IO FilePath createSystemTempDirectory prefix = do systemTempDir <- getCanonicalTemporaryDirectory From c0d47e38a50b80102e08083831100626308038eb Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Wed, 15 Jan 2025 10:41:55 +0100 Subject: [PATCH 4/6] Globally set the postcondition for the `Test.MockFS` state machine --- test/Test/MockFS.hs | 55 ++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 54 insertions(+), 1 deletion(-) diff --git a/test/Test/MockFS.hs b/test/Test/MockFS.hs index 3bd6695..eb8c905 100644 --- a/test/Test/MockFS.hs +++ b/test/Test/MockFS.hs @@ -14,6 +14,10 @@ module Test.MockFS ( tests , propLockstep + -- * Unsafe: set postcondition + , setPostconditionDefault + , setPostconditionNonVerbose + , setPostconditionVerbose ) where import Prelude hiding (init) @@ -21,8 +25,10 @@ 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 @@ -30,6 +36,7 @@ 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) @@ -87,7 +94,9 @@ instance StateModel (Lockstep FsState) where instance RunModel (Lockstep FsState) RealMonad where perform = \_st -> runIO - postcondition = Lockstep.postcondition + postcondition states action lookUp result = do + pc <- lift $ lift getPostcondition + runPostcondition pc states action lookUp result monitoring = Lockstep.monitoring (Proxy @RealMonad) deriving instance Show (Action (Lockstep FsState) a) @@ -390,3 +399,47 @@ createSystemTempDirectory :: [Char] -> IO FilePath createSystemTempDirectory prefix = do systemTempDir <- getCanonicalTemporaryDirectory createTempDirectory systemTempDir prefix + +{------------------------------------------------------------------------------- + Unsafe: set postcondition +-------------------------------------------------------------------------------} + +data Postcondition = + DefaultPostcondition + | NonVerbosePostcondition + | VerbosePostcondition + +runPostcondition :: + Postcondition + -> (Lockstep FsState, Lockstep FsState) + -> Action (Lockstep FsState) a + -> LookUp RealMonad + -> Realized RealMonad a + -> PostconditionM RealMonad Bool +runPostcondition DefaultPostcondition = Lockstep.postcondition +runPostcondition NonVerbosePostcondition = Lockstep.postconditionWith False +runPostcondition VerbosePostcondition = Lockstep.postconditionWith True + +{-# NOINLINE postconditionRef #-} +postconditionRef :: IORef Postcondition +postconditionRef = unsafePerformIO $ newIORef DefaultPostcondition + +{-# NOINLINE getPostcondition #-} +getPostcondition :: IO Postcondition +getPostcondition = readIORef postconditionRef + +{-# NOINLINE setPostconditionDefault #-} +setPostconditionDefault :: IO () +setPostconditionDefault = setPostcondition VerbosePostcondition + +{-# NOINLINE setPostconditionVerbose #-} +setPostconditionVerbose :: IO () +setPostconditionVerbose = setPostcondition VerbosePostcondition + +{-# NOINLINE setPostconditionNonVerbose #-} +setPostconditionNonVerbose :: IO () +setPostconditionNonVerbose = setPostcondition NonVerbosePostcondition + +{-# NOINLINE setPostcondition #-} +setPostcondition :: Postcondition -> IO () +setPostcondition = writeIORef postconditionRef From 967d5fbc25ecdf0a3c74de07bbd4c52007fdac04 Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Wed, 15 Jan 2025 10:42:19 +0100 Subject: [PATCH 5/6] Globally set induced errors for the `Test.MockFS` state machine --- test/Test/MockFS.hs | 41 +++++++++++++++++++++++++++++++++++++++-- 1 file changed, 39 insertions(+), 2 deletions(-) diff --git a/test/Test/MockFS.hs b/test/Test/MockFS.hs index eb8c905..f015102 100644 --- a/test/Test/MockFS.hs +++ b/test/Test/MockFS.hs @@ -14,6 +14,9 @@ module Test.MockFS ( tests , propLockstep + -- * Unsafe: induce test failure + , setInduceFault + , setNoInduceFault -- * Unsafe: set postcondition , setPostconditionDefault , setPostconditionNonVerbose @@ -340,8 +343,12 @@ runIO action lookUp = ReaderT $ \root -> aux root action IO.hPutStr (lookUp' h) s Close h -> catchErr $ IO.hClose (lookUp' h) - Read f -> catchErr $ - IO.readFile (Mock.fileFP root $ either lookUp' id f) + Read f -> catchErr $ do + fault <- getFaultRef + s <- IO.readFile (Mock.fileFP root $ either lookUp' id f) + case fault of + Fault | length s >= 3 -> pure "" + _ -> pure s where lookUp' :: FsVar x -> x lookUp' = lookUpGVar (Proxy @RealMonad) lookUp @@ -400,6 +407,36 @@ createSystemTempDirectory prefix = do systemTempDir <- getCanonicalTemporaryDirectory createTempDirectory systemTempDir prefix +{------------------------------------------------------------------------------- + Unsafe: induce test failure +-------------------------------------------------------------------------------} + +data Fault = Fault | NoFault + deriving Eq + +{-# NOINLINE faultRef #-} +-- | A mutable variable that can be set globally to induce test failures in +-- 'propLockstep'. This is used in "Test.Golden" to golden test counterexamples +-- as produced by the @quickcheck-lockstep@. +faultRef :: IORef Fault +faultRef = unsafePerformIO $ newIORef NoFault + +{-# NOINLINE getFaultRef #-} +getFaultRef :: IO Fault +getFaultRef = readIORef faultRef + +{-# NOINLINE setFaultRef #-} +setFaultRef :: Fault -> IO () +setFaultRef = writeIORef faultRef + +{-# NOINLINE setInduceFault #-} +setInduceFault :: IO () +setInduceFault = setFaultRef Fault + +{-# NOINLINE setNoInduceFault #-} +setNoInduceFault :: IO () +setNoInduceFault = setFaultRef NoFault + {------------------------------------------------------------------------------- Unsafe: set postcondition -------------------------------------------------------------------------------} From 0b014533585de3f7152226d9d8024370ba2f33ab Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Wed, 15 Jan 2025 10:42:57 +0100 Subject: [PATCH 6/6] Golden tests for counterexamples produced by `postcondition` and `postconditionWith` --- .gitattributes | 1 + .gitignore | 2 + quickcheck-lockstep.cabal | 2 + test/Main.hs | 12 +- test/Test/Golden.hs | 107 ++++++++++++++++++ ...failure_default_propLockstep_MockFS.golden | 18 +++ ...lure_nonVerbose_propLockstep_MockFS.golden | 12 ++ ...failure_verbose_propLockstep_MockFS.golden | 18 +++ .../golden_success_propLockstep_MockFS.golden | 19 ++++ 9 files changed, 186 insertions(+), 5 deletions(-) create mode 100644 .gitattributes create mode 100644 test/Test/Golden.hs create mode 100644 test/golden/golden_failure_default_propLockstep_MockFS.golden create mode 100644 test/golden/golden_failure_nonVerbose_propLockstep_MockFS.golden create mode 100644 test/golden/golden_failure_verbose_propLockstep_MockFS.golden create mode 100644 test/golden/golden_success_propLockstep_MockFS.golden diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..555cfe9 --- /dev/null +++ b/.gitattributes @@ -0,0 +1 @@ +*.golden -text \ No newline at end of file diff --git a/.gitignore b/.gitignore index 5f60a05..ca0e284 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,7 @@ dist-newstyle .envrc +_tmp +haddocks/ # Haskell.gitignore dist diff --git a/quickcheck-lockstep.cabal b/quickcheck-lockstep.cabal index 0f1aea6..6daa6e1 100644 --- a/quickcheck-lockstep.cabal +++ b/quickcheck-lockstep.cabal @@ -80,6 +80,7 @@ test-suite test-quickcheck-lockstep hs-source-dirs: test main-is: Main.hs other-modules: + Test.Golden Test.IORef.Full Test.IORef.Simple Test.MockFS @@ -101,6 +102,7 @@ test-suite test-quickcheck-lockstep , quickcheck-dynamic , quickcheck-lockstep , tasty + , tasty-golden , tasty-hunit , tasty-quickcheck , temporary diff --git a/test/Main.hs b/test/Main.hs index 4957a2b..c97f845 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,14 +1,16 @@ module Main (main) where -import Test.Tasty +import Test.Tasty -import Test.IORef.Full qualified -import Test.IORef.Simple qualified -import Test.MockFS qualified +import Test.Golden +import Test.IORef.Full +import Test.IORef.Simple +import Test.MockFS main :: IO () main = defaultMain $ testGroup "quickcheck-lockstep" [ - Test.IORef.Simple.tests + Test.Golden.tests + , Test.IORef.Simple.tests , Test.IORef.Full.tests , Test.MockFS.tests ] diff --git a/test/Test/Golden.hs b/test/Test/Golden.hs new file mode 100644 index 0000000..85eae38 --- /dev/null +++ b/test/Test/Golden.hs @@ -0,0 +1,107 @@ +{- HLINT ignore "Use camelCase" -} + +module Test.Golden where + +import Control.Exception (bracket_) +import System.Directory +import System.FilePath +import Test.MockFS as MockFS +import Test.QuickCheck +import Test.QuickCheck.Random (mkQCGen) +import Test.Tasty +import Test.Tasty.Golden + +tests :: TestTree +tests = testGroup "Test.Golden" [ + golden_success_propLockstep_MockFS + , golden_failure_default_propLockstep_MockFS + , golden_failure_nonVerbose_propLockstep_MockFS + , golden_failure_verbose_propLockstep_MockFS + ] + +goldenDir :: FilePath +goldenDir = "test" "golden" + +tmpDir :: FilePath +tmpDir = "_tmp" + +-- | Golden test for a successful lockstep test +golden_success_propLockstep_MockFS :: TestTree +golden_success_propLockstep_MockFS = + goldenVsFile testName goldenPath outputPath $ do + createDirectoryIfMissing False tmpDir + r <- quickCheckWithResult args MockFS.propLockstep + writeFile outputPath (output r) + where + testName = "golden_success_propLockstep_MockFS" + goldenPath = goldenDir testName <.> "golden" + outputPath = tmpDir testName <.> "golden" + + args = stdArgs { + replay = Just (mkQCGen 17, 32) + , chatty = False + } + +-- | Golden test for a failing lockstep test that produces a counterexample +-- using the default postcondition. +golden_failure_default_propLockstep_MockFS :: TestTree +golden_failure_default_propLockstep_MockFS = + goldenVsFile testName goldenPath outputPath $ do + createDirectoryIfMissing False tmpDir + r <- + bracket_ + MockFS.setInduceFault + MockFS.setNoInduceFault + (quickCheckWithResult args MockFS.propLockstep) + writeFile outputPath (output r) + where + testName = "golden_failure_default_propLockstep_MockFS" + goldenPath = goldenDir testName <.> "golden" + outputPath = tmpDir testName <.> "golden" + + args = stdArgs { + replay = Just (mkQCGen 17, 32) + , chatty = False + } + +-- | Golden test for a failing lockstep test that produces a /non-verbose/ counterexample +golden_failure_nonVerbose_propLockstep_MockFS :: TestTree +golden_failure_nonVerbose_propLockstep_MockFS = + goldenVsFile testName goldenPath outputPath $ do + createDirectoryIfMissing False tmpDir + r <- + bracket_ + (MockFS.setInduceFault >> MockFS.setPostconditionNonVerbose) + (MockFS.setNoInduceFault >> MockFS.setPostconditionDefault) + (quickCheckWithResult args MockFS.propLockstep) + writeFile outputPath (output r) + where + testName = "golden_failure_nonVerbose_propLockstep_MockFS" + goldenPath = goldenDir testName <.> "golden" + outputPath = tmpDir testName <.> "golden" + + args = stdArgs { + replay = Just (mkQCGen 17, 32) + , chatty = False + } + +-- | Golden test for a failing lockstep test that produces a /verbose/ counterexample +golden_failure_verbose_propLockstep_MockFS :: TestTree +golden_failure_verbose_propLockstep_MockFS = + goldenVsFile testName goldenPath outputPath $ do + createDirectoryIfMissing False tmpDir + r <- + bracket_ + (MockFS.setInduceFault >> MockFS.setPostconditionVerbose) + (MockFS.setNoInduceFault >> MockFS.setPostconditionDefault) + (quickCheckWithResult args MockFS.propLockstep) + writeFile outputPath (output r) + where + testName = "golden_failure_verbose_propLockstep_MockFS" + goldenPath = goldenDir testName <.> "golden" + outputPath = tmpDir testName <.> "golden" + + args = stdArgs { + replay = Just (mkQCGen 17, 32) + , chatty = False + } diff --git a/test/golden/golden_failure_default_propLockstep_MockFS.golden b/test/golden/golden_failure_default_propLockstep_MockFS.golden new file mode 100644 index 0000000..b27897f --- /dev/null +++ b/test/golden/golden_failure_default_propLockstep_MockFS.golden @@ -0,0 +1,18 @@ +*** Failed! Assertion failed (after 40 tests and 9 shrinks): +do var1 <- action $ Open (File {dir = Dir [], name = "t0"}) + action $ Write (unsafeMkGVar var1 (OpFst `OpComp` OpRight `OpComp` OpId)) "BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA" + action $ Close (unsafeMkGVar var1 (OpFst `OpComp` OpRight `OpComp` OpId)) + action $ Read (Left (unsafeMkGVar var1 (OpSnd `OpComp` OpRight `OpComp` OpId))) + pure () +State: FsState {fsStateMock = M {dirs = fromList [Dir []], files = fromList [(File {dir = Dir [], name = "t0"},"")], open = fromList [(0,File {dir = Dir [], name = "t0"})], next = 1}, fsStateStats = fromList [File {dir = Dir [], name = "t0"}]} +System under test returned: OEither (Right (OPair (OHandle,OId (File {dir = Dir [], name = "t0"})))) +Model returned: OEither (Right (OPair (OHandle,OId (File {dir = Dir [], name = "t0"})))) (MEither (Right (MPair (MHandle 0,MFile (File {dir = Dir [], name = "t0"}))))) +State: FsState {fsStateMock = M {dirs = fromList [Dir []], files = fromList [(File {dir = Dir [], name = "t0"},"BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA")], open = fromList [(0,File {dir = Dir [], name = "t0"})], next = 1}, fsStateStats = fromList [File {dir = Dir [], name = "t0"}]} +System under test returned: OEither (Right (OId ())) (Right ()) +Model returned: OEither (Right (OId ())) (MEither (Right (MUnit ()))) +State: FsState {fsStateMock = M {dirs = fromList [Dir []], files = fromList [(File {dir = Dir [], name = "t0"},"BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA")], open = fromList [], next = 1}, fsStateStats = fromList [File {dir = Dir [], name = "t0"}]} +System under test returned: OEither (Right (OId ())) (Right ()) +Model returned: OEither (Right (OId ())) (MEither (Right (MUnit ()))) +State: FsState {fsStateMock = M {dirs = fromList [Dir []], files = fromList [(File {dir = Dir [], name = "t0"},"BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA")], open = fromList [], next = 1}, fsStateStats = fromList [File {dir = Dir [], name = "t0"}]} +System under test returned: OEither (Right (OId "")) (Right "") +but model returned: OEither (Right (OId "BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA")) (MEither (Right (MString "BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA"))) diff --git a/test/golden/golden_failure_nonVerbose_propLockstep_MockFS.golden b/test/golden/golden_failure_nonVerbose_propLockstep_MockFS.golden new file mode 100644 index 0000000..b87907f --- /dev/null +++ b/test/golden/golden_failure_nonVerbose_propLockstep_MockFS.golden @@ -0,0 +1,12 @@ +*** Failed! Assertion failed (after 40 tests and 9 shrinks): +do var1 <- action $ Open (File {dir = Dir [], name = "t0"}) + action $ Write (unsafeMkGVar var1 (OpFst `OpComp` OpRight `OpComp` OpId)) "BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA" + action $ Close (unsafeMkGVar var1 (OpFst `OpComp` OpRight `OpComp` OpId)) + action $ Read (Left (unsafeMkGVar var1 (OpSnd `OpComp` OpRight `OpComp` OpId))) + pure () +State: FsState {fsStateMock = M {dirs = fromList [Dir []], files = fromList [(File {dir = Dir [], name = "t0"},"")], open = fromList [(0,File {dir = Dir [], name = "t0"})], next = 1}, fsStateStats = fromList [File {dir = Dir [], name = "t0"}]} +State: FsState {fsStateMock = M {dirs = fromList [Dir []], files = fromList [(File {dir = Dir [], name = "t0"},"BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA")], open = fromList [(0,File {dir = Dir [], name = "t0"})], next = 1}, fsStateStats = fromList [File {dir = Dir [], name = "t0"}]} +State: FsState {fsStateMock = M {dirs = fromList [Dir []], files = fromList [(File {dir = Dir [], name = "t0"},"BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA")], open = fromList [], next = 1}, fsStateStats = fromList [File {dir = Dir [], name = "t0"}]} +State: FsState {fsStateMock = M {dirs = fromList [Dir []], files = fromList [(File {dir = Dir [], name = "t0"},"BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA")], open = fromList [], next = 1}, fsStateStats = fromList [File {dir = Dir [], name = "t0"}]} +System under test returned: OEither (Right (OId "")) (Right "") +but model returned: OEither (Right (OId "BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA")) (MEither (Right (MString "BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA"))) diff --git a/test/golden/golden_failure_verbose_propLockstep_MockFS.golden b/test/golden/golden_failure_verbose_propLockstep_MockFS.golden new file mode 100644 index 0000000..b27897f --- /dev/null +++ b/test/golden/golden_failure_verbose_propLockstep_MockFS.golden @@ -0,0 +1,18 @@ +*** Failed! Assertion failed (after 40 tests and 9 shrinks): +do var1 <- action $ Open (File {dir = Dir [], name = "t0"}) + action $ Write (unsafeMkGVar var1 (OpFst `OpComp` OpRight `OpComp` OpId)) "BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA" + action $ Close (unsafeMkGVar var1 (OpFst `OpComp` OpRight `OpComp` OpId)) + action $ Read (Left (unsafeMkGVar var1 (OpSnd `OpComp` OpRight `OpComp` OpId))) + pure () +State: FsState {fsStateMock = M {dirs = fromList [Dir []], files = fromList [(File {dir = Dir [], name = "t0"},"")], open = fromList [(0,File {dir = Dir [], name = "t0"})], next = 1}, fsStateStats = fromList [File {dir = Dir [], name = "t0"}]} +System under test returned: OEither (Right (OPair (OHandle,OId (File {dir = Dir [], name = "t0"})))) +Model returned: OEither (Right (OPair (OHandle,OId (File {dir = Dir [], name = "t0"})))) (MEither (Right (MPair (MHandle 0,MFile (File {dir = Dir [], name = "t0"}))))) +State: FsState {fsStateMock = M {dirs = fromList [Dir []], files = fromList [(File {dir = Dir [], name = "t0"},"BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA")], open = fromList [(0,File {dir = Dir [], name = "t0"})], next = 1}, fsStateStats = fromList [File {dir = Dir [], name = "t0"}]} +System under test returned: OEither (Right (OId ())) (Right ()) +Model returned: OEither (Right (OId ())) (MEither (Right (MUnit ()))) +State: FsState {fsStateMock = M {dirs = fromList [Dir []], files = fromList [(File {dir = Dir [], name = "t0"},"BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA")], open = fromList [], next = 1}, fsStateStats = fromList [File {dir = Dir [], name = "t0"}]} +System under test returned: OEither (Right (OId ())) (Right ()) +Model returned: OEither (Right (OId ())) (MEither (Right (MUnit ()))) +State: FsState {fsStateMock = M {dirs = fromList [Dir []], files = fromList [(File {dir = Dir [], name = "t0"},"BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA")], open = fromList [], next = 1}, fsStateStats = fromList [File {dir = Dir [], name = "t0"}]} +System under test returned: OEither (Right (OId "")) (Right "") +but model returned: OEither (Right (OId "BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA")) (MEither (Right (MString "BAACCCCCCBCCAAAABBBBCBBABACCACBABCCACCA"))) diff --git a/test/golden/golden_success_propLockstep_MockFS.golden b/test/golden/golden_success_propLockstep_MockFS.golden new file mode 100644 index 0000000..2525079 --- /dev/null +++ b/test/golden/golden_success_propLockstep_MockFS.golden @@ -0,0 +1,19 @@ ++++ OK, passed 100 tests. + +Action polarity (2489 in total): +100.00% + + +Actions (2489 in total): +30.33% +MkDir +28.93% +Open +27.92% +Read + 6.79% +Write + 6.03% +Close + +Actions rejected by precondition (958 in total): +52.0% Close +48.0% Write + +Tags (428 in total): +92.3% OpenTwo + 7.7% SuccessfulRead