Commit 5f4d6615 authored by tibbe's avatar tibbe
Browse files

Make the test suite compile on Windows

parent 49de83a3
......@@ -164,6 +164,7 @@ test-suite package-tests
PackageTests.PackageTester
PackageTests.PathsModule.Executable.Check
PackageTests.PathsModule.Library.Check
Distribution.Compat.CreatePipe
hs-source-dirs: tests
build-depends:
base,
......@@ -177,7 +178,9 @@ test-suite package-tests
directory,
filepath,
extensible-exceptions,
bytestring,
unix
bytestring
if !os(windows)
build-depends: unix
ghc-options: -Wall
Default-Extensions: CPP
Default-Language: Haskell98
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
module Distribution.Compat.CreatePipe (createPipe) where
import System.IO (Handle)
#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))
import System.Posix.IO (fdToHandle)
import qualified System.Posix.IO as Posix
#else
# include <io.h> /* for _pipe */
# include <fcntl.h> /* for _O_BINARY */
import Control.Exception (onException)
import Foreign.C.Error (throwErrnoIfMinus1_)
import Foreign.C.Types (CInt(CInt), CUInt(CUInt))
import Foreign.Ptr (Ptr)
import Foreign.Marshal.Array (allocaArray)
import Foreign.Storable (peek, peekElemOff)
import GHC.IO.FD (mkFD)
import GHC.IO.Device (close)
import GHC.IO.Handle.FD (mkHandleFromFD)
import System.IO (IOMode(ReadMode, WriteMode))
#endif
createPipe :: IO (Handle, Handle)
#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))
createPipe = do
(readfd, writefd) <- Posix.createPipe
readh <- fdToHandle readfd
writeh <- fdToHandle writefd
return (readh, writeh)
#else
createPipe = 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, readDeviceType) <- mkFD readfd ReadMode Nothing False False
readh <- mkHandleFromFD readFD readDeviceType "" ReadMode False Nothing
`onException` close readFD
(writeFD, writeDeviceType) <- mkFD writefd WriteMode Nothing False False
writeh <- mkHandleFromFD writeFD writeDeviceType "" WriteMode False Nothing
`onException` close writeFD
return (readh, writeh)
foreign import ccall "io.h _pipe" c__pipe ::
Ptr CInt -> CUInt -> CInt -> IO CInt
#endif
......@@ -24,7 +24,6 @@ import System.Directory
import System.FilePath
import System.IO
import System.IO.Error (isDoesNotExistError)
import System.Posix.IO
import System.Process hiding (cwd)
import System.Exit
import Control.Monad
......@@ -33,6 +32,7 @@ import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Test.HUnit
import Distribution.Compat.CreatePipe (createPipe)
data PackageSpec =
PackageSpec {
......@@ -153,14 +153,12 @@ cabal spec cabalArgs = do
run :: Maybe FilePath -> String -> [String] -> IO (String, ExitCode, String)
run cwd cmd args = do
-- Posix-specific
(outf, outf0) <- createPipe
outh <- fdToHandle outf
outh0 <- fdToHandle outf0
pid <- runProcess cmd args cwd Nothing Nothing (Just outh0) (Just outh0)
(readh, writeh) <- createPipe
pid <- runProcess cmd args cwd Nothing Nothing (Just writeh) (Just writeh)
-- fork off a thread to start consuming the output
output <- suckH [] outh
hClose outh
output <- suckH [] readh
hClose readh
-- wait on the process
ex <- waitForProcess pid
......
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