[commit: packages/process] master: T11100: Updated the createPipe implementation (7900487)
git at git.haskell.org
git at git.haskell.org
Thu Apr 7 12:04:09 UTC 2016
Repository : ssh://git@git.haskell.org/process
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/7900487fe825cece73b1f9582ff6a09c3584f28b/process
>---------------------------------------------------------------
commit 7900487fe825cece73b1f9582ff6a09c3584f28b
Author: Tamar Christina <tamar at zhox.com>
Date: Sat Jan 23 14:09:16 2016 +0100
T11100: Updated the createPipe implementation
>---------------------------------------------------------------
7900487fe825cece73b1f9582ff6a09c3584f28b
System/Process.hsc | 2 +-
System/Process/Internals.hs | 14 ++++++++++-
System/Process/Windows.hsc | 11 ++-------
cbits/pipes.c | 57 ---------------------------------------------
include/pipes.h | 18 --------------
process.cabal | 6 -----
6 files changed, 16 insertions(+), 92 deletions(-)
diff --git a/System/Process.hsc b/System/Process.hsc
index 579c197..7d0219c 100644
--- a/System/Process.hsc
+++ b/System/Process.hsc
@@ -57,7 +57,7 @@ module System.Process (
-- Interprocess communication
createPipe,
- createPipeInternalFd,
+ createPipeFD,
-- * Old deprecated functions
-- | These functions pre-date 'createProcess' which is much more
diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
index a3fb0d8..5554a88 100644
--- a/System/Process/Internals.hs
+++ b/System/Process/Internals.hs
@@ -38,7 +38,7 @@ module System.Process.Internals (
withFilePathException, withCEnvironment,
translate,
createPipe,
- createPipeInternalFd,
+ createPipeFD,
interruptProcessGroupOf,
) where
@@ -46,6 +46,7 @@ import Foreign.C
import System.IO
import GHC.IO.Handle.FD (fdToHandle)
+import System.Posix.Internals (FD)
import System.Process.Common
@@ -164,6 +165,17 @@ createPipe :: IO (Handle, Handle)
createPipe = createPipeInternal
{-# INLINE createPipe #-}
+-- ---------------------------------------------------------------------------
+-- createPipeFD
+
+-- | Create a pipe for interprocess communication and return a
+-- @(readEnd, writeEnd)@ `FD` pair.
+--
+-- @since 1.2.1.0
+createPipeFD :: IO (FD, FD)
+createPipeFD = createPipeInternalFd
+{-# INLINE createPipeFD #-}
+
-- ----------------------------------------------------------------------------
-- interruptProcessGroupOf
diff --git a/System/Process/Windows.hsc b/System/Process/Windows.hsc
index 613656a..c2582fe 100644
--- a/System/Process/Windows.hsc
+++ b/System/Process/Windows.hsc
@@ -245,11 +245,7 @@ isDefaultSignal = const False
createPipeInternal :: IO (Handle, Handle)
createPipeInternal = do
- (readfd, writefd) <- allocaArray 2 $ \ pfds -> do
- throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 (#const _O_BINARY)
- readfd <- peek pfds
- writefd <- peekElemOff pfds 1
- return (readfd, writefd)
+ (readfd, writefd) <- createPipeInternalFd
(do readh <- fdToHandle readfd
writeh <- fdToHandle writefd
return (readh, writeh)) `onException` (close' readfd >> close' writefd)
@@ -257,7 +253,7 @@ createPipeInternal = do
createPipeInternalFd :: IO (FD, FD)
createPipeInternalFd = do
allocaArray 2 $ \ pfds -> do
- throwErrnoIfMinus1_ "_pipe" $ c__pipe2 pfds 2 (#const _O_BINARY)
+ throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 (#const _O_BINARY)
readfd <- peek pfds
writefd <- peekElemOff pfds 1
return (readfd, writefd)
@@ -269,9 +265,6 @@ close' = throwErrnoIfMinus1_ "_close" . c__close
foreign import ccall "io.h _pipe" c__pipe ::
Ptr CInt -> CUInt -> CInt -> IO CInt
-foreign import ccall "pipes.h createInheritablePipe" c__pipe2 ::
- Ptr CInt -> CUInt -> CInt -> IO CInt
-
foreign import ccall "io.h _close" c__close ::
CInt -> IO CInt
diff --git a/cbits/pipes.c b/cbits/pipes.c
deleted file mode 100644
index 2ba9265..0000000
--- a/cbits/pipes.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/* ----------------------------------------------------------------------------
- (c) The University of Glasgow 2004
-
- Support for System.Process
- ------------------------------------------------------------------------- */
-
-#include "pipes.h"
-
-BOOL createInheritablePipe(int *phandles, unsigned int psize, int textmode) {
- HANDLE hTemporaryIn = NULL;
- HANDLE hTemporaryOut = NULL;
-
- BOOL isInheritableOut = TRUE;
- BOOL isInheritableIn = TRUE;
-
- /* Create the anon pipe with both ends inheritable */
- if (!CreatePipe(&hTemporaryIn, &hTemporaryOut, NULL, 0))
- {
- maperrno();
- phandles[0] = NULL;
- phandles[1] = NULL;
- return FALSE;
- }
-
- if (isInheritableIn) {
- // SetHandleInformation requires at least Win2k
- if (!SetHandleInformation(hTemporaryIn,
- HANDLE_FLAG_INHERIT,
- HANDLE_FLAG_INHERIT))
- {
- maperrno();
- phandles[0] = NULL;
- phandles[1] = NULL;
- CloseHandle(hTemporaryIn);
- CloseHandle(hTemporaryOut);
- return FALSE;
- }
- }
- phandles[0] = _open_osfhandle((int)hTemporaryIn, textmode);
-
- if (isInheritableOut) {
- if (!SetHandleInformation(hTemporaryOut,
- HANDLE_FLAG_INHERIT,
- HANDLE_FLAG_INHERIT))
- {
- maperrno();
- phandles[0] = NULL;
- phandles[1] = NULL;
- CloseHandle(hTemporaryIn);
- CloseHandle(hTemporaryOut);
- return FALSE;
- }
- }
- phandles[1] = _open_osfhandle((int)hTemporaryOut, textmode);
-
- return TRUE;
-}
\ No newline at end of file
diff --git a/include/pipes.h b/include/pipes.h
deleted file mode 100644
index 36e2545..0000000
--- a/include/pipes.h
+++ /dev/null
@@ -1,18 +0,0 @@
-/* ----------------------------------------------------------------------------
- (c) The University of Glasgow 2004
-
- Interface for code in pipes.c (providing support for System.Process)
- ------------------------------------------------------------------------- */
-
-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
-#define UNICODE
-#include <windows.h>
-#include <stdlib.h>
-#include <io.h>
-#endif
-
-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
-
-extern BOOL createInheritablePipe(int *phandles, unsigned int psize, int textmode);
-
-#endif
diff --git a/process.cabal b/process.cabal
index c0918f2..ee69285 100644
--- a/process.cabal
+++ b/process.cabal
@@ -51,12 +51,6 @@ library
build-depends: Win32 >=2.2 && < 2.4
extra-libraries: kernel32
cpp-options: -DWINDOWS
- c-sources:
- cbits/pipes.c
- includes:
- pipes.h
- install-includes:
- pipes.h
else
other-modules: System.Process.Posix
build-depends: unix >= 2.5 && < 2.8
More information about the ghc-commits
mailing list