X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FSysTools.lhs;h=64e7b7803f1ecef11553a6cdebb3ee1fc414339b;hb=fea8c9e4b1ef4973aa577f29b59d35ee12472ebb;hp=a4224e98aa19221ce72ee0ba67dd0145b9dc1bbe;hpb=1889796e4c1048f2c18f7875c5d0cdbf53468bc6;p=ghc-hetmet.git diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index a4224e9..64e7b78 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -57,11 +57,7 @@ import Data.Maybe 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 ) @@ -75,7 +71,6 @@ import GHC.IOBase ( IOErrorType(..) ) #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 @@ -474,7 +469,7 @@ xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys) getGccEnv :: [Option] -> IO (Maybe [(String,String)]) getGccEnv opts = #if __GLASGOW_HASKELL__ < 603 - return (opts,Nothing) + return Nothing #else if null b_dirs then return Nothing @@ -486,7 +481,8 @@ getGccEnv opts = get_b_opt (Option ('-':'B':dir)) = Left dir get_b_opt other = Right other - mangle_path ("PATH",paths) = ("PATH", '\"' : head b_dirs ++ "\";" ++ paths) + mangle_path (path,paths) | map toUpper path == "PATH" + = (path, '\"' : head b_dirs ++ "\";" ++ paths) mangle_path other = other #endif @@ -510,7 +506,9 @@ runAs dflags args = do 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 @@ -581,7 +579,8 @@ newTempName dflags extn = do d <- getTempDir dflags x <- getProcessID findTempName (d ++ "/ghc" ++ show x ++ "_") 0 - where + where + findTempName :: FilePath -> Integer -> IO FilePath findTempName prefix x = do let filename = (prefix ++ show x) `joinFileExt` extn b <- doesFileExist filename @@ -598,6 +597,8 @@ getTempDir dflags@(DynFlags{tmpDir=tmp_dir}) Nothing -> do x <- getProcessID let prefix = tmp_dir ++ "/ghc" ++ show x ++ "_" + let + mkTempDir :: Integer -> IO FilePath mkTempDir x = let dirname = prefix ++ show x in do createDirectory dirname @@ -721,7 +722,11 @@ builderMainLoop dflags filter_fn pgm real_args mb_env = do hSetBuffering hStdErr LineBuffering forkIO (readerProc chan hStdOut filter_fn) forkIO (readerProc chan hStdErr filter_fn) - rc <- loop chan hProcess 2 1 ExitSuccess + -- we don't want to finish until 2 streams have been completed + -- (stdout and stderr) + -- nor until 1 exit code has been retrieved. + rc <- loop chan hProcess (2::Integer) (1::Integer) ExitSuccess + -- after that, we're done here. hClose hStdIn hClose hStdOut hClose hStdErr @@ -875,12 +880,9 @@ getBaseDir = return Nothing #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