strict-mvar 1.1.0.0 → 1.2.0.0
raw patch · 6 files changed
+242/−18 lines, 6 filesdep +QuickCheckdep +io-simdep +nothunksdep ~io-classesPVP ok
version bump matches the API change (PVP)
Dependencies added: QuickCheck, io-sim, nothunks, strict-mvar, tasty, tasty-quickcheck
Dependency ranges changed: io-classes
API changes (from Hackage documentation)
+ Control.Concurrent.Class.MonadMVar.Strict: type LazyMVar m = MVar m
Files
- CHANGELOG.md +14/−0
- src/Control/Concurrent/Class/MonadMVar/Strict.hs +2/−2
- strict-mvar.cabal +31/−16
- test/Main.hs +9/−0
- test/Test/Control/Concurrent/Class/MonadMVar/Strict/WHNF.hs +163/−0
- test/Test/Utils.hs +23/−0
CHANGELOG.md view
@@ -1,5 +1,19 @@ # Revsion history of strict-mvar +## 1.2.0.0++### Breaking changes++* Remove the `asserts` package flag.++### Non-breaking changes++* Export `LazyMVar`.++### Patch++* Update cabal header fields like `author` and `category`.+ ## 1.1.0.0 ### Non breaking changes
src/Control/Concurrent/Class/MonadMVar/Strict.hs view
@@ -2,11 +2,11 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} --- | This module corresponds to 'Control.Concurrent.MVar' in "base" package---+-- | This module corresponds to "Control.Concurrent.MVar" in the @base@ package. module Control.Concurrent.Class.MonadMVar.Strict ( -- * StrictMVar StrictMVar+ , LazyMVar , castStrictMVar , toLazyMVar , fromLazyMVar
strict-mvar.cabal view
@@ -1,22 +1,20 @@ cabal-version: 3.0 name: strict-mvar-version: 1.1.0.0+version: 1.2.0.0 synopsis: Strict MVars for IO and IOSim description: Strict @MVar@ interface compatible with [IO](https://hackage.haskell.org/package/base-4.18.0.0/docs/Prelude.html#t:IO) & [io-sim](https://hackage.haskell.org/package/io-sim). license: Apache-2.0-license-files:- LICENSE- NOTICE+license-files: LICENSE NOTICE copyright: 2019-2023 Input Output Global Inc (IOG).-author: IOHK Engineering Team+author: IOG Engineering Team maintainer: operations@iohk.io-category: Control+category: Concurrency build-type: Simple-extra-source-files: CHANGELOG.md- README.md+extra-doc-files: CHANGELOG.md README.md+bug-reports: https://github.com/input-output-hk/io-sim/issues tested-with: GHC == { 8.10, 9.2, 9.4, 9.6 } source-repository head@@ -24,18 +22,13 @@ location: https://github.com/input-output-hk/io-sim subdir: strict-mvar -flag asserts- description: Enable assertions- manual: False- default: False- library hs-source-dirs: src exposed-modules: Control.Concurrent.Class.MonadMVar.Strict default-language: Haskell2010 build-depends: base >= 4.9 && <4.19,- io-classes >= 1.0 && <1.2+ io-classes ^>= 1.2, ghc-options: -Wall -Wno-unticked-promoted-constructors -Wcompat@@ -44,5 +37,27 @@ -Wpartial-fields -Widentities - if flag(asserts)- ghc-options: -fno-ignore-asserts+test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs++ other-modules: Test.Control.Concurrent.Class.MonadMVar.Strict.WHNF+ Test.Utils+ default-language: Haskell2010+ build-depends: base >=4.9 && <4.19,+ io-sim,+ nothunks,+ QuickCheck,+ tasty,+ tasty-quickcheck,+ strict-mvar,++ ghc-options: -Wall+ -Wno-unticked-promoted-constructors+ -Wcompat+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wpartial-fields+ -Widentities+ -fno-ignore-asserts
+ test/Main.hs view
@@ -0,0 +1,9 @@+module Main where++import qualified Test.Control.Concurrent.Class.MonadMVar.Strict.WHNF as WHNF+import Test.Tasty++main :: IO ()+main = defaultMain $ testGroup "strict-mvar" [+ WHNF.tests+ ]
+ test/Test/Control/Concurrent/Class/MonadMVar/Strict/WHNF.hs view
@@ -0,0 +1,163 @@+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Use camelCase" #-}++-- | Test whether functions on 'StrictMVar's correctly force values to WHNF+-- before they are put inside the 'StrictMVar'.+module Test.Control.Concurrent.Class.MonadMVar.Strict.WHNF (tests) where++import Control.Concurrent.Class.MonadMVar.Strict+import Control.Monad (void)+import Data.Typeable (Typeable)+import NoThunks.Class (OnlyCheckWhnf (OnlyCheckWhnf), unsafeNoThunks)+import Test.QuickCheck.Monadic (PropertyM, monadicIO, monitor, run)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.QuickCheck (Fun, applyFun, counterexample,+ testProperty)+import Test.Utils (monadicSim)++{-------------------------------------------------------------------------------+ Main test tree+-------------------------------------------------------------------------------}++tests :: TestTree+tests = testGroup "Test.Control.Concurrent.Class.MonadMVar.Strict" [+ testGroup "WHNF" [+ testGroup "IO" [+ testProperty "prop_newMVar" $+ monadicIO .: prop_newMVar+ , testProperty "prop_putMVar" $+ monadicIO .: prop_putMVar+ , testProperty "prop_swapMVar" $+ monadicIO .: prop_swapMVar+ , testProperty "prop_tryPutMVar" $+ monadicIO .: prop_tryPutMVar+ , testProperty "prop_modifyMVar_" $+ monadicIO .: prop_modifyMVar_+ , testProperty "prop_modifyMVar" $+ monadicIO .: prop_modifyMVar+ , testProperty "prop_modifyMVarMasked_" $+ monadicIO .: prop_modifyMVarMasked_+ , testProperty "prop_modifyMVarMasked" $+ monadicIO .: prop_modifyMVarMasked+ ]+ , testGroup "IOSim" [+ testProperty "prop_newMVar" $ \x f ->+ monadicSim $ prop_newMVar x f+ , testProperty "prop_putMVar" $ \x f ->+ monadicSim $ prop_putMVar x f+ , testProperty "prop_swapMVar" $ \x f ->+ monadicSim $ prop_swapMVar x f+ , testProperty "prop_tryPutMVar" $ \x f ->+ monadicSim $ prop_tryPutMVar x f+ , testProperty "prop_modifyMVar_" $ \x f ->+ monadicSim $ prop_modifyMVar_ x f+ , testProperty "prop_modifyMVar" $ \x f ->+ monadicSim $ prop_modifyMVar x f+ , testProperty "prop_modifyMVarMasked_" $ \x f ->+ monadicSim $ prop_modifyMVarMasked_ x f+ , testProperty "prop_modifyMVarMasked" $ \x f ->+ monadicSim $ prop_modifyMVarMasked x f+ ]+ ]+ ]++{-------------------------------------------------------------------------------+ Utilities+-------------------------------------------------------------------------------}++infixr 9 .:++(.:) :: (y -> z) -> (x0 -> x1 -> y) -> (x0 -> x1 -> z)+(.:) g f x0 x1 = g (f x0 x1)++isInWHNF :: (MonadMVar m, Typeable a) => StrictMVar m a -> PropertyM m Bool+isInWHNF v = do+ x <- run $ readMVar v+ case unsafeNoThunks (OnlyCheckWhnf x) of+ Nothing -> pure True+ Just tinfo -> monitor (counterexample $ "Not in WHNF: " ++ show tinfo)+ >> pure False++{-------------------------------------------------------------------------------+ Properties+-------------------------------------------------------------------------------}++prop_newMVar ::+ MonadMVar m+ => Int+ -> Fun Int Int+ -> PropertyM m Bool+prop_newMVar x f = do+ v <- run $ newMVar (applyFun f x)+ isInWHNF v++prop_putMVar ::+ MonadMVar m+ => Int+ -> Fun Int Int+ -> PropertyM m Bool+prop_putMVar x f = do+ v <- run newEmptyMVar+ run $ putMVar v (applyFun f x)+ isInWHNF v++prop_swapMVar ::+ MonadMVar m+ => Int+ -> Fun Int Int+ -> PropertyM m Bool+prop_swapMVar x f = do+ v <- run $ newMVar x+ void $ run $ swapMVar v (applyFun f x)+ isInWHNF v++prop_tryPutMVar ::+ MonadMVar m+ => Int+ -> Fun Int Int+ -> PropertyM m Bool+prop_tryPutMVar x f = do+ v <- run newEmptyMVar+ b <- run $ tryPutMVar v (applyFun f x)+ b' <- isInWHNF v+ pure (b && b')++prop_modifyMVar_ ::+ MonadMVar m+ => Int+ -> Fun Int Int+ -> PropertyM m Bool+prop_modifyMVar_ x f =do+ v <- run $ newMVar x+ run $ modifyMVar_ v (pure . applyFun f)+ isInWHNF v++prop_modifyMVar ::+ MonadMVar m+ => Int+ -> Fun Int (Int, Char)+ -> PropertyM m Bool+prop_modifyMVar x f =do+ v <- run $ newMVar x+ void $ run $ modifyMVar v (pure . applyFun f)+ isInWHNF v++prop_modifyMVarMasked_ ::+ MonadMVar m+ => Int+ -> Fun Int Int+ -> PropertyM m Bool+prop_modifyMVarMasked_ x f =do+ v <- run $ newMVar x+ void $ run $ modifyMVarMasked_ v (pure . applyFun f)+ isInWHNF v++prop_modifyMVarMasked ::+ MonadMVar m+ => Int+ -> Fun Int (Int, Char)+ -> PropertyM m Bool+prop_modifyMVarMasked x f =do+ v <- run $ newMVar x+ void $ run $ modifyMVarMasked v (pure . applyFun f)+ isInWHNF v
+ test/Test/Utils.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE RankNTypes #-}++module Test.Utils+ ( runSimGen+ , monadicSim+ ) where++import Control.Monad.IOSim (IOSim, runSimOrThrow)+import Test.QuickCheck (Gen, Property, Testable (..))+import Test.QuickCheck.Gen.Unsafe (Capture (..), capture)+import Test.QuickCheck.Monadic (PropertyM, monadic')++{-------------------------------------------------------------------------------+ Property runners (copied from "Ouroboros.Network.Testing.QuickCheck")+-------------------------------------------------------------------------------}++runSimGen :: (forall s. Gen (IOSim s a)) -> Gen a+runSimGen f = do+ Capture eval <- capture+ return $ runSimOrThrow (eval f)++monadicSim :: Testable a => (forall s. PropertyM (IOSim s) a) -> Property+monadicSim m = property (runSimGen (monadic' m))