#8684: hWaitForInput cannot be interrupted by async exceptions on unix -------------------------------------+------------------------------------ Reporter: nh2 | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: libraries/base | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Unknown/Multiple Type of failure: None/Unknown | Difficulty: Unknown Test Case: | Blocked By: Blocking: | Related Tickets: -------------------------------------+------------------------------------ Comment (by lnandor): I have tried to fix the bug by replacing select with pselect to ignore the SIGVTALRM signal sent by the runtime, but to properly terminate when SIGPIPE is received. [https://github.com/nandor/packages-base/compare/fix-8684?expand=1] {{{ diff --git a/GHC/IO/FD.hs b/GHC/IO/FD.hs index 2023526..0b0b1de 100644 --- a/GHC/IO/FD.hs +++ b/GHC/IO/FD.hs @@ -3,6 +3,7 @@ , NoImplicitPrelude , BangPatterns , DeriveDataTypeable + , InterruptibleFFI #-} {-# OPTIONS_GHC -fno-warn-identities #-} -- Whether there are identities depends on the platform @@ -395,7 +396,7 @@ setNonBlockingMode fd set = do ready :: FD -> Bool -> Int -> IO Bool ready fd write msecs = do - r <- throwErrnoIfMinus1Retry "GHC.IO.FD.ready" $ + r <- throwErrnoIfMinus1 "GHC.IO.FD.ready" $ fdReady (fdFD fd) (fromIntegral $ fromEnum $ write) (fromIntegral msecs) #if defined(mingw32_HOST_OS) @@ -405,7 +406,7 @@ ready fd write msecs = do #endif return (toEnum (fromIntegral r)) -foreign import ccall safe "fdReady" +foreign import ccall interruptible "fdReady" fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt -- --------------------------------------------------------------------------- @@ -502,7 +503,7 @@ indicates that there's no data, we call threadWaitRead. readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int readRawBufferPtr loc !fd buf off len | isNonBlocking fd = unsafe_read -- unsafe is ok, it can't block - | otherwise = do r <- throwErrnoIfMinus1 loc + | otherwise = do r <- throwErrnoIfMinus1Retry loc (unsafe_fdReady (fdFD fd) 0 0 0) if r /= 0 then read diff --git a/GHC/IO/Handle/Text.hs b/GHC/IO/Handle/Text.hs index f182e7f..31f2cac 100644 --- a/GHC/IO/Handle/Text.hs +++ b/GHC/IO/Handle/Text.hs @@ -106,7 +106,6 @@ hWaitForInput h msecs = do writeIORef haCharBuffer cbuf' if not (isEmptyBuffer cbuf') then return True else do - r <- IODevice.ready haDevice False{-read-} msecs if r then do -- Call hLookAhead' to throw an EOF -- exception if appropriate diff --git a/cbits/inputReady.c b/cbits/inputReady.c index 51f278f..9d51750 100644 --- a/cbits/inputReady.c +++ b/cbits/inputReady.c @@ -22,9 +22,10 @@ fdReady(int fd, int write, int msecs, int isSock) #else ( 1 ) { #endif - int maxfd, ready; + int maxfd; fd_set rfd, wfd; - struct timeval tv; + struct timespec tv; + sigset_t set; FD_ZERO(&rfd); FD_ZERO(&wfd); @@ -39,16 +40,14 @@ fdReady(int fd, int write, int msecs, int isSock) */ maxfd = fd + 1; tv.tv_sec = msecs / 1000; - tv.tv_usec = (msecs % 1000) * 1000; + tv.tv_nsec = (msecs % 1000) * 1000000; - while ((ready = select(maxfd, &rfd, &wfd, NULL, &tv)) < 0 ) { - if (errno != EINTR ) { - return -1; - } - } + /* Block SIGVTALRM */ + sigprocmask(SIG_BLOCK, NULL, &set); + sigaddset(&set, SIGVTALRM); /* 1 => Input ready, 0 => not ready, -1 => error */ - return (ready); + return pselect(maxfd, &rfd, &wfd, NULL, &tv, &set); } #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) else { }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8684#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler