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
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import System.FilePath
import System.IO ( stderr, hPutChar )
......@@ -494,6 +496,11 @@ data DynFlags = DynFlags {
filesToClean :: IORef [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
flags :: [DynFlag],
-- Don't change this without updating extensionFlags:
......@@ -730,12 +737,14 @@ initDynFlags dflags = do
ways <- readIORef v_Ways
refFilesToClean <- newIORef []
refDirsToClean <- newIORef Map.empty
refGeneratedDumps <- newIORef Set.empty
return dflags{
ways = ways,
buildTag = mkBuildTag (filter (not . wayRTSOnly) ways),
rtsBuildTag = mkBuildTag ways,
filesToClean = refFilesToClean,
dirsToClean = refDirsToClean
dirsToClean = refDirsToClean,
generatedDumps = refGeneratedDumps
}
-- | The normal 'DynFlags'. Note that they is not suitable for use in this form
......@@ -811,6 +820,7 @@ defaultDynFlags mySettings =
-- end of ghc -M values
filesToClean = panic "defaultDynFlags: No filesToClean",
dirsToClean = panic "defaultDynFlags: No dirsToClean",
generatedDumps = panic "defaultDynFlags: No generatedDumps",
haddockOptions = Nothing,
flags = defaultFlags,
language = Nothing,
......
......@@ -41,6 +41,9 @@ import StaticFlags ( opt_ErrorSpans )
import System.Exit ( ExitCode(..), exitWith )
import Data.List
import qualified Data.Set as Set
import Data.IORef
import Control.Monad
import System.IO
-- -----------------------------------------------------------------------------
......@@ -208,19 +211,26 @@ mkDumpDoc hdr doc
-- otherwise emit to stdout.
dumpSDoc :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
dumpSDoc dflags dflag hdr doc
= do let mFile = chooseDumpFile dflags dflag
case mFile of
-- write the dump to a file
-- don't add the header in this case, we can see what kind
-- of dump it is from the filename.
Just fileName
-> do handle <- openFile fileName AppendMode
hPrintDump handle doc
hClose handle
-- write the dump to stdout
Nothing
-> do printDump (mkDumpDoc hdr doc)
= do let mFile = chooseDumpFile dflags dflag
case mFile of
-- write the dump to a file
-- don't add the header in this case, we can see what kind
-- of dump it is from the filename.
Just fileName
-> do
let gdref = generatedDumps dflags
gd <- readIORef gdref
let append = Set.member fileName gd
mode = if append then AppendMode else WriteMode
when (not append) $
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
......
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