[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