[GHC] #12852: threadWaitReadSTM does not provide a way to unregister action.

[GHC]

#12852: threadWaitReadSTM does not provide a way to unregister action.
-------------------------------------+-------------------------------------
           Reporter:  qnikst         |             Owner:
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:
          Component:  Core           |           Version:  8.0.1
  Libraries                          |
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  None/Unknown
  Unknown/Multiple                   |
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 In non-threaded RTS or on windows RTS does not return meaningful
 unregister action:

 {{{#!hs
 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:
 {{{#!hs
 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

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/12852>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler