From 98344985c816d0abe17192f38b1663d85d8d2f9b Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Tue, 28 Feb 2006 15:31:34 +0000 Subject: [PATCH] filter the messages generated by gcc Eliminate things like "warning: call-clobbered register used as global register variable", which is an non-suppressible warning from gcc. --- ghc/compiler/main/SysTools.lhs | 72 ++++++++++++++++++++++++++-------------- 1 file changed, 48 insertions(+), 24 deletions(-) diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs index 05153ce..5c434d0 100644 --- a/ghc/compiler/main/SysTools.lhs +++ b/ghc/compiler/main/SysTools.lhs @@ -54,16 +54,17 @@ import Util ( Suffix, global, notNull, consIORef, joinFileName, import DynFlags ( DynFlags(..), DynFlag(..), dopt, Option(..), setTmpDir, defaultDynFlags ) -import EXCEPTION ( throwDyn ) +import EXCEPTION ( throwDyn, finally ) import DATA_IOREF ( IORef, readIORef, writeIORef ) import DATA_INT import Monad ( when, unless ) import System ( ExitCode(..), getEnv, system ) -import IO ( try, catch, +import IO ( try, catch, hGetContents, openFile, hPutStr, hClose, hFlush, IOMode(..), stderr, ioError, isDoesNotExistError ) import Directory ( doesFileExist, removeFile ) +import Maybe ( isJust ) import List ( partition ) -- GHC <= 4.08 didn't have rawSystem, and runs into problems with long command @@ -462,7 +463,21 @@ runPp dflags args = do runCc :: DynFlags -> [Option] -> IO () runCc dflags args = do let (p,args0) = pgm_c dflags - runSomething dflags "C Compiler" p (args0++args) + runSomethingFiltered dflags cc_filter "C Compiler" p (args0++args) + where + -- discard some harmless warnings from gcc that we can't turn off + cc_filter str = unlines (do_filter (lines str)) + + do_filter [] = [] + do_filter ls@(l:ls') + | (w:rest) <- dropWhile (isJust .matchRegex r_from) ls, + isJust (matchRegex r_warn w) + = do_filter rest + | otherwise + = l : do_filter ls' + + r_from = mkRegex "from.*:[0-9]+" + r_warn = mkRegex "warning: call-clobbered register used" runMangle :: DynFlags -> [Option] -> IO () runMangle dflags args = do @@ -599,12 +614,18 @@ runSomething :: DynFlags -- runSomething will dos-ify them -> IO () -runSomething dflags phase_name pgm args = do +runSomething dflags phase_name pgm args = + runSomethingFiltered dflags id phase_name pgm args + +runSomethingFiltered + :: DynFlags -> (String->String) -> String -> String -> [Option] -> IO () + +runSomethingFiltered dflags filter_fn phase_name pgm args = do let real_args = filter notNull (map showOpt args) traceCmd dflags phase_name (unwords (pgm:real_args)) $ do (exit_code, doesn'tExist) <- IO.catch (do - rc <- builderMainLoop dflags pgm real_args + rc <- builderMainLoop dflags filter_fn pgm real_args case rc of ExitSuccess{} -> return (rc, False) ExitFailure n @@ -636,18 +657,18 @@ runSomething dflags phase_name pgm args = do #if __GLASGOW_HASKELL__ < 603 -builderMainLoop dflags pgm real_args = do +builderMainLoop dflags filter_fn pgm real_args = do rawSystem pgm real_args #else -builderMainLoop dflags pgm real_args = do +builderMainLoop dflags filter_fn pgm real_args = do chan <- newChan (hStdIn, hStdOut, hStdErr, hProcess) <- runInteractiveProcess pgm real_args Nothing Nothing -- and run a loop piping the output from the compiler to the log_action in DynFlags hSetBuffering hStdOut LineBuffering hSetBuffering hStdErr LineBuffering - forkIO (readerProc chan hStdOut) - forkIO (readerProc chan hStdErr) + forkIO (readerProc chan hStdOut filter_fn) + forkIO (readerProc chan hStdErr filter_fn) rc <- loop chan hProcess 2 1 ExitSuccess hClose hStdIn hClose hStdOut @@ -680,30 +701,33 @@ builderMainLoop dflags pgm real_args = do loop chan hProcess (t-1) p exitcode | otherwise -> loop chan hProcess t p exitcode -readerProc chan hdl = loop Nothing `catch` \e -> writeChan chan EOF +readerProc chan hdl filter_fn = + (do str <- hGetContents hdl + loop (lines (filter_fn str)) Nothing) + `finally` + writeChan chan EOF -- ToDo: check errors more carefully + -- ToDo: in the future, the filter should be implemented as + -- a stream transformer. where - loop in_err = do - l <- hGetLine hdl `catch` \e -> do - case in_err of - Just err -> writeChan chan err - Nothing -> return () - ioError e + loop [] Nothing = return () + loop [] (Just err) = writeChan chan err + loop (l:ls) in_err = case in_err of Just err@(BuildError srcLoc msg) | leading_whitespace l -> do - loop (Just (BuildError srcLoc (msg $$ text l))) + loop ls (Just (BuildError srcLoc (msg $$ text l))) | otherwise -> do writeChan chan err - checkError l + checkError l ls Nothing -> do - checkError l + checkError l ls - checkError l + checkError l ls = case matchRegex errRegex l of Nothing -> do writeChan chan (BuildMsg (text l)) - loop Nothing + loop ls Nothing Just (file':lineno':colno':msg:_) -> do let file = mkFastString file' lineno = read lineno'::Int @@ -711,10 +735,10 @@ readerProc chan hdl = loop Nothing `catch` \e -> writeChan chan EOF "" -> 0 _ -> read (init colno') :: Int srcLoc = mkSrcLoc file lineno colno - loop (Just (BuildError srcLoc (text msg))) + loop ls (Just (BuildError srcLoc (text msg))) - leading_whitespace [] = False - leading_whitespace (x:_) = isSpace x + leading_whitespace [] = False + leading_whitespace (x:_) = isSpace x errRegex = mkRegex "^([^:]*):([0-9]+):([0-9]+:)?(.*)" -- 1.7.10.4