Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
1dc458bf
Commit
1dc458bf
authored
May 15, 2011
by
Edward Z. Yang
Browse files
Make -ddump-to-file truncate existing files.
Signed-off-by:
Edward Z. Yang
<
ezyang@mit.edu
>
parent
7365e8ee
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/main/DynFlags.hs
View file @
1dc458bf
...
...
@@ -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
,
...
...
compiler/main/ErrUtils.lhs
View file @
1dc458bf
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment