io-sim 1.5.1.0 → 1.6.0.0

raw patch · 7 files changed

+126/−55 lines, 7 filesdep −si-timersdep −strict-stmdep ~io-classesPVP ok

version bump matches the API change (PVP)

Dependencies removed: si-timers, strict-stm

Dependency ranges changed: io-classes

API changes (from Hackage documentation)

Files

• CHANGELOG.md +2/−9
• README.md +4/−5
• io-sim.cabal +6/−8
• src/Control/Monad/IOSim.hs +13/−17
• test/Main.hs +2/−0
• test/Test/Control/Concurrent/Class/MonadMVar/Strict.hs +31/−0
• test/Test/Control/Monad/IOSim.hs +68/−16

@@ -1,15 +1,8 @@ # Revision history of io-sim -## 1.5.1.0+## 1.6.0.0 -- The signature of:-  - `selectTraceEvents'`,-  - `selectTraceEventsDynamic'`,-  - `selectTraceEventsDynamicWithTime'`,-  - `selectTraceEventsSay'` and-  - `selectTraceEventsSayWithTime'`-  is more general.  These functions now accepts trace with any result, rather-  than one that finishes with `SimResult`.+- Upgraded to `io-classes-1.6.0.0`  ## 1.5.0.0 

@@ -1,8 +1,8 @@-# [IO Simulator Monad][`io-sim`]+# [IO Simulator Monad][`io-sim`]: `io-sim`  A pure simulator monad built on top of the lazy `ST` monad which supports: -  * optional dynamic race discovery and schedule exploration+  * optional dynamic race discovery and schedule exploration (see [`IOSimPOR`])   * synchronous and asynchronous exceptions; including: throwing, catching and     masking synchronous and asynchronous exceptions;   * concurrency (using simulated threads), with interfaces shaped by the@@ -15,7 +15,6 @@   * inspection of `STM` mutable data structures;   * deadlock detection;   * `MonadFix` instances for both [`IOSim`] and its corresponding `STM` monad.-  * partial order reduction (see [`IOSimPOR`]).  [`io-sim`] together with [`io-classes`] is a drop-in replacement for the `IO` monad (with some ramifications).  It was designed to write easily testable@@ -42,7 +41,7 @@ specification.  [`io-sim`]:  https://hackage.haskell.org/package/io-sim-[`io-classes`]: https://hackage.haskell.org/package/io-classes-[`si-timers`]: https://hackage.haskell.org/package/si-timers+[`io-classes`]: https://input-output-hk.github.io/io-sim/io-classes/index.html+[`si-timers`]: https://input-output-hk.github.io/io-sim/io-classes/si-timers/index.html [`IOSimPOR`]: https://github.com/input-output-hk/io-sim/tree/main/io-sim/how-to-use-IOSimPOR.md [`IOSim`]: https://hackage.haskell.org/package/io-sim/docs/Control-Monad-IOSim.html#t:IOSim

@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                io-sim-version:             1.5.1.0+version:             1.6.0.0 synopsis:            A pure simulator for monadic concurrency with STM. description:   A pure simulator monad with support of concurency (base & async style), stm,@@ -76,15 +76,14 @@                        ScopedTypeVariables,                        TypeFamilies   build-depends:       base              >=4.9 && <4.21,-                       io-classes       ^>=1.5,+                       io-classes:{io-classes,strict-stm,si-timers}+                                        ^>=1.6,                        exceptions        >=0.10,                        containers,                        deepseq,                        nothunks,                        primitive         >=0.7 && <0.11,                        psqueues          >=0.2 && <0.3,-                       strict-stm       ^>=1.5,-                       si-timers        ^>=1.5,                        time              >=1.9.1 && <1.13,                        quiet,                        QuickCheck,@@ -100,6 +99,7 @@   hs-source-dirs:      test   main-is:             Main.hs   other-modules:       Test.Control.Concurrent.Class.MonadMVar+                       Test.Control.Concurrent.Class.MonadMVar.Strict                        Test.Control.Monad.STM                        Test.Control.Monad.Utils                        Test.Control.Monad.IOSim@@ -109,11 +109,9 @@   build-depends:       base,                        array,                        containers,-                       io-classes,+                       io-classes:{io-classes,strict-stm,si-timers,testlib},                        io-sim,                        QuickCheck,-                       si-timers,-                       strict-stm,                        tasty,                        tasty-quickcheck,                        tasty-hunit,@@ -133,7 +131,7 @@   build-depends:       base,                        criterion ^>= 1.6, -                       io-classes,+                       io-classes:io-classes,                        io-sim,   ghc-options:         -Wall                        -Wcompat

@@ -43,6 +43,8 @@     -- * Simulation trace   , type SimTrace   , Trace (Cons, Nil, SimTrace, SimPORTrace, TraceDeadlock, TraceLoop, TraceMainReturn, TraceMainException, TraceRacesFound, TraceInternalError)+  , traceEvents+  , traceResult   , SimResult (..)   , SimEvent (..)   , SimEventType (..)@@ -59,8 +61,6 @@   , ppSimEvent   , ppDebug     -- ** Selectors-  , traceEvents-  , traceResult     -- *** list selectors   , selectTraceEvents   , selectTraceEvents'@@ -144,12 +144,11 @@     . traceSelectTraceEvents fn  -- | Like 'selectTraceEvents', but it returns even if the simulation trace ends--- with 'Failure'.  It also works with any return type, not only `SimResult`--- like `selectTraceEvents` does.+-- with 'Failure'. -- selectTraceEvents'     :: (Time ->  SimEventType -> Maybe b)-    -> Trace a SimEvent+    -> SimTrace a     -> [b] selectTraceEvents' fn =       bifoldr ( \ _ _   -> []  )@@ -226,22 +225,20 @@     fn t (EventLog dyn) = (t,) <$> fromDynamic dyn     fn _ _              = Nothing --- | Like 'selectTraceEventsDynamic' but it returns even if the simulation--- trace ends with 'Failure'.  It also works with any return type, not only--- `SimResult` like `selectTraceEventsDynamic` does.+-- | Like 'selectTraceEventsDynamic' but it returns even if the simulation trace+-- ends with 'Failure'. ---selectTraceEventsDynamic' :: forall a b. Typeable b => Trace a SimEvent -> [b]+selectTraceEventsDynamic' :: forall a b. Typeable b => SimTrace a -> [b] selectTraceEventsDynamic' = selectTraceEvents' fn   where     fn :: Time -> SimEventType -> Maybe b     fn _ (EventLog dyn) = fromDynamic dyn     fn _ _              = Nothing --- | Like `selectTraceEventsDynamicWithTime'` but it also captures time of the--- trace event.  It also works with any return type, not only `SimResult` like--- `selectTraceEventsDynamicWithTime` does.+-- | Like `selectTraceEventsDynamic'` but it also captures time of the trace+-- event. ---selectTraceEventsDynamicWithTime' :: forall a b. Typeable b => Trace a SimEvent -> [(Time, b)]+selectTraceEventsDynamicWithTime' :: forall a b. Typeable b => SimTrace a -> [(Time, b)] selectTraceEventsDynamicWithTime' = selectTraceEvents' fn   where     fn :: Time -> SimEventType -> Maybe (Time, b)@@ -269,10 +266,9 @@     fn _ _            = Nothing  -- | Like 'selectTraceEventsSay' but it returns even if the simulation trace--- ends with 'Failure'.  It also works with any return type, not only `SimResult`--- like `selectTraceEventsSay` does.+-- ends with 'Failure'. ---selectTraceEventsSay' :: Trace a SimEvent -> [String]+selectTraceEventsSay' :: SimTrace a -> [String] selectTraceEventsSay' = selectTraceEvents' fn   where     fn :: Time -> SimEventType -> Maybe String@@ -281,7 +277,7 @@  -- | Like `selectTraceEventsSay'` but it also captures time of the trace event. ---selectTraceEventsSayWithTime' :: Trace a SimEvent -> [(Time, String)]+selectTraceEventsSayWithTime' :: SimTrace a -> [(Time, String)] selectTraceEventsSayWithTime' = selectTraceEvents' fn   where     fn :: Time -> SimEventType -> Maybe (Time, String)

@@ -3,6 +3,7 @@ import Test.Tasty  import Test.Control.Concurrent.Class.MonadMVar qualified (tests)+import Test.Control.Concurrent.Class.MonadMVar.Strict qualified (tests) import Test.Control.Monad.IOSim qualified (tests) import Test.Control.Monad.IOSimPOR qualified (tests) @@ -13,6 +14,7 @@ tests =   testGroup "io-sim-tests"   [ Test.Control.Concurrent.Class.MonadMVar.tests+  , Test.Control.Concurrent.Class.MonadMVar.Strict.tests   , Test.Control.Monad.IOSim.tests   , Test.Control.Monad.IOSimPOR.tests   ]

@@ -0,0 +1,31 @@+module Test.Control.Concurrent.Class.MonadMVar.Strict where++import Control.Monad.IOSim+import Test.Control.Concurrent.Class.MonadMVar.Strict.WHNF++import Test.Tasty+import Test.Tasty.QuickCheck++tests :: TestTree+tests = testGroup "Test.Control.Concurrent.Class.MonadMVar.Strict"+        [ testGroup "WHNF"+          [ testGroup "IOSIM"+            [ testProperty "prop_newMVar" $ \x f ->+                monadicIOSim_ $ prop_newMVar x f+            , testProperty "prop_putMVar" $ \x f ->+                monadicIOSim_ $ prop_putMVar x f+            , testProperty "prop_swapMVar" $ \x f ->+                monadicIOSim_ $ prop_swapMVar x f+            , testProperty "prop_tryPutMVar" $ \x f ->+                monadicIOSim_ $ prop_tryPutMVar x f+            , testProperty "prop_modifyMVar_" $ \x f ->+                monadicIOSim_ $ prop_modifyMVar_ x f+            , testProperty "prop_modifyMVar" $ \x f ->+                monadicIOSim_ $ prop_modifyMVar x f+            , testProperty "prop_modifyMVarMasked_" $ \x f ->+                monadicIOSim_ $ prop_modifyMVarMasked_ x f+            , testProperty "prop_modifyMVarMasked" $ \x f ->+                monadicIOSim_ $ prop_modifyMVarMasked x f+            ]+          ]+        ]

@@ -181,9 +181,17 @@     ]   , testGroup "MonadSTM"     [ testGroup "flushTQueue"-      [ testProperty "empties the queue" prop_flushTQueueEmpties-      , testProperty "maintains FIFO order" prop_flushTQueueOrder+      [ testProperty "empties the queue IO" prop_flushTQueueEmpties_IO+      , testProperty "empties the queue IOSim" prop_flushTQueueEmpties_IOSim+      , testProperty "maintains FIFO order IO" prop_flushTQueueOrder_IO+      , testProperty "maintains FIFO order IOSim" prop_flushTQueueOrder_IOSim       ]+    , testGroup "flushTBQueue"+      [ testProperty "empties the queue IO" prop_flushTBQueueEmpties_IO+      , testProperty "empties the queue IOSim" prop_flushTBQueueEmpties_IOSim+      , testProperty "maintains FIFO order IO" prop_flushTBQueueOrder_IO+      , testProperty "maintains FIFO order IOSim" prop_flushTBQueueOrder_IOSim+      ]     ]   ] @@ -1385,32 +1393,76 @@         cancelTimeout         awaitTimeout --- | Test that 'flushTQueue' empties the queue.-prop_flushTQueueEmpties :: Property-prop_flushTQueueEmpties =-  ioProperty emptyQueueAfterFlush-  .&&. runSimOrThrow emptyQueueAfterFlush+-- | Test that 'flushTQueue' empties the queue in `IO`.+prop_flushTQueueEmpties_IO :: Property+prop_flushTQueueEmpties_IO =+  ioProperty emptyTQueueAfterFlush -emptyQueueAfterFlush :: MonadSTM m => m Bool-emptyQueueAfterFlush = do+-- | Test that 'flushTQueue' empties the queue in `IOSim`.+prop_flushTQueueEmpties_IOSim :: Bool+prop_flushTQueueEmpties_IOSim =+  runSimOrThrow emptyTQueueAfterFlush++emptyTQueueAfterFlush :: MonadSTM m => m Bool+emptyTQueueAfterFlush = do   q <- newTQueueIO   atomically $ do     writeTQueue q (1 :: Int)     _ <- flushTQueue q     isEmptyTQueue q --- | Test that 'flushTQueue' returns values in FIFO order.-prop_flushTQueueOrder :: [Int] -> Property-prop_flushTQueueOrder entries =-  ioProperty (writeAndFlushQueue entries >>= \actual -> pure $ actual === entries)-  .&&. runSimOrThrow (writeAndFlushQueue entries) === entries+-- | Test that 'flushTQueue' returns values in FIFO order in `IO`.+prop_flushTQueueOrder_IO :: [Int] -> Property+prop_flushTQueueOrder_IO entries =+  ioProperty (writeAndFlushTQueue entries >>= \actual -> pure $ actual === entries) -writeAndFlushQueue :: MonadSTM m => [Int] -> m [Int]-writeAndFlushQueue entries =+-- | Test that 'flushTQueue' returns values in FIFO order in `IOSim`.+prop_flushTQueueOrder_IOSim :: [Int] -> Property+prop_flushTQueueOrder_IOSim entries =+  runSimOrThrow (writeAndFlushTQueue entries) === entries++writeAndFlushTQueue :: MonadSTM m => [Int] -> m [Int]+writeAndFlushTQueue entries =   atomically $ do     q <- newTQueue     forM_ entries $ writeTQueue q     flushTQueue q++-- | Test that 'flushTBQueue' empties the queue in `IO`.+prop_flushTBQueueEmpties_IO :: Property+prop_flushTBQueueEmpties_IO =+  ioProperty emptyTBQueueAfterFlush++-- | Test that 'flushTBQueue' empties the queue in `IOSim`.+prop_flushTBQueueEmpties_IOSim :: Bool+prop_flushTBQueueEmpties_IOSim =+  runSimOrThrow emptyTBQueueAfterFlush++emptyTBQueueAfterFlush :: MonadSTM m => m Bool+emptyTBQueueAfterFlush = do+  q <- newTBQueueIO 10+  atomically $ do+    writeTBQueue q (1 :: Int)+    writeTBQueue q 2+    _ <- flushTBQueue q+    isEmptyTBQueue q++-- | Test that 'flushTBQueue' returns values in FIFO order in `IO`.+prop_flushTBQueueOrder_IO :: [Int] -> Property+prop_flushTBQueueOrder_IO entries =+  ioProperty (writeAndFlushTBQueue entries >>= \actual -> pure $ actual === entries)++-- | Test that 'flushTBQueue' returns values in FIFO order in `IOSim`.+prop_flushTBQueueOrder_IOSim :: [Int] -> Property+prop_flushTBQueueOrder_IOSim entries =+  runSimOrThrow (writeAndFlushTBQueue entries) === entries++writeAndFlushTBQueue :: MonadSTM m => [Int] -> m [Int]+writeAndFlushTBQueue entries =+  atomically $ do+    q <- newTBQueue (1 + fromIntegral (length entries))+    forM_ entries $ writeTBQueue q+    flushTBQueue q  -- -- Utils