pass COLLECT_GCC_OPTIONS

This commit is contained in:
Joey Hess 2013-12-06 13:53:58 -04:00
parent 237f72990e
commit 5b5c33e06d
2 changed files with 20 additions and 10 deletions

View file

@ -21,8 +21,11 @@ import Utility.Monad
import Utility.Process
import System.Directory
data CmdParams = CmdParams { cmd :: String, opts :: String }
deriving (Show)
data CmdParams = CmdParams
{ cmd :: String
, opts :: String
, env :: Maybe [(String, String)]
} deriving (Show)
{- Find where ghc calls gcc to link the executable. -}
parseGhcLink :: Parser CmdParams
@ -33,7 +36,7 @@ parseGhcLink = do
gcccmd <- many1 (noneOf "\"")
string "\" "
gccparams <- restOfLine
return $ CmdParams gcccmd (manglepaths gccparams)
return $ CmdParams gcccmd (manglepaths gccparams) Nothing
where
linkheaderline = do
string "*** Linker"
@ -53,6 +56,7 @@ parseGccLink = do
char ' '
collect2params <- restOfLine
return $ CmdParams (path ++ collectcmd) (escapeDosPaths collect2params)
(Just [(collectenv, env)])
where
collectcmd = "collect2.exe"
collectenv = "COLLECT_GCC_OPTIONS"
@ -85,10 +89,10 @@ restOfLine = newline `after` many (noneOf "\n")
{- Intentionally ignores command failure; the whole point is to work around
- that. -}
getOutput :: String -> [String] -> IO String
getOutput cmd params = do
getOutput :: String -> [String] -> Maybe [(String, String)] -> IO String
getOutput cmd params env = do
putStrLn $ unwords [cmd, show params]
(log, _ok) <- processTranscript cmd params Nothing
(log, _ok) <- processTranscript' cmd params env Nothing
return log
runParser' :: Parser a -> String -> a
@ -100,7 +104,7 @@ atFile f = '@':f
runAtFile :: Parser CmdParams -> String -> FilePath -> [String] -> IO String
runAtFile p s f extraparams = do
writeFile f (opts c)
out <- getOutput (cmd c) (atFile f:extraparams)
out <- getOutput (cmd c) (atFile f:extraparams) (env c)
removeFile f
return out
where
@ -108,7 +112,7 @@ runAtFile p s f extraparams = do
main = do
ghcout <- getOutput "cabal"
["build", "--ghc-options=-v -keep-tmp-files"]
["build", "--ghc-options=-v -keep-tmp-files"] Nothing
gccout <- runAtFile parseGhcLink ghcout "gcc.opt" ["-v"]
writeFile "gcc.out" gccout
collect2out <- runAtFile parseGccLink gccout "collect2.opt" ["-v"]

View file

@ -22,6 +22,7 @@ module Utility.Process (
createProcessChecked,
createBackgroundProcess,
processTranscript,
processTranscript',
withHandle,
withBothHandles,
withQuietOutput,
@ -162,10 +163,13 @@ createBackgroundProcess p a = a =<< createProcess p
- returns a transcript combining its stdout and stderr, and
- whether it succeeded or failed. -}
processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
processTranscript cmd opts input = processTranscript' cmd opts Nothing input
processTranscript' :: String -> [String] -> Maybe [(String, String)] -> (Maybe String) -> IO (String, Bool)
#ifndef mingw32_HOST_OS
{- This implementation interleves stdout and stderr in exactly the order
- the process writes them. -}
processTranscript cmd opts input = do
processTranscript' cmd opts environ input = do
(readf, writef) <- createPipe
readh <- fdToHandle readf
writeh <- fdToHandle writef
@ -174,6 +178,7 @@ processTranscript cmd opts input = do
{ std_in = if isJust input then CreatePipe else Inherit
, std_out = UseHandle writeh
, std_err = UseHandle writeh
, env = environ
}
hClose writeh
@ -195,12 +200,13 @@ processTranscript cmd opts input = do
return (transcript, ok)
#else
{- This implementation for Windows puts stderr after stdout. -}
processTranscript cmd opts input = do
processTranscript cmd opts input environ = do
p@(_, _, _, pid) <- createProcess $
(proc cmd opts)
{ std_in = if isJust input then CreatePipe else Inherit
, std_out = CreatePipe
, std_err = CreatePipe
, env = environ
}
getout <- mkreader (stdoutHandle p)