projects
/
lsp-test.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Include ignoreSigPipe to avoid hangs
[lsp-test.git]
/
src
/
Language
/
Haskell
/
LSP
/
Test
/
Compat.hs
diff --git
a/src/Language/Haskell/LSP/Test/Compat.hs
b/src/Language/Haskell/LSP/Test/Compat.hs
index a68f74158bb95baa85d5965556eecaf5689c1044..87b7dc9ca9737cb5e2731722c110f6b0c8a76b41 100644
(file)
--- a/
src/Language/Haskell/LSP/Test/Compat.hs
+++ b/
src/Language/Haskell/LSP/Test/Compat.hs
@@
-9,17
+9,27
@@
import Data.Maybe
import System.IO
#if MIN_VERSION_process(1,6,3)
import System.IO
#if MIN_VERSION_process(1,6,3)
-# if MIN_VERSION_process(1,6,4)
+-- We have to hide cleanupProcess for process-1.6.3.0
+-- cause it is in the public api for 1.6.3.0 versions
+-- shipped with ghc >= 8.6 and < 8.6.4
import System.Process hiding (getPid, cleanupProcess)
import System.Process hiding (getPid, cleanupProcess)
+# if MIN_VERSION_process(1,6,4)
import qualified System.Process (getPid, cleanupProcess)
# else
import qualified System.Process (getPid, cleanupProcess)
# else
-import System.Process hiding (getPid)
+import Foreign.C.Error
+import GHC.IO.Exception ( IOErrorType(..), IOException(..) )
+
import qualified System.Process (getPid)
import qualified System.Process (getPid)
+import qualified Control.Exception as C
# endif
#else
# endif
#else
+import Control.Concurrent.MVar
+import Foreign.C.Error
+import GHC.IO.Exception ( IOErrorType(..), IOException(..) )
import System.Process
import System.Process.Internals
import System.Process
import System.Process.Internals
-import Control.Concurrent.MVar
+
+import qualified Control.Exception as C
#endif
#ifdef mingw32_HOST_OS
#endif
#ifdef mingw32_HOST_OS
@@
-73,9
+83,16
@@
cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do
-- Note, it's important that other threads that might be reading/writing
-- these handles also get killed off, since otherwise they might be holding
-- the handle lock and prevent us from closing, leading to deadlock.
-- Note, it's important that other threads that might be reading/writing
-- these handles also get killed off, since otherwise they might be holding
-- the handle lock and prevent us from closing, leading to deadlock.
- maybe (return ())
hClose
mb_stdin
+ maybe (return ())
(ignoreSigPipe . hClose)
mb_stdin
maybe (return ()) hClose mb_stdout
maybe (return ()) hClose mb_stderr
return ()
maybe (return ()) hClose mb_stdout
maybe (return ()) hClose mb_stderr
return ()
+
+ignoreSigPipe :: IO () -> IO ()
+ignoreSigPipe = C.handle $ \e -> case e of
+ IOError { ioe_type = ResourceVanished
+ , ioe_errno = Just ioe }
+ | Errno ioe == ePIPE -> return ()
+ _ -> C.throwIO e
#endif
#endif