Merge branch 'master' of https://github.com/ezyang/process into 74-ch…

…eck-rel-path-subdirs

System/Process.hs

@@ -42,6 +42,7 @@ module System.Process (
     readProcess,
     readCreateProcessWithExitCode,
     readProcessWithExitCode,
+    withCreateProcess,
 
     -- ** Related utilities
     showCommandForUser,
@@ -196,29 +197,27 @@ createProcess cp = do
   maybeCloseStd _ = return ()
 
 {-
--- TODO: decide if we want to expose this to users
--- | A 'C.bracketOnError'-style resource handler for 'createProcess'.
+-- | A 'C.bracket'-style resource handler for 'createProcess'.
 --
--- In normal operation it adds nothing, you are still responsible for waiting
--- for (or forcing) process termination and closing any 'Handle's. It only does
--- automatic cleanup if there is an exception. If there is an exception in the
--- body then it ensures that the process gets terminated and any 'CreatePipe'
--- 'Handle's are closed. In particular this means that if the Haskell thread
--- is killed (e.g. 'killThread'), that the external process is also terminated.
+-- Does automatic cleanup when the action finishes. If there is an exception
+-- in the body then it ensures that the process gets terminated and any
+-- 'CreatePipe' 'Handle's are closed. In particular this means that if the
+-- Haskell thread is killed (e.g. 'killThread'), that the external process is
+-- also terminated.
 --
 -- e.g.
 --
 -- > withCreateProcess (proc cmd args) { ... }  $ \_ _ _ ph -> do
 -- >   ...
 --
+-}
 withCreateProcess
   :: CreateProcess
   -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
   -> IO a
 withCreateProcess c action =
-    C.bracketOnError (createProcess c) cleanupProcess
-                     (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph)
--}
+    C.bracket (createProcess c) cleanupProcess
+              (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph)
 
 -- wrapper so we can get exceptions with the appropriate function name.
 withCreateProcess_

System/Process/Common.hs

@@ -64,7 +64,7 @@ type PHANDLE = CPid
 #endif
 
 data CreateProcess = CreateProcess{
-  cmdspec      :: CmdSpec,                 -- ^ Executable & arguments, or shell command
+  cmdspec      :: CmdSpec,                 -- ^ Executable & arguments, or shell command.  Relative paths are resolved with respect to 'cwd' if given, and otherwise the current working directory.
   cwd          :: Maybe FilePath,          -- ^ Optional path to the working directory for the new process
   env          :: Maybe [(String,String)], -- ^ Optional environment (otherwise inherit from the current process)
   std_in       :: StdStream,               -- ^ How to determine stdin

System/Process/Internals.hs

@@ -50,7 +50,7 @@ import System.Posix.Internals (FD)
 
 import System.Process.Common
 
-#if WINDOWS
+#ifdef WINDOWS
 import System.Process.Windows
 #else
 import System.Process.Posix

changelog.md

@@ -1,5 +1,9 @@
 # Changelog for [`process` package](http://hackage.haskell.org/package/process)
 
+## Unreleased
+
+  * New exposed `withCreateProcess`
+
 ## 1.4.2.0 *January 2016*
 
 * Added `createPipeFD` [#52](https://github.com/haskell/process/pull/52)

process.cabal

@@ -79,5 +79,6 @@ test-suite test
   main-is: main.hs
   type: exitcode-stdio-1.0
   build-depends: base
+               , bytestring
                , directory
                , process

test/main.hs

@@ -5,6 +5,10 @@ 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
@@ -41,6 +45,27 @@ main = do
       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