Raise exceptions when blocked in bad FDs (fixes Trac #4934)

Before the patch any call to 'select()' with 'bad_fd' led to:
- unblocking of all threads
- hiding exception for 'threadWaitRead bad_fd'

The patch fixes both cases in this way:
after 'select()' failure we iterate over each blocked descriptor
and poll individually to see it's actual status, which is:
- READY (move to run queue)
- BLOCKED (leave in blocked queue)
- INVALID (send an IOErrror exception)

Signed-off-by: Sergei Trofimovich <slyfox@gentoo.org>

1 files changed, 5 insertions, 1 deletions

diff --git a/libraries/base/GHC/Event/Thread.hs b/libraries/base/GHC/Event/Thread.hs
index c599047db6..6e991bfb6c 100644
--- a/libraries/base/GHC/Event/Thread.hs
+++ b/libraries/base/GHC/Event/Thread.hs
@@ -12,9 +12,10 @@ module GHC.Event.Thread
     , closeFdWith
     , threadDelay
     , registerDelay
+    , blockedOnBadFD -- used by RTS
     ) where
 
-import Control.Exception (finally)
+import Control.Exception (finally, SomeException, toException)
 import Control.Monad (forM, forM_, sequence_, zipWithM, when)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Data.List (zipWith3)
@@ -115,6 +116,9 @@ threadWait evt fd = mask_ $ do
     then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing
     else return ()
 
+-- used at least by RTS in 'select()' IO manager backend
+blockedOnBadFD :: SomeException
+blockedOnBadFD = toException $ errnoToIOError "awaitEvent" eBADF Nothing Nothing
 
 threadWaitSTM :: Event -> Fd -> IO (STM (), IO ())
 threadWaitSTM evt fd = mask_ $ do