threadWaitReadSTM does not provide a way to unregister action.
In non-threaded RTS or on windows RTS does not return meaningful unregister action:
threadWaitWriteSTM :: Fd -> IO (Sync.STM (), IO ())
threadWaitWriteSTM fd
#ifndef mingw32_HOST_OS
| threaded = Event.threadWaitWriteSTM fd
#endif
| otherwise = do
m <- Sync.newTVarIO False
_ <- 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 ()
return (waitAction, killAction)
As a result in case if data will never arrive, helper thread will never be deallocated. This may lead to a memory leaks in some cases, see https://github.com/lpeterse/haskell-socket/issues/27 for details.
Minimal testcase is:
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
Expected output will be True, True, True, but non-threaded runtime gives True, False, True
Trac metadata
Trac field | Value |
---|---|
Version | 8.0.1 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Core Libraries |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | ekmett |
Operating system | |
Architecture |