import Data.List
#ifndef mingw32_HOST_OS
-#if __GLASGOW_HASKELL__ > 504
import qualified System.Posix.Internals
-#else
-import qualified Posix
-#endif
#else /* Must be Win32 */
import Foreign
import CString ( CString, peekCString )
#else
import System.Process ( runInteractiveProcess, getProcessExitCode )
import Control.Concurrent( forkIO, newChan, readChan, writeChan )
-import Data.Char ( isSpace )
import FastString ( mkFastString )
import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
#endif
runCc :: DynFlags -> [Option] -> IO ()
runCc dflags args = do
let (p,args0) = pgm_c dflags
- (args1,mb_env) <- getGccEnv (args0++args)
+ args1 = args0 ++ args
+ mb_env <- getGccEnv args1
runSomethingFiltered dflags cc_filter "C Compiler" p args1 mb_env
where
-- discard some harmless warnings from gcc that we can't turn off
isContainedIn :: String -> String -> Bool
xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
--- Turn the -B<dir> option to gcc into the GCC_EXEC_PREFIX env var, to
--- workaround a bug in MinGW gcc on Windows Vista, see bug #1110.
-getGccEnv :: [Option] -> IO ([Option], Maybe [(String,String)])
+-- If the -B<dir> option is set, add <dir> to PATH. This works around
+-- a bug in gcc on Windows Vista where it can't find its auxiliary
+-- binaries (see bug #1110).
+getGccEnv :: [Option] -> IO (Maybe [(String,String)])
getGccEnv opts =
#if __GLASGOW_HASKELL__ < 603
- return (opts,Nothing)
+ return Nothing
#else
if null b_dirs
- then return (opts,Nothing)
+ then return Nothing
else do env <- getEnvironment
- return (rest, Just (("GCC_EXEC_PREFIX", head b_dirs) : env))
+ return (Just (map mangle_path env))
where
- (b_dirs, rest) = partitionWith get_b_opt opts
+ (b_dirs, _) = partitionWith get_b_opt opts
get_b_opt (Option ('-':'B':dir)) = Left dir
get_b_opt other = Right other
+
+ mangle_path (path,paths) | map toUpper path == "PATH"
+ = (path, '\"' : head b_dirs ++ "\";" ++ paths)
+ mangle_path other = other
#endif
runMangle :: DynFlags -> [Option] -> IO ()
runAs :: DynFlags -> [Option] -> IO ()
runAs dflags args = do
let (p,args0) = pgm_a dflags
- runSomething dflags "Assembler" p (args0++args)
+ args1 = args0 ++ args
+ mb_env <- getGccEnv args1
+ runSomethingFiltered dflags id "Assembler" p args1 mb_env
runLink :: DynFlags -> [Option] -> IO ()
runLink dflags args = do
let (p,args0) = pgm_l dflags
- runSomething dflags "Linker" p (args0++args)
+ args1 = args0 ++ args
+ mb_env <- getGccEnv args1
+ runSomethingFiltered dflags id "Linker" p args1 mb_env
runMkDLL :: DynFlags -> [Option] -> IO ()
runMkDLL dflags args = do
let (p,args0) = pgm_dll dflags
- (args1,mb_env) <- getGccEnv (args0++args)
+ args1 = args0 ++ args
+ mb_env <- getGccEnv (args0++args)
runSomethingFiltered dflags id "Make DLL" p args1 mb_env
touch :: DynFlags -> String -> String -> IO ()
#ifdef mingw32_HOST_OS
foreign import ccall unsafe "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
-#elif __GLASGOW_HASKELL__ > 504
-getProcessID :: IO Int
-getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
#else
getProcessID :: IO Int
-getProcessID = Posix.getProcessID
+getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
#endif
-- Divvy up text stream into lines, taking platform dependent