getChar cannot be interrupted with -threaded
Now that stdin
, stdout
and stderr
are left in blocking mode, when using the threaded RTS, I/O operations on these handles are no longer interruptible. We ought to do something about this.
module Main where
import Control.Monad
import System.Posix.Signals
import Control.Concurrent
import Control.Concurrent.MVar
import System.IO
main = do
hSetBuffering stdin NoBuffering
hSetEcho stdin False
mv <- newEmptyMVar
let handler = putMVar mv Nothing
installHandler sigINT (CatchOnce handler) Nothing
tid <- forkIO (myGetChar mv)
c <- takeMVar mv
when (c==Nothing) $ do
killThread tid
putStrLn ("Result: " ++ show c)
myGetChar mv = do
c <- getChar
putMVar mv (Just c)
Trac metadata
Trac field | Value |
---|---|
Version | 6.8.2 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | high |
Resolution | Unresolved |
Component | libraries/base |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | Unknown |
Architecture | Unknown |