writeChan is not 100% exception-safe

Control.Concurrent.Chan.writeChan is currently implemented like this:

writeChan :: Chan a -> a -> IO ()
writeChan (Chan _ writeVar) val = do
  new_hole <- newEmptyMVar
  modifyMVar_ writeVar $ \old_hole -> do
    putMVar old_hole (ChItem val new_hole)
    return new_hole

The problem is that modifyMVar_ restores the exception mask when it calls the callback. If an asynchronous exception is delivered immediately after the putMVar, the Chan's write end will be set to a filled hole, violating a key invariant.

I think it should be implemented like this:

writeChan :: Chan a -> a -> IO ()
writeChan (Chan _ writeVar) val = do
  new_hole <- newEmptyMVar
  mask_ $ do
    old_hole <- takeMVar writeVar           -- (1)
    putMVar old_hole (ChItem val new_hole)  -- (2)
    putMVar writeVar new_hole               -- (3)

This looks a bit naïve, but it should be atomic, at least in theory:

• (1) is interruptible. However, if it is interrupted, the MVar will remain intact.
• (2) is not interruptible, because old_hole is guaranteed to be empty. No other thread can fill it because we have taken exclusive access to writeVar.
• (3) is not interruptible, because we have taken exclusive access to writeVar.

This implementation has the added benefit of removing an exception handler, which should make it slightly faster.

readChan is okay, though:

readChan :: Chan a -> IO a
readChan (Chan readVar _) = do
  modifyMVar readVar $ \read_end -> do
    (ChItem val new_read_end) <- readMVar read_end
    return (new_read_end, val)

If an exception is received immediately after the readMVar, then the read cursor will not be advanced, and the next call to readChan will simply read from that position again. Unfortunately, we can't get rid of the exception handler like we did with writeChan, because readMVar read_end is interruptible.

The attached patch changes the implementation of writeChan to the one shown above, and adds a comment to the definition of Chan about the write end's empty-hole invariant. I believe all of the Chan operations preserve this invariant, even the deprecated unGetChan and isEmptyChan.

I have not been able to create a test case where writeChan is interrupted between filling the hole and updating the write cursor. Perhaps it doesn't actually happen in practice, or perhaps it is extremely rare. But by my understanding of the semantics:

mask $ \restore -> do
    thing1
    restore $ putMVar ...
    thing2

It is possible for an exception to arrive after the putMVar and before thing2.

Trac metadata

Trac field	Value
Version	7.4.1
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	libraries/base
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture