[commit: packages/process] master: Add check for binary handles (68abdc2)
git at git.haskell.org
git at git.haskell.org
Wed Jul 19 21:16:47 UTC 2017
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"
More information about the ghc-commits
mailing list