Commit 5a8a8a64 authored by Ben Gamari's avatar Ben Gamari 🐢

Don't allowInterrupt inside uninterruptibleMask

This fixes #9516.

Differential Revision: https://phabricator.haskell.org/D181Authored-by: Edsko de Vries's avatarEdsko de Vries <edsko@well-typed.com>
parent 24afe6d3
......@@ -234,6 +234,22 @@
call.
</para>
</listitem>
<listitem>
<para>
A new function, <literal>interruptible</literal>, was added
to <literal>GHC.IO</literal> allowing an
<literal>IO</literal> action to be run such that it can be
interrupted by an asynchronous exception, even if exceptions
are masked (except if masked with
<literal>interruptibleMask</literal>).
</para>
<para>
This was introduced to fix the behavior of
<literal>allowInterrupt</literal>, which would previously
incorrectly allow exceptions in uninterruptible regions
(see Trac #9516).
</para>
</listitem>
</itemizedlist>
</sect3>
......
......@@ -106,6 +106,7 @@ module Control.Exception (
uninterruptibleMask_,
MaskingState(..),
getMaskingState,
interruptible,
allowInterrupt,
-- *** Applying @mask@ to an exception handler
......@@ -134,7 +135,7 @@ module Control.Exception (
import Control.Exception.Base
import GHC.Base
import GHC.IO (unsafeUnmask)
import GHC.IO (interruptible)
-- | You need this when using 'catches'.
data Handler a = forall e . Exception e => Handler (e -> IO a)
......@@ -215,14 +216,14 @@ A typical use of 'tryJust' for recovery looks like this:
-- | When invoked inside 'mask', this function allows a masked
-- asynchronous exception to be raised, if one exists. It is
-- equivalent to performing an interruptible operation (see
-- #interruptible#), but does not involve any actual blocking.
-- #interruptible), but does not involve any actual blocking.
--
-- When called outside 'mask', or inside 'uninterruptibleMask', this
-- function has no effect.
--
-- @since 4.4.0.0
allowInterrupt :: IO ()
allowInterrupt = unsafeUnmask $ return ()
allowInterrupt = interruptible $ return ()
{- $async
......
......@@ -36,7 +36,7 @@ module GHC.IO (
catchException, catchAny, throwIO,
mask, mask_, uninterruptibleMask, uninterruptibleMask_,
MaskingState(..), getMaskingState,
unsafeUnmask,
unsafeUnmask, interruptible,
onException, bracket, finally, evaluate
) where
......@@ -341,6 +341,22 @@ unblock = unsafeUnmask
unsafeUnmask :: IO a -> IO a
unsafeUnmask (IO io) = IO $ unmaskAsyncExceptions# io
-- | Allow asynchronous exceptions to be raised even inside 'mask', making
-- the operation interruptible (see the discussion of "Interruptible operations"
-- in 'Control.Exception').
--
-- When called outside 'mask', or inside 'uninterruptibleMask', this
-- function has no effect.
--
-- /Since: 4.8.2.0/
interruptible :: IO a -> IO a
interruptible act = do
st <- getMaskingState
case st of
Unmasked -> act
MaskedInterruptible -> unsafeUnmask act
MaskedUninterruptible -> act
blockUninterruptible :: IO a -> IO a
blockUninterruptible (IO io) = IO $ maskUninterruptible# io
......
......@@ -45,6 +45,9 @@
* Exported `GiveGCStats`, `DoCostCentres`, `DoHeapProfile`, `DoTrace`,
`RtsTime`, and `RtsNat` from `GHC.RTS.Flags`
* New function `GHC.IO.interruptible` used to correctly implement
`Control.Exception.allowInterrupt` (#9516)
## 4.8.1.0 *TBA*
* Bundled with GHC 7.10.2
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment