mirror of
https://github.com/barrucadu/dejafu.git
synced 2024-12-21 04:21:30 +03:00
59 lines
2.4 KiB
Haskell
59 lines
2.4 KiB
Haskell
module Cases.Refinement where
|
|
|
|
import Control.Concurrent.Classy.MVar
|
|
import Control.Monad (void)
|
|
import Test.DejaFu.Conc (ConcIO)
|
|
import Test.DejaFu.Refinement
|
|
import Test.HUnit.DejaFu (testProperty)
|
|
|
|
import Common
|
|
|
|
tests :: [Test]
|
|
tests = [ testGroup "MVar" mvarProps ]
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
mvar :: (MVar ConcIO Int -> ConcIO a) -> Sig (MVar ConcIO Int) (Maybe Int) (Maybe Int)
|
|
mvar e = Sig
|
|
{ initialise = maybe newEmptyMVar newMVar
|
|
, observe = const . tryTakeMVar
|
|
, interfere = \v mi -> tryTakeMVar v >> maybe (pure ()) (void . tryPutMVar v) mi
|
|
, expression = void . e
|
|
}
|
|
|
|
mvarProps :: [Test]
|
|
mvarProps = toTestList
|
|
[ testProperty "readMVar is idempotent when composed sequentially" $
|
|
mvar readMVar === mvar (\v -> readMVar v >> readMVar v)
|
|
|
|
, testProperty "readMVar is idempotent when composed concurrently" $
|
|
mvar readMVar === mvar (\v -> readMVar v ||| readMVar v)
|
|
|
|
, testProperty "readMVar is not equivalent to a take followed by a put" $
|
|
expectFailure $ mvar readMVar === mvar (\v -> takeMVar v >>= putMVar v)
|
|
|
|
, testProperty "readMVar is a strict refinement of a take followed by a put" $
|
|
mvar readMVar ->- mvar (\v -> takeMVar v >>= putMVar v)
|
|
|
|
, testProperty "takeMVar is equivalent to a read followed by a take" $
|
|
mvar takeMVar === mvar (\v -> readMVar v >> takeMVar v)
|
|
|
|
, testProperty "takeMVar is not equivalent to a read concurrently composed with a take" $
|
|
expectFailure $ mvar takeMVar === mvar (\v -> readMVar v ||| takeMVar v)
|
|
|
|
, testProperty "takeMVar is a strict refinement of a read concurrently composed with a take" $
|
|
mvar takeMVar ->- mvar (\v -> readMVar v ||| takeMVar v)
|
|
|
|
, testProperty "putMVar is not equivalent to a put followed by a read" $
|
|
\x -> expectFailure $ mvar (\v -> putMVar v x) === mvar (\v -> putMVar v x >> readMVar v)
|
|
|
|
, testProperty "putMVar is a strict refinement of a put followed by a read" $
|
|
\x -> mvar (\v -> putMVar v x) ->- mvar (\v -> putMVar v x >> readMVar v)
|
|
|
|
, testProperty "putMVar is not equivalent to a put concurrently composed with a read" $
|
|
\x -> expectFailure $ mvar (\v -> putMVar v x) === mvar (\v -> putMVar v x ||| readMVar v)
|
|
|
|
, testProperty "putMVar is a strict refinement of a put concurrently composed with a read" $
|
|
\x -> mvar (\v -> putMVar v x) ->- mvar (\v -> putMVar v x ||| readMVar v)
|
|
]
|