Commit f4302534 authored by Alexander Vershilov's avatar Alexander Vershilov Committed by Ben Gamari

Allow to unregister threadWaitReadSTM action.

Allow to unregister threadWaitReadSTM/threadWaitWriteSTM on
a non-threaded runtime. Previosly noop action was returned,
as a result it was not possible to unregister action, unless
data arrives to Fd or it's closed.

Fixes #12852.

Reviewers: simonmar, hvr, austin, bgamari, trofi

Reviewed By: bgamari, trofi

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2729

GHC Trac Issues: #12852
parent 1399c8b4
......@@ -119,18 +119,18 @@ threadWaitWrite fd
-- is an IO action that can be used to deregister interest
-- in the file descriptor.
threadWaitReadSTM :: Fd -> IO (Sync.STM (), IO ())
threadWaitReadSTM fd
threadWaitReadSTM fd
#ifndef mingw32_HOST_OS
| threaded = Event.threadWaitReadSTM fd
#endif
| otherwise = do
m <- Sync.newTVarIO False
_ <- Sync.forkIO $ do
t <- Sync.forkIO $ do
threadWaitRead fd
Sync.atomically $ Sync.writeTVar m True
let waitAction = do b <- Sync.readTVar m
if b then return () else retry
let killAction = return ()
let killAction = Sync.killThread t
return (waitAction, killAction)
-- | Returns an STM action that can be used to wait until data
......@@ -138,18 +138,18 @@ threadWaitReadSTM fd
-- is an IO action that can be used to deregister interest
-- in the file descriptor.
threadWaitWriteSTM :: Fd -> IO (Sync.STM (), IO ())
threadWaitWriteSTM fd
threadWaitWriteSTM fd
#ifndef mingw32_HOST_OS
| threaded = Event.threadWaitWriteSTM fd
#endif
| otherwise = do
m <- Sync.newTVarIO False
_ <- Sync.forkIO $ do
t <- Sync.forkIO $ do
threadWaitWrite fd
Sync.atomically $ Sync.writeTVar m True
let waitAction = do b <- Sync.readTVar m
if b then return () else retry
let killAction = return ()
let killAction = Sync.killThread t
return (waitAction, killAction)
-- | Close a file descriptor in a concurrency-safe way (GHC only). If
......
import GHC.Conc
import GHC.IO
import GHC.IO.FD as FD
import System.Posix.IO
import System.Posix.Types
main = do
(rfd,wfd) <- createPipe
(waitread, unregister) <- threadWaitReadSTM rfd
unregister
result0 <- atomically $ (fmap (const False) waitread) `orElse` return True
print result0
fdWrite wfd "test"
threadDelay 20000
result1 <- atomically $ (fmap (const False) waitread) `orElse` return True
print result1
(waitread1, _) <- threadWaitReadSTM rfd
threadDelay 20000
result2 <- atomically $ (fmap (const True) waitread1) `orElse` return False
print result2
......@@ -205,3 +205,4 @@ test('T9848',
test('T10149', normal, compile_and_run, [''])
test('T11334a', normal, compile_and_run, [''])
test('T11555', normal, compile_and_run, [''])
test('T12852', when(opsys('mingw32'), skip), compile_and_run, [''])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment