#5238: throwSTM+catchSTM pollutes the masking state
-----------------------------------+----------------------------------------
Reporter: mikhail.vorozhtsov | Owner:
Type: bug | Status: new
Priority: normal | Component: Runtime System
Version: 7.1 | Keywords: stm
Testcase: | Blockedby:
Os: Unknown/Multiple | Blocking:
Architecture: Unknown/Multiple | Failure: None/Unknown
-----------------------------------+----------------------------------------
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)"
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/5238>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
