[commit: packages/process] master: Add check for binary handles (68abdc2)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/process

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/68abdc2af6272c3d8531ba26482d6b38052d7d33/process

>---------------------------------------------------------------

commit 68abdc2af6272c3d8531ba26482d6b38052d7d33
Author: Michael Snoyman <michael at snoyman.com>
Date:   Tue Jun 14 16:37:39 2016 +0300

    Add check for binary handles


>---------------------------------------------------------------

68abdc2af6272c3d8531ba26482d6b38052d7d33
 process.cabal |  2 ++
 test/main.hs  | 26 ++++++++++++++++++++++++++
 2 files changed, 28 insertions(+)

diff --git a/process.cabal b/process.cabal
index 15f6a65..3c51883 100644
--- a/process.cabal
+++ b/process.cabal
@@ -77,4 +77,6 @@ test-suite test
   main-is: main.hs
   type: exitcode-stdio-1.0
   build-depends: base
+               , bytestring
+               , directory
                , process
diff --git a/test/main.hs b/test/main.hs
index 40558b2..65c0342 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -1,7 +1,12 @@
 import Control.Exception
+import Control.Monad (unless)
 import System.Exit
 import System.IO.Error
 import System.Process
+import System.IO (hClose, openBinaryTempFile)
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as S8
+import System.Directory (getTemporaryDirectory, removeFile)
 
 main :: IO ()
 main = do
@@ -27,4 +32,25 @@ main = do
     test "create_new_console" $ \cp -> cp { create_new_console = True }
     test "new_session" $ \cp -> cp { new_session = True }
 
+    putStrLn "Binary handles"
+    tmpDir <- getTemporaryDirectory
+    bracket
+      (openBinaryTempFile tmpDir "process-binary-test.bin")
+      (\(fp, h) -> hClose h `finally` removeFile fp)
+      $ \(fp, h) -> do
+        let bs = S8.pack "hello\nthere\r\nworld\0"
+        S.hPut h bs
+        hClose h
+
+        (Nothing, Just out, Nothing, ph) <- createProcess (proc "cat" [fp])
+            { std_out = CreatePipe
+            }
+        res' <- S.hGetContents out
+        hClose out
+        ec <- waitForProcess ph
+        unless (ec == ExitSuccess)
+            $ error $ "Unexpected exit code " ++ show ec
+        unless (bs == res')
+            $ error $ "Unexpected result: " ++ show res'
+
     putStrLn "Tests passed successfully"