Commit 1dc458bf authored by Edward Z. Yang's avatar Edward Z. Yang

Make -ddump-to-file truncate existing files.

Signed-off-by: Edward Z. Yang's avatarEdward Z. Yang <ezyang@mit.edu>
parent 7365e8ee
...@@ -108,6 +108,8 @@ import Data.Char ...@@ -108,6 +108,8 @@ import Data.Char
import Data.List import Data.List
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import System.FilePath import System.FilePath
import System.IO ( stderr, hPutChar ) import System.IO ( stderr, hPutChar )
...@@ -494,6 +496,11 @@ data DynFlags = DynFlags { ...@@ -494,6 +496,11 @@ data DynFlags = DynFlags {
filesToClean :: IORef [FilePath], filesToClean :: IORef [FilePath],
dirsToClean :: IORef (Map FilePath FilePath), dirsToClean :: IORef (Map FilePath FilePath),
-- Names of files which were generated from -ddump-to-file; used to
-- track which ones we need to truncate because it's our first run
-- through
generatedDumps :: IORef (Set FilePath),
-- hsc dynamic flags -- hsc dynamic flags
flags :: [DynFlag], flags :: [DynFlag],
-- Don't change this without updating extensionFlags: -- Don't change this without updating extensionFlags:
...@@ -730,12 +737,14 @@ initDynFlags dflags = do ...@@ -730,12 +737,14 @@ initDynFlags dflags = do
ways <- readIORef v_Ways ways <- readIORef v_Ways
refFilesToClean <- newIORef [] refFilesToClean <- newIORef []
refDirsToClean <- newIORef Map.empty refDirsToClean <- newIORef Map.empty
refGeneratedDumps <- newIORef Set.empty
return dflags{ return dflags{
ways = ways, ways = ways,
buildTag = mkBuildTag (filter (not . wayRTSOnly) ways), buildTag = mkBuildTag (filter (not . wayRTSOnly) ways),
rtsBuildTag = mkBuildTag ways, rtsBuildTag = mkBuildTag ways,
filesToClean = refFilesToClean, filesToClean = refFilesToClean,
dirsToClean = refDirsToClean dirsToClean = refDirsToClean,
generatedDumps = refGeneratedDumps
} }
-- | The normal 'DynFlags'. Note that they is not suitable for use in this form -- | The normal 'DynFlags'. Note that they is not suitable for use in this form
...@@ -811,6 +820,7 @@ defaultDynFlags mySettings = ...@@ -811,6 +820,7 @@ defaultDynFlags mySettings =
-- end of ghc -M values -- end of ghc -M values
filesToClean = panic "defaultDynFlags: No filesToClean", filesToClean = panic "defaultDynFlags: No filesToClean",
dirsToClean = panic "defaultDynFlags: No dirsToClean", dirsToClean = panic "defaultDynFlags: No dirsToClean",
generatedDumps = panic "defaultDynFlags: No generatedDumps",
haddockOptions = Nothing, haddockOptions = Nothing,
flags = defaultFlags, flags = defaultFlags,
language = Nothing, language = Nothing,
......
...@@ -41,6 +41,9 @@ import StaticFlags ( opt_ErrorSpans ) ...@@ -41,6 +41,9 @@ import StaticFlags ( opt_ErrorSpans )
import System.Exit ( ExitCode(..), exitWith ) import System.Exit ( ExitCode(..), exitWith )
import Data.List import Data.List
import qualified Data.Set as Set
import Data.IORef
import Control.Monad
import System.IO import System.IO
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
...@@ -208,19 +211,26 @@ mkDumpDoc hdr doc ...@@ -208,19 +211,26 @@ mkDumpDoc hdr doc
-- otherwise emit to stdout. -- otherwise emit to stdout.
dumpSDoc :: DynFlags -> DynFlag -> String -> SDoc -> IO () dumpSDoc :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
dumpSDoc dflags dflag hdr doc dumpSDoc dflags dflag hdr doc
= do let mFile = chooseDumpFile dflags dflag = do let mFile = chooseDumpFile dflags dflag
case mFile of case mFile of
-- write the dump to a file -- write the dump to a file
-- don't add the header in this case, we can see what kind -- don't add the header in this case, we can see what kind
-- of dump it is from the filename. -- of dump it is from the filename.
Just fileName Just fileName
-> do handle <- openFile fileName AppendMode -> do
hPrintDump handle doc let gdref = generatedDumps dflags
hClose handle gd <- readIORef gdref
let append = Set.member fileName gd
-- write the dump to stdout mode = if append then AppendMode else WriteMode
Nothing when (not append) $
-> do printDump (mkDumpDoc hdr doc) writeIORef gdref (Set.insert fileName gd)
handle <- openFile fileName mode
hPrintDump handle doc
hClose handle
-- write the dump to stdout
Nothing
-> printDump (mkDumpDoc hdr doc)
-- | Choose where to put a dump file based on DynFlags -- | Choose where to put a dump file based on DynFlags
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment