getChanContents BlockedIndefinitelyOnMVar on 7.10 RC1
All of the stanzas work on 7.8.3, but the middle one works incorrectly on 7.10:
module Main where
import Control.Concurrent.Chan
import Control.Monad
main = do
io <- newChan
let inp = [0] :: [Int]
mapM_ (writeChan io) inp
{-
-- WORKS:
outp <- getChanContents io
if 0 == head outp
then putStrLn "OK"
else error $ "Smoke test failed"
-}
-- BROKEN ON 7.10 (BlockedIndefinitelyOnMVar):
outp <- getChanContents io
if and (zipWith (==) inp outp)
then putStrLn "OK"
else error $ "Smoke test failed"
{-
-- WORKS:
forM_ inp $ \xIn-> do
xOut <- readChan io
unless (xIn == xOut) $
error $ "Smoke test failed"
-}
I first noticed the behavior in a Chan-like library I wrote, whose internals are completely different from Chan, but where the getChanContents is a copy-paste from Chan. So I assume it has something to do with unsafeInterleaveIO.
Trac metadata
| Trac field | Value |
|---|---|
| Version | 7.10.1-rc1 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | libraries/base |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | ekmett, hvr |
| Operating system | |
| Architecture |