mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

wall clean

Browse source
This commit is contained in:
Joey Hess 2013-12-09 15:28:33 -04:00
parent 5017523183
commit 0e729fdff6
1 changed files with 27 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
Build/EvilLinker.hs
View file

@ -10,9 +10,6 @@
module Main where module Main where
import Data.Maybe
import Data.Either
import Data.List
import Data.List.Utils import Data.List.Utils
import Text.Parsec import Text.Parsec
import Text.Parsec.String import Text.Parsec.String
@ -32,64 +29,64 @@ data CmdParams = CmdParams
{- Find where ghc calls gcc to link the executable. -} {- Find where ghc calls gcc to link the executable. -}
parseGhcLink :: Parser CmdParams parseGhcLink :: Parser CmdParams
parseGhcLink = do parseGhcLink = do
many prelinkline void $ many prelinkline
linkheaderline void linkheaderline
char '"' void $ char '"'
gcccmd <- many1 (noneOf "\"") gcccmd <- many1 (noneOf "\"")
string "\" " void $ string "\" "
gccparams <- restOfLine gccparams <- restOfLine
return $ CmdParams gcccmd (manglepaths gccparams) Nothing return $ CmdParams gcccmd (manglepaths gccparams) Nothing
where where
linkheaderline = do linkheaderline = do
string "*** Linker" void $ string "*** Linker"
restOfLine restOfLine
prelinkline = do prelinkline = do
notFollowedBy linkheaderline void $ notFollowedBy linkheaderline
restOfLine restOfLine
manglepaths = replace "\\" "/" manglepaths = replace "\\" "/"
{- Find where gcc calls collect2. -} {- Find where gcc calls collect2. -}
parseGccLink :: Parser CmdParams parseGccLink :: Parser CmdParams
parseGccLink = do parseGccLink = do
many preenv void $ many preenv
env <- collectenv cenv <- collectenv
try $ char ' ' void $ try $ char ' '
path <- manyTill anyChar (try $ string collectcmd) path <- manyTill anyChar (try $ string collectcmd)
char ' ' void $ char ' '
collect2params <- restOfLine collect2params <- restOfLine
return $ CmdParams (path ++ collectcmd) (escapeDosPaths collect2params) env return $ CmdParams (path ++ collectcmd) (escapeDosPaths collect2params) cenv
where where
collectcmd = "collect2.exe" collectcmd = "collect2.exe"
pathenv = "COMPILER_PATH" pathenv = "COMPILER_PATH"
libpathenv = "LIBRARY_PATH" libpathenv = "LIBRARY_PATH"
optenv = "COLLECT_GCC_OPTIONS" optenv = "COLLECT_GCC_OPTIONS"
collectenv = do collectenv = do
string pathenv void $ string pathenv
char '=' void $ char '='
p <- restOfLine p <- restOfLine
string libpathenv void $ string libpathenv
char '=' void $ char '='
lp <- restOfLine lp <- restOfLine
string optenv void $ string optenv
char '=' void $ char '='
o <- restOfLine o <- restOfLine
return $ Just [(pathenv, p), (libpathenv, lp), (optenv, o)] return $ Just [(pathenv, p), (libpathenv, lp), (optenv, o)]
preenv = do preenv = do
notFollowedBy collectenv void $ notFollowedBy collectenv
restOfLine restOfLine
{- Find where collect2 calls ld. -} {- Find where collect2 calls ld. -}
parseCollect2 :: Parser CmdParams parseCollect2 :: Parser CmdParams
parseCollect2 = do parseCollect2 = do
manyTill restOfLine (try versionline) void $ manyTill restOfLine (try versionline)
path <- manyTill anyChar (try $ string ldcmd) path <- manyTill anyChar (try $ string ldcmd)
char ' ' void $ char ' '
params <- restOfLine params <- restOfLine
return $ CmdParams (path ++ ldcmd) (escapeDosPaths params) Nothing return $ CmdParams (path ++ ldcmd) (escapeDosPaths params) Nothing
where where
ldcmd = "ld.exe" ldcmd = "ld.exe"
versionline = do versionline = do
string "collect2 version" void $ string "collect2 version"
restOfLine restOfLine
{- Input contains something like {- Input contains something like
@ -112,11 +109,11 @@ restOfLine :: Parser String
restOfLine = newline `after` many (noneOf "\n") restOfLine = newline `after` many (noneOf "\n")
getOutput :: String -> [String] -> Maybe [(String, String)] -> IO (String, Bool) getOutput :: String -> [String] -> Maybe [(String, String)] -> IO (String, Bool)
getOutput cmd params env = do getOutput c ps environ = do
putStrLn $ unwords [cmd, show params] putStrLn $ unwords [c, show ps]
out@(s, ok) <- processTranscript' cmd params env Nothing out@(s, ok) <- processTranscript' c ps environ Nothing
putStrLn $ unwords [cmd, "finished", show ok, "output size:", show (length s)] putStrLn $ unwords [c, "finished", show ok, "output size:", show (length s)]
writeFile (cmd ++ ".out") s writeFile (c ++ ".out") s
return out return out
runParser' :: Parser a -> String -> String -> a runParser' :: Parser a -> String -> String -> a
@ -141,6 +138,7 @@ runAtFile p s f extraparams = do
where where
c = runParser' p s (opts c) c = runParser' p s (opts c)
main :: IO ()
main = do main = do
ghcout <- fst <$> getOutput "cabal" ghcout <- fst <$> getOutput "cabal"
["build", "--ghc-options=-v -keep-tmp-files"] Nothing ["build", "--ghc-options=-v -keep-tmp-files"] Nothing