diff --git a/process.cabal b/process.cabal index 15f6a656..3c518837 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 40558b28..65c03423 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"