Add tests for MonadFail exceptions

This commit is contained in:
Michael Walker 2017-08-21 16:22:49 +01:00
parent 2d4e28e308
commit 26bdb96b25

View File

@ -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