Commit 80803096 authored by Tamar Christina's avatar Tamar Christina
Browse files

GH77: Fixed compilation

parent 684ce185
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# LANGUAGE InterruptibleFFI #-}
module System.Process.Windows
( mkProcessHandle
, translateInternal
......@@ -57,7 +58,7 @@ mkProcessHandle h = do
mkProcessHandle' :: PHANDLE -> IO (Maybe ProcessHandle)
mkProcessHandle' h = do
if h /= nullPtr
then return $ Just $ mkProcessHandle h
then Just <$> mkProcessHandle h
else return $ Nothing
processHandleFinaliser :: MVar ProcessHandle__ -> IO ()
......@@ -90,8 +91,8 @@ createProcess_Internal
-> IO (Maybe Handle, Maybe Handle,
Maybe Handle, ProcessHandle)
createProcess_Internal fun cp
= let (hndStdInput, hndStdOutput, hndStdError, ph, _, _) = createProcess_Internal_ext fun cp
in return (hndStdInput, hndStdOutput, hndStdError, ph)
= do (hndStdInput, hndStdOutput, hndStdError, ph, _, _) <- createProcess_Internal_ext fun False cp
return (hndStdInput, hndStdOutput, hndStdError, ph)
createProcess_Internal_ext
:: String -- ^ function name (for error messages)
......@@ -101,7 +102,7 @@ createProcess_Internal_ext
Maybe Handle, ProcessHandle,
Maybe ProcessHandle, Maybe ProcessHandle)
createProcess_Internal fun useJob CreateProcess{ cmdspec = cmdsp,
createProcess_Internal_ext fun useJob CreateProcess{ cmdspec = cmdsp,
cwd = mb_cwd,
env = mb_env,
std_in = mb_stdin,
......@@ -114,17 +115,18 @@ createProcess_Internal fun useJob CreateProcess{ cmdspec = cmdsp,
create_new_console = mb_create_new_console,
new_session = mb_new_session }
= do
let lenPtr = sizeOf (undefined :: WordPtr)
(cmd, cmdline) <- commandToProcess cmdsp
withFilePathException cmd $
alloca $ \ pfdStdInput ->
alloca $ \ pfdStdOutput ->
alloca $ \ pfdStdError ->
alloca $ \ hJob ->
alloca $ \ hIOcpPort ->
alloca $ \ pfdStdInput ->
alloca $ \ pfdStdOutput ->
alloca $ \ pfdStdError ->
allocaBytes lenPtr $ \ hJob ->
allocaBytes lenPtr $ \ hIOcpPort ->
maybeWith withCEnvironment mb_env $ \pEnv ->
maybeWith withCWString mb_cwd $ \pWorkDir -> do
withCWString cmdline $ \pcmdline -> do
fdin <- mbFd fun fd_stdin mb_stdin
fdout <- mbFd fun fd_stdout mb_stdout
fderr <- mbFd fun fd_stderr mb_stderr
......@@ -160,7 +162,7 @@ createProcess_Internal fun useJob CreateProcess{ cmdspec = cmdsp,
ph <- mkProcessHandle proc_handle
phJob <- mkProcessHandle' hJob
phIOCP <- mkProcessHandle' hIOcpPort
return (hndStdInput, hndStdOutput, hndStdError, ph)
return (hndStdInput, hndStdOutput, hndStdError, ph, phJob, phIOCP)
{-# NOINLINE runInteractiveProcess_lock #-}
runInteractiveProcess_lock :: MVar ()
......@@ -192,7 +194,7 @@ foreign import ccall unsafe "terminateJob"
foreign import ccall interruptible "waitForJobCompletion" -- NB. safe - can block
c_waitForJobCompletion
:: PHANDLE
:: PHANDLE
-> PHANDLE
-> CInt
-> Ptr CInt
-> IO CInt
......
......@@ -520,8 +520,14 @@ createJob ()
// Last process in the job terminates. This prevent half dead processes.
jeli.BasicLimitInformation.LimitFlags = JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE;
return SetInformationJobObject(hJob, JobObjectExtendedLimitInformation,
&jeli, sizeof(JOBOBJECT_EXTENDED_LIMIT_INFORMATION));
if (SetInformationJobObject (hJob, JobObjectExtendedLimitInformation,
&jeli, sizeof(JOBOBJECT_EXTENDED_LIMIT_INFORMATION)))
{
return hJob;
}
maperrno();
return NULL;
}
static HANDLE
......@@ -782,7 +788,7 @@ waitForProcess (ProcHandle handle, int *pret)
return -1;
}
static int
int
waitForJobCompletion (HANDLE hJob, HANDLE ioPort, DWORD timeout, int *pExitCode)
{
DWORD CompletionCode;
......
......@@ -10,6 +10,7 @@
* New exposed `withCreateProcess`
* Derive `Show` and `Eq` for `CreateProcess`, `CmdSpec`, and `StdStream`
* Add support for monitoring process tree for termination with `...`
## 1.4.2.0 *January 2016*
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment