barrucadu/dejafu
1
1
Fork 0
mirror of https://github.com/barrucadu/dejafu.git synced 2024-12-18 19:11:37 +03:00
Code Issues Projects Releases Wiki Activity

Add tests for MonadFail exceptions

Browse Source
This commit is contained in:
Michael Walker 2017-08-21 16:22:49 +01:00
parent 2d4e28e308
commit 26bdb96b25
1 changed files with 11 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
dejafu-tests/Cases/SingleThreaded.hs
View File

@ -56,6 +56,8 @@ tests =
, testDejafu excSTM "from stm" $ gives' [True] , testDejafu excSTM "from stm" $ gives' [True]
, testDejafu excToMain1 "throw to main (uncaught)" $ gives [Left UncaughtException] , testDejafu excToMain1 "throw to main (uncaught)" $ gives [Left UncaughtException]
, testDejafu excToMain2 "throw to main (caught)" $ gives' [()] , testDejafu excToMain2 "throw to main (caught)" $ gives' [()]
, testDejafu excMFail "monadfail" $ gives [Left UncaughtException]
, testDejafu excMFailSTM "monadfail (stm)" $ gives [Left UncaughtException]
] ]
, testGroup "Capabilities" . hUnitTestToTests $ test , testGroup "Capabilities" . hUnitTestToTests $ test
@ -269,6 +271,15 @@ excToMain2 = do
tid <- myThreadId tid <- myThreadId
catchArithException (throwTo tid Overflow) (\_ -> pure ()) catchArithException (throwTo tid Overflow) (\_ -> pure ())
-- | Throw an exception using 'fail'. Using 'ConcT' directly to avoid
-- a 'MonadFail' constraint, which won't work with base < 4.9.
excMFail :: Monad n => ConcT r n (Either Failure ())
excMFail = fail "hello world"
-- | Throw an exception in an STM transaction using 'fail'.
excMFailSTM :: Monad n => ConcT r n (Either Failure ())
excMFailSTM = atomically $ fail "hello world"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Capabilities -- Capabilities