[commit: packages/process] master: Merge branch 'master' of https://github.com/ezyang/process into 74-check-rel-path-subdirs (66eaeb6)
git at git.haskell.org
git at git.haskell.org
Wed Jul 19 21:17:17 UTC 2017
Repository : ssh://git@git.haskell.org/process
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/66eaeb612ad64da2738e83f4eac24ca748a3ac64/process
>---------------------------------------------------------------
commit 66eaeb612ad64da2738e83f4eac24ca748a3ac64
Merge: 1ffe7da 681aaee
Author: Michael Snoyman <michael at snoyman.com>
Date: Sun Nov 13 12:01:39 2016 +0200
Merge branch 'master' of https://github.com/ezyang/process into 74-check-rel-path-subdirs
>---------------------------------------------------------------
66eaeb612ad64da2738e83f4eac24ca748a3ac64
System/Process.hs | 21 ++++++++++-----------
System/Process/Common.hs | 2 +-
System/Process/Internals.hs | 2 +-
changelog.md | 4 ++++
process.cabal | 1 +
test/main.hs | 25 +++++++++++++++++++++++++
6 files changed, 42 insertions(+), 13 deletions(-)
diff --cc test/main.hs
index f768b81,65c0342..3bc6d8c
--- a/test/main.hs
+++ b/test/main.hs
@@@ -2,9 -2,11 +2,13 @@@ import Control.Exceptio
import Control.Monad (unless)
import System.Exit
import System.IO.Error
+import System.Directory (getCurrentDirectory, setCurrentDirectory)
import System.Process
+import Data.List (isInfixOf)
+ 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
@@@ -30,23 -32,25 +34,44 @@@
test "create_new_console" $ \cp -> cp { create_new_console = True }
test "new_session" $ \cp -> cp { new_session = True }
+ putStrLn "Testing subdirectories"
+
+ withCurrentDirectory "exes" $ do
+ res1 <- readCreateProcess (proc "./echo.bat" []) ""
+ unless ("parent" `isInfixOf` res1) $ error $
+ "echo.bat with cwd failed: " ++ show res1
+
+ res2 <- readCreateProcess (proc "./echo.bat" []) { cwd = Just "subdir" } ""
+ unless ("child" `isInfixOf` res2) $ error $
+ "echo.bat with cwd failed: " ++ show res2
+
+ 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"
+
+withCurrentDirectory :: FilePath -> IO a -> IO a
+withCurrentDirectory new inner = do
+ orig <- getCurrentDirectory
+ bracket_
+ (setCurrentDirectory new)
+ (setCurrentDirectory orig)
+ inner
More information about the ghc-commits
mailing list