throwSTM+catchSTM pollutes the masking state
The following program prints "(Unmasked,MaskedUninterruptible)"
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Exception
import Control.Concurrent.STM
import GHC.Conc (STM(..))
import GHC.Prim (getMaskingState#)
getMaskingStateSTM = STM $ \s → case getMaskingState# s of
(# s', i #) -> (# s', case i of 0# → Unmasked
1# → MaskedUninterruptible
_ → MaskedInterruptible #)
main = do
mss ← atomically $ do
ms1 ← getMaskingStateSTM
(throwSTM Overflow) `catchSTM` (\(e ∷ SomeException) → return ())
ms2 ← getMaskingStateSTM
return (ms1, ms2)
putStrLn $ show mss
I would be nice to have (un)maskAsyncExceptions+retry supported too, currenly
maskSTM (STM stm) = STM $ maskAsyncExceptions# stm
main = do
mss ← atomically $ do
ms1 ← getMaskingStateSTM
maskSTM retry `orElse` return ()
ms2 ← getMaskingStateSTM
return (ms1, ms2)
putStrLn $ show mss
prints "(Unmasked,MaskedInterruptible)"
Trac metadata
Trac field | Value |
---|---|
Version | 7.1 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Runtime System |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |