Deadlock in Chan module
The following program:
module Main where
import Control.Concurrent
main :: IO ()
main = do
todo <- newChan
forkIO $ readChan todo
putStrLn "Before isEmptyChan"
b <- isEmptyChan todo
putStrLn "After isEmptyChan"
writeChan todo ()
Gives the output:
$ ghc --make Main.hs -threaded && ./Main.exe
Before isEmptyChan
Main.exe: thread blocked indefinitely in an MVar operation
I think that's a bug. Note that if the putStrLn
statements are removed then it works, but I think that's because the printing introduces a delay that lets the other thread run.
No child items are currently assigned. Use child items to break down this issue into smaller parts.
Link issues together to show that they're related or that one is blocking others. Learn more.
Activity
- Simon Marlow mentioned in issue #3527 (closed)
mentioned in issue #3527 (closed)
- Leon P Smith mentioned in issue #4001 (closed)
mentioned in issue #4001 (closed)
- Neil Mitchell changed weight to 5
changed weight to 5
- Neil Mitchell added Tbug Trac import core libraries labels
added Tbug Trac import core libraries labels
- Simon Marlow changed weight to 7
changed weight to 7
- Developer
I can't see a way to fix this in the implementation of
Chan
while retaining the properties and the other operations it has. The problem is thatreadChan
holds empty the read end of theChan
, butisEmptyChan
andunGetChan
(see #3527 (closed)) also need to take the read end, so they deadlock if there is a blocked reader on an emptyChan
.My suggestion is to deprecate both
isEmptyChan
andunGetChan
, with a message explaining the problem and directing people toTChan
instead.TChan
works, but lacks the fairness property ofChan
, and is probably only suitable when you have a small number of readers. We could make anMVar
version with similar properties, but it wouldn't perform any better thanTChan
and wouldn't be composable, so this seems the best compromise:-
Chan
has fairness, single-wakeup (good for multiple readers) -
TChan
hasisEmptyChan
andunGetChan
Trac metadata
Trac field Value Priority normal → high Operating system Windows → Unknown/Multiple -
- Simon Marlow mentioned in commit aae6f867
mentioned in commit aae6f867
- SamAnklesaria assigned to @trac-SamAnklesaria
assigned to @trac-SamAnklesaria
- SamAnklesaria unassigned @trac-SamAnklesaria
unassigned @trac-SamAnklesaria
- Simon Marlow closed
closed
- Developer
Fixed by deprecating
isEmptyChan
andunGetChan
(see above).Trac metadata
Trac field Value Resolution Unresolved → ResolvedFixed The only case where I have been using
isEmptyChan
was in my version of non-blockingreadChan
, returning Maybe. Is it possible to define instead ofisEmptyChan
some non-blocking version ofreadChan
withtryTakeMVar
andtryPutMVar
?- mitar mentioned in issue #4535 (closed)
mentioned in issue #4535 (closed)
I would also like a non-blocking readChan, and while tryTakeMVar seems like the right solution for that, from reading this report it seems that isEmptyChan will not cause a deadlock in this case, because no one is reading the Chan (unless you have multiple readers).
- Maintainer
It's been 7 years since
isEmptyChan
andunGetChan
was deprecated (first release with deprecation seems to be 7.0). Should we delete them now? - Ben Gamari mentioned in issue #13561 (closed)
mentioned in issue #13561 (closed)
- Ben Gamari changed the description
changed the description
- Ben Gamari changed milestone to %8.4.1
changed milestone to %8.4.1
- Maintainer
Indeed, let's delete them for 8.4. I've opened #13561 (closed) to make sure we don't forget this.
What about my proposal:
The only case where I have been using
isEmptyChan
was in my version of non-blockingreadChan
, returning Maybe. Is it possible to define instead ofisEmptyChan
some non-blocking version ofreadChan
withtryTakeMVar
andtryPutMVar
?- Maintainer
Replying to [ticket:4154#comment:135105 mitar]:
What about my proposal:
The only case where I have been using
isEmptyChan
was in my version of non-blockingreadChan
, returning Maybe. Is it possible to define instead ofisEmptyChan
some non-blocking version ofreadChan
withtryTakeMVar
andtryPutMVar
?Out of curiosity, why not move to STM if you need these sorts of operations?
I think the proposal is fine (assuming it's possible to implement safely; I am not familiar with the implementation of
Chan
). Do you want to put together a patch? Not sure if I am able to do so either. :-(
- Maintainer
Is it possible to define instead of isEmptyChan some non-blocking version of readChan with tryTakeMVar and tryPutMVar?
I think this can't work. A
readChan
is actually twotakeMVar
s. Implementation oftryReadChan
has to usetryTakeMVar
s, otherwise you can't avoid being blocked in some cases.So these two MVars that need to be taken to be able to read something off a chan need to be taken with
tryReadChan
.First
tryTakeMVar
would only succeed if the queue is empty. The trouble is in the case where the chan has enough stuff but currently some other thread is busy actually reading the contents (and updating the read-end) you'd get aNothing
, even though if you actually doreadChan
you'd get blocked for a very short amount of time because chan has enough contents. So this implementation would returnNothing
in some cases when there is enough contents in the chan.Now suppose that you use
tryReadMVar
to read the read-end. Suppose that right after you read the read-end another thread doesreadChan
, and takes the read-end MVar. Now there's a race condition between your thread and the other thread. The loser needs to re-take the read-end. Furthermore, if your thread was the only thread you can't update the read-end, because you didn't take it (remember that in this scenario we usetryReadMVar
instead oftryTakeMVar
).So neither
tryTakeMVar
nortryReadMVar
gives you a race-free implementation oftryReadChan
. I hope this makes sense.(Another problem with both implementations is that you have no guarantees that you'll be able to read the contents. For example if chan has enough contents but a million threads are running
readChan
in parallel you may not be able to read anything withtryReadChan
)MVar
-based implementation is cute but has this limitation. (it also doesn't scale as number of writers and readers increase) - trac-import added incorrect runtime result label
added incorrect runtime result label
- Ben Gamari added Phigh label
added Phigh label