barrucadu/dejafu
1
1
Fork 0
mirror of https://github.com/barrucadu/dejafu.git synced 2024-12-28 08:03:51 +03:00
Code Issues Projects Releases Wiki Activity

Fix some dejafu-tests warnings

Browse Source
This commit is contained in:
Michael Walker 2018-03-17 18:43:04 +00:00
parent 8f0d3394e1
commit b74661559b
5 changed files with 10 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
dejafu-tests/lib/Common.hs
View File

@ -126,7 +126,7 @@ prop_dep_fun conc = H.property $ do
let tids2 = toTIdTrace trc2
pure (efa1, map fst tids1, efa2, map fst tids2)
play memtype conc s g = runConcurrent s memtype g conc
play memtype c s g = runConcurrent s memtype g c
-------------------------------------------------------------------------------
-- Exceptions

6
dejafu-tests/lib/Integration/MultiThreaded.hs
View File

@ -306,11 +306,11 @@ hacksTests = toTestList
takeMVar out
, djfuT "Thread IDs are consistent between the inner action and the outside" (sometimesFailsWith isUncaughtException) $ do
(tid, trigger) <- dontCheck Nothing $ do
trigger <- dontCheck Nothing $ do
me <- myThreadId
v <- newEmptyMVar
t <- fork $ takeMVar v >> killThread me
pure (t, v)
_ <- fork $ takeMVar v >> killThread me
pure v
putMVar trigger ()
, djfuT "Inner action is run under sequential consistency" (gives' [1]) $ do

5
dejafu-tests/lib/Integration/SCT.hs
View File

@ -31,7 +31,7 @@ discardTests = toTestList
const (Just DiscardResultAndTrace)
, check "Results failing the test are not present" [1, 2] $
\x -> if x == Right 3 then Just DiscardResultAndTrace else Nothing
, testCase "No traces kept when they get discared" $ testDiscardTrace discarder testAction
, testCase "No traces kept when they get discared" $ testDiscardTrace testAction
]
where
check name xs f = testDejafuWithSettings (set ldiscard (Just f) defaultSettings) name (gives' xs) testAction
@ -41,11 +41,12 @@ discardTests = toTestList
_ <- fork $ putMVar mvar 2
_ <- fork $ putMVar mvar 3
readMVar mvar
discarder (Right 2) = Just DiscardTrace
discarder (Right 3) = Just DiscardResultAndTrace
discarder _ = Nothing
testDiscardTrace discarder action = do
testDiscardTrace action = do
results <- runSCTWithSettings (set ldiscard (Just discarder) defaultSettings) action
for_ results $ \(efa, trace) -> case discarder efa of
Just DiscardResultAndTrace -> assertFailure "expected result to be discarded"

6
dejafu-tests/lib/Integration/SingleThreaded.hs
View File

@ -288,7 +288,7 @@ hacksTests = toTestList
, snapshotTest "Lifted IO is re-run (1)" (gives' [2..151]) $ do
r <- dontCheck Nothing $ do
r <- liftIO (IORef.newIORef 0)
r <- liftIO (IORef.newIORef (0::Int))
liftIO (IORef.modifyIORef r (+1))
pure r
liftIO (IORef.readIORef r)
@ -296,14 +296,14 @@ hacksTests = toTestList
, snapshotTest "Lifted IO is re-run (2)" (gives' [1]) $ do
r <- dontCheck Nothing $ do
let modify r f = liftIO (IORef.readIORef r) >>= liftIO . IORef.writeIORef r . f
r <- liftIO (IORef.newIORef 0)
r <- liftIO (IORef.newIORef (0::Int))
modify r (+1)
pure r
liftIO (IORef.readIORef r)
, snapshotTest "Lifted IO is re-run (3)" (gives' [1]) $ do
r <- dontCheck Nothing $ do
r <- liftIO (IORef.newIORef 0)
r <- liftIO (IORef.newIORef (0::Int))
liftIO (IORef.writeIORef r 0)
liftIO (IORef.modifyIORef r (+1))
pure r

1
dejafu-tests/lib/Unit/Properties.hs
View File

@ -5,7 +5,6 @@ import qualified Control.Exception as E
import Control.Monad (zipWithM)
import qualified Control.Monad.Conc.Class as C
import Control.Monad.IO.Class (liftIO)
import qualified Control.Monad.ST as ST
import qualified Data.Foldable as F
import qualified Data.Map as M
import qualified Data.Sequence as S