mirror of
https://github.com/barrucadu/dejafu.git
synced 2024-12-18 02:51:42 +03:00
Add tests for MonadFail exceptions
This commit is contained in:
parent
2d4e28e308
commit
26bdb96b25
@ -56,6 +56,8 @@ tests =
|
||||
, testDejafu excSTM "from stm" $ gives' [True]
|
||||
, testDejafu excToMain1 "throw to main (uncaught)" $ gives [Left UncaughtException]
|
||||
, testDejafu excToMain2 "throw to main (caught)" $ gives' [()]
|
||||
, testDejafu excMFail "monadfail" $ gives [Left UncaughtException]
|
||||
, testDejafu excMFailSTM "monadfail (stm)" $ gives [Left UncaughtException]
|
||||
]
|
||||
|
||||
, testGroup "Capabilities" . hUnitTestToTests $ test
|
||||
@ -269,6 +271,15 @@ excToMain2 = do
|
||||
tid <- myThreadId
|
||||
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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user