Repository : ssh://darcs.haskell.org//srv/darcs/packages/process On branch : master
http://hackage.haskell.org/trac/ghc/changeset/76fb4b7e8861dec8054723a3c794c73511d07bb2 >--------------------------------------------------------------- commit 76fb4b7e8861dec8054723a3c794c73511d07bb2 Author: Paolo Capriotti <[email protected]> Date: Thu May 10 13:41:37 2012 +0100 Ignore broken pipe error in readProcessWithExitCode (#4889) >--------------------------------------------------------------- System/Process.hs | 19 ++++++++++++++++--- tests/T4889.hs | 10 ++++++++++ tests/T4889.stdout | 2 ++ tests/all.T | 1 + 4 files changed, 29 insertions(+), 3 deletions(-) diff --git a/System/Process.hs b/System/Process.hs index 1acb308..51fba92 100644 --- a/System/Process.hs +++ b/System/Process.hs @@ -91,7 +91,7 @@ import System.Exit ( ExitCode(..) ) #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__ >= 611 -import GHC.IO.Exception ( ioException, IOErrorType(..) ) +import GHC.IO.Exception ( ioException, IOErrorType(..), IOException(..) ) #else import GHC.IOBase ( ioException, IOErrorType(..) ) #endif @@ -449,8 +449,21 @@ readProcessWithExitCode cmd args input = waitErr <- forkWait $ C.evaluate $ rnf err -- now write and flush any input - when (not (null input)) $ do hPutStr inh input; hFlush inh - hClose inh -- done with stdin + let writeInput = do + unless (null input) $ do + hPutStr inh input + hFlush inh + hClose inh + +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 611 + C.catch writeInput $ \e -> case e of + IOError { ioe_type = ResourceVanished + , ioe_errno = Just ioe } + | Errno ioe == ePIPE -> return () + _ -> throwIO e +#else + writeInput +#endif -- wait on the output waitOut diff --git a/tests/T4889.hs b/tests/T4889.hs new file mode 100644 index 0000000..d8feb47 --- /dev/null +++ b/tests/T4889.hs @@ -0,0 +1,10 @@ +module Main where + +import System.Process + +main :: IO () +main = do + let text = unlines . map show $ [1..10000 :: Int] + (code, out, _) <- readProcessWithExitCode "head" ["-n", "1"] text + print code + putStr out diff --git a/tests/T4889.stdout b/tests/T4889.stdout new file mode 100644 index 0000000..d72cac5 --- /dev/null +++ b/tests/T4889.stdout @@ -0,0 +1,2 @@ +ExitSuccess +1 diff --git a/tests/all.T b/tests/all.T index 7d25b17..5d53d0b 100644 --- a/tests/all.T +++ b/tests/all.T @@ -29,3 +29,4 @@ test('4198', ['']) test('3994', only_ways(['threaded1','threaded2']), compile_and_run, ['']) +test('T4889', normal, compile_and_run, ['']) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
