Repository : ssh://darcs.haskell.org//srv/darcs/packages/process On branch : master
http://hackage.haskell.org/trac/ghc/changeset/d10b168a65701ffb29a80b3d72d77362cfa12110 >--------------------------------------------------------------- commit d10b168a65701ffb29a80b3d72d77362cfa12110 Author: Ian Lynagh <[email protected]> Date: Fri Nov 30 21:37:28 2012 +0000 Bump base lower version to 4.5 (the version GHC 7.4.1 came with) and remove code to support older versions >--------------------------------------------------------------- System/Cmd.hs | 2 +- System/Process.hs | 13 ++----------- System/Process/Internals.hs | 34 +--------------------------------- cbits/runProcess.c | 2 -- process.cabal | 12 +----------- 5 files changed, 5 insertions(+), 58 deletions(-) diff --git a/System/Cmd.hs b/System/Cmd.hs index 54f0b85..989572c 100644 --- a/System/Cmd.hs +++ b/System/Cmd.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 701 +#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} #endif diff --git a/System/Process.hs b/System/Process.hs index d34370e..967aedd 100644 --- a/System/Process.hs +++ b/System/Process.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-} -#if __GLASGOW_HASKELL__ >= 701 +#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE InterruptibleFFI #-} #endif @@ -90,11 +90,7 @@ import Data.Maybe import System.Exit ( ExitCode(..) ) #ifdef __GLASGOW_HASKELL__ -#if __GLASGOW_HASKELL__ >= 611 import GHC.IO.Exception ( ioException, IOErrorType(..), IOException(..) ) -#else -import GHC.IOBase ( ioException, IOErrorType(..) ) -#endif #if defined(mingw32_HOST_OS) import System.Win32.Process (getProcessId) import System.Win32.Console (generateConsoleCtrlEvent, cTRL_BREAK_EVENT) @@ -482,7 +478,7 @@ readProcessWithExitCode cmd args input = hFlush inh hClose inh -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 611 +#if defined(__GLASGOW_HASKELL__) C.catch writeInput $ \e -> case e of IOError { ioe_type = ResourceVanished , ioe_errno = Just ioe } @@ -706,11 +702,6 @@ foreign import ccall unsafe "getProcessExitCode" -> Ptr CInt -> IO CInt -#if __GLASGOW_HASKELL__ < 701 --- not available prior to 7.1 -#define interruptible safe -#endif - foreign import ccall interruptible "waitForProcess" -- NB. safe - can block c_waitForProcess :: PHANDLE diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs index 72e0bfd..d6cd745 100644 --- a/System/Process/Internals.hs +++ b/System/Process/Internals.hs @@ -2,7 +2,7 @@ {-# OPTIONS_HADDOCK hide #-} {-# OPTIONS_GHC -w #-} -- XXX We get some warnings on Windows -#if __GLASGOW_HASKELL__ >= 701 +#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} #endif @@ -66,7 +66,6 @@ import Foreign # ifdef __GLASGOW_HASKELL__ import System.Posix.Internals -#if __GLASGOW_HASKELL__ >= 611 import GHC.IO.Exception import GHC.IO.Encoding import qualified GHC.IO.FD as FD @@ -81,10 +80,6 @@ import Data.Typeable import GHC.IO.IOMode import System.Win32.DebugApi (PHANDLE) #endif -#else -import GHC.IOBase ( haFD, FD, IOException(..) ) -import GHC.Handle -#endif # elif __HUGS__ @@ -92,9 +87,7 @@ import Hugs.Exception ( IOException(..) ) # endif -#ifdef base4 import System.IO.Error ( ioeSetFileName ) -#endif #if defined(mingw32_HOST_OS) import Control.Monad ( when ) import System.Directory ( doesFileExist ) @@ -389,9 +382,6 @@ mbFd :: String -> FD -> StdStream -> IO FD mbFd _ _std CreatePipe = return (-1) mbFd _fun std Inherit = return std mbFd fun _std (UseHandle hdl) = -#if __GLASGOW_HASKELL__ < 611 - withHandle_ fun hdl $ return . haFD -#else withHandle fun hdl $ \h@Handle__{haDevice=dev,..} -> case cast dev of Just fd -> do @@ -403,7 +393,6 @@ mbFd fun _std (UseHandle hdl) = ioError (mkIOError illegalOperationErrorType "createProcess" (Just hdl) Nothing `ioeSetErrorString` "handle is not a file descriptor") -#endif mbPipe :: StdStream -> Ptr FD -> IOMode -> IO (Maybe Handle) mbPipe CreatePipe pfd mode = fmap Just (pfdToHandle pfd mode) @@ -413,7 +402,6 @@ pfdToHandle :: Ptr FD -> IOMode -> IO Handle pfdToHandle pfd mode = do fd <- peek pfd let filepath = "fd:" ++ show fd -#if __GLASGOW_HASKELL__ >= 611 (fD,fd_type) <- FD.mkFD (fromIntegral fd) mode (Just (Stream,0,0)) -- avoid calling fstat() False {-is_socket-} @@ -421,16 +409,6 @@ pfdToHandle pfd mode = do fD <- FD.setNonBlockingMode fD True -- see #3316 enc <- getLocaleEncoding mkHandleFromFD fD fd_type filepath mode False {-is_socket-} (Just enc) -#else - fdToHandle' fd (Just Stream) - False {-Windows: not a socket, Unix: don't set non-blocking-} - filepath mode True {-binary-} -#endif - -#if __GLASGOW_HASKELL__ < 703 -getLocaleEncoding :: IO TextEncoding -getLocaleEncoding = return localeEncoding -#endif #ifndef __HUGS__ -- ---------------------------------------------------------------------------- @@ -478,13 +456,7 @@ commandToProcess (RawCommand cmd args) = do findCommandInterpreter :: IO FilePath findCommandInterpreter = do -- try COMSPEC first -#ifdef base3 - catchJust (\e -> case e of - IOException e | isDoesNotExistError e -> Just e - _otherwise -> Nothing) -#else catchJust (\e -> if isDoesNotExistError e then Just e else Nothing) -#endif (getEnv "COMSPEC") $ \e -> do -- try to find CMD.EXE or COMMAND.COM @@ -607,11 +579,7 @@ translate str withFilePathException :: FilePath -> IO a -> IO a withFilePathException fpath act = handle mapEx act where -#ifdef base4 mapEx ex = ioError (ioeSetFileName ex fpath) -#else - mapEx (IOException (IOError h iot fun str _)) = ioError (IOError h iot fun str (Just fpath)) -#endif #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) withCEnvironment :: [(String,String)] -> (Ptr CString -> IO a) -> IO a diff --git a/cbits/runProcess.c b/cbits/runProcess.c index 6165162..a315334 100644 --- a/cbits/runProcess.c +++ b/cbits/runProcess.c @@ -89,9 +89,7 @@ runInteractiveProcess (char *const args[], { case -1: unblockUserSignals(); -#if __GLASGOW_HASKELL__ > 612 startTimer(); -#endif if (fdStdIn == -1) { close(fdStdInput[0]); close(fdStdInput[1]); diff --git a/process.cabal b/process.cabal index 37fce22..b9bfc0e 100644 --- a/process.cabal +++ b/process.cabal @@ -22,8 +22,6 @@ source-repository head type: git location: http://darcs.haskell.org/packages/process.git/ -flag base4 - Library { exposed-modules: System.Cmd if !impl(nhc98) { @@ -48,15 +46,7 @@ Library { build-depends: unix } - if (flag(base4)) { - build-depends: base >= 4 && < 5 - cpp-options: -Dbase4 - -- later, we can use the new MIN_VERSION_base() stuff that - -- arrived in Cabal-1.6. - } else { - build-depends: base >= 3 && < 4 - cpp-options: -Dbase3 - } + build-depends: base >= 4.5 && < 5 build-depends: directory >= 1.0 && < 1.3, filepath >= 1.1 && < 1.4, _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
