Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : ghc-7.4
http://hackage.haskell.org/trac/ghc/changeset/b24a3598764592ae341f3e90d7223ae04bce931b >--------------------------------------------------------------- commit b24a3598764592ae341f3e90d7223ae04bce931b Author: Joey Adams <[email protected]> Date: Sun Feb 12 16:08:07 2012 -0500 Sealed writeChan with mask_ to prevent a theoretical bug MERGED from commit 48df85c45e50d18a1e34f2db82a58e74dea6bbef >--------------------------------------------------------------- Control/Concurrent/Chan.hs | 18 +++++++++++++++--- 1 files changed, 15 insertions(+), 3 deletions(-) diff --git a/Control/Concurrent/Chan.hs b/Control/Concurrent/Chan.hs index 23b21bb..2b84503 100644 --- a/Control/Concurrent/Chan.hs +++ b/Control/Concurrent/Chan.hs @@ -40,6 +40,7 @@ import Prelude import System.IO.Unsafe ( unsafeInterleaveIO ) import Control.Concurrent.MVar +import Control.Exception (mask_) import Data.Typeable #include "Typeable.h" @@ -51,7 +52,7 @@ import Data.Typeable -- |'Chan' is an abstract type representing an unbounded FIFO channel. data Chan a = Chan (MVar (Stream a)) - (MVar (Stream a)) + (MVar (Stream a)) -- Invariant: the Stream a is always an empty MVar deriving Eq INSTANCE_TYPEABLE1(Chan,chanTc,"Chan") @@ -83,9 +84,20 @@ newChan = do writeChan :: Chan a -> a -> IO () writeChan (Chan _ writeVar) val = do new_hole <- newEmptyMVar - modifyMVar_ writeVar $ \old_hole -> do + mask_ $ do + old_hole <- takeMVar writeVar putMVar old_hole (ChItem val new_hole) - return new_hole + putMVar writeVar new_hole + +-- The reason we don't simply do this: +-- +-- modifyMVar_ writeVar $ \old_hole -> do +-- putMVar old_hole (ChItem val new_hole) +-- return new_hole +-- +-- is because if an asynchronous exception is received after the 'putMVar' +-- completes and before modifyMVar_ installs the new value, it will set the +-- Chan's write end to a filled hole. -- |Read the next value from the 'Chan'. readChan :: Chan a -> IO a _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
