Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alfredo Di Napoli
GHC
Commits
c5597bb6
Commit
c5597bb6
authored
Dec 03, 2015
by
Ben Gamari
🐢
Browse files
Revert "Create empty dump files when there was nothing to dump"
This reverts commit
8cba907a
which broke `-ddump-to-file`.
parent
a034031a
Changes
7
Hide whitespace changes
Inline
Side-by-side
compiler/main/DriverPipeline.hs
View file @
c5597bb6
...
...
@@ -649,13 +649,8 @@ runPipeline' start_phase hsc_env env input_fn
=
do
-- Execute the pipeline...
let
state
=
PipeState
{
hsc_env
,
maybe_loc
,
maybe_stub_o
=
maybe_stub_o
}
dflags
=
extractDynFlags
hsc_env
-- #10320: Open dump files for writing. Any existing dump specified
-- in 'dflags' will be truncated.
bracket_
(
openDumpFiles
dflags
)
(
closeDumpFiles
dflags
)
(
evalP
(
pipeLoop
start_phase
input_fn
)
env
state
)
evalP
(
pipeLoop
start_phase
input_fn
)
env
state
-- ---------------------------------------------------------------------------
-- outer pipeline loop
...
...
compiler/main/DynFlags.hs
View file @
c5597bb6
...
...
@@ -806,7 +806,7 @@ data DynFlags = DynFlags {
-- 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
(
Map
FilePath
Handle
),
generatedDumps
::
IORef
(
Set
FilePath
),
-- hsc dynamic flags
dumpFlags
::
IntSet
,
...
...
@@ -1386,7 +1386,7 @@ initDynFlags dflags = do
refFilesToClean
<-
newIORef
[]
refDirsToClean
<-
newIORef
Map
.
empty
refFilesToNotIntermediateClean
<-
newIORef
[]
refGeneratedDumps
<-
newIORef
Map
.
empty
refGeneratedDumps
<-
newIORef
Set
.
empty
refRtldInfo
<-
newIORef
Nothing
refRtccInfo
<-
newIORef
Nothing
wrapperNum
<-
newIORef
emptyModuleEnv
...
...
compiler/main/ErrUtils.hs
View file @
c5597bb6
...
...
@@ -33,7 +33,6 @@ module ErrUtils (
-- * Dump files
dumpIfSet
,
dumpIfSet_dyn
,
dumpIfSet_dyn_printer
,
mkDumpDoc
,
dumpSDoc
,
openDumpFiles
,
closeDumpFiles
,
-- * Issuing messages during compilation
putMsg
,
printInfoForUser
,
printOutputForUser
,
...
...
@@ -61,7 +60,7 @@ import System.Directory
import
System.Exit
(
ExitCode
(
..
),
exitWith
)
import
System.FilePath
(
takeDirectory
,
(
</>
)
)
import
Data.List
import
qualified
Data.
Map
as
Map
import
qualified
Data.
Set
as
Set
import
Data.IORef
import
Data.Maybe
(
fromMaybe
)
import
Data.Ord
...
...
@@ -300,15 +299,6 @@ dumpIfSet_dyn_printer :: PrintUnqualified
dumpIfSet_dyn_printer
printer
dflags
flag
doc
=
when
(
dopt
flag
dflags
)
$
dumpSDoc
dflags
printer
flag
""
doc
-- | a wrapper around 'dumpSDoc'.
-- First check whether the dump flag is set
-- Do nothing if it is unset
--
-- Makes a dummy write operation into the dump
dumpIfSet_dyn_empty
::
DynFlags
->
DumpFlag
->
IO
()
dumpIfSet_dyn_empty
dflags
flag
=
when
(
dopt
flag
dflags
)
$
dumpSDoc
dflags
neverQualify
flag
""
empty
mkDumpDoc
::
String
->
SDoc
->
SDoc
mkDumpDoc
hdr
doc
=
vcat
[
blankLine
,
...
...
@@ -318,23 +308,6 @@ mkDumpDoc hdr doc
where
line
=
text
(
replicate
20
'='
)
-- | Open dump files from DynFlags for writing
--
-- #10320: This function should be called once before the pipe line
-- is started. It writes empty data into all requested dumps to initiate
-- their creation.
openDumpFiles
::
DynFlags
->
IO
()
openDumpFiles
dflags
=
let
flags
=
enumFrom
(
toEnum
0
::
DumpFlag
)
in
mapM_
(
dumpIfSet_dyn_empty
dflags
)
flags
-- | Close all opened dump files
--
closeDumpFiles
::
DynFlags
->
IO
()
closeDumpFiles
dflags
=
do
gd
<-
readIORef
$
generatedDumps
dflags
mapM_
hClose
$
Map
.
elems
gd
-- | Write out a dump.
-- If --dump-to-file is set then this goes to a file.
...
...
@@ -350,16 +323,32 @@ dumpSDoc dflags print_unqual flag hdr doc
=
do
let
mFile
=
chooseDumpFile
dflags
flag
dump_style
=
mkDumpStyle
print_unqual
case
mFile
of
Just
fileName
->
do
handle
<-
getDumpFileHandle
dflags
fileName
doc'
<-
if
null
hdr
then
return
doc
else
do
t
<-
getCurrentTime
let
d
=
text
(
show
t
)
$$
blankLine
$$
doc
return
$
mkDumpDoc
hdr
d
defaultLogActionHPrintDoc
dflags
handle
doc'
dump_style
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
)
createDirectoryIfMissing
True
(
takeDirectory
fileName
)
handle
<-
openFile
fileName
mode
-- We do not want the dump file to be affected by
-- environment variables, but instead to always use
-- UTF8. See:
-- https://ghc.haskell.org/trac/ghc/ticket/10762
hSetEncoding
handle
utf8
doc'
<-
if
null
hdr
then
return
doc
else
do
t
<-
getCurrentTime
let
d
=
text
(
show
t
)
$$
blankLine
$$
doc
return
$
mkDumpDoc
hdr
d
defaultLogActionHPrintDoc
dflags
handle
doc'
dump_style
hClose
handle
-- write the dump to stdout
Nothing
->
do
...
...
@@ -368,31 +357,6 @@ dumpSDoc dflags print_unqual flag hdr doc
|
otherwise
=
(
mkDumpDoc
hdr
doc
,
SevDump
)
log_action
dflags
dflags
severity
noSrcSpan
dump_style
doc'
-- | Return a handle assigned to the given filename.
--
-- If the requested file doesn't exist the new one will be created
getDumpFileHandle
::
DynFlags
->
FilePath
->
IO
Handle
getDumpFileHandle
dflags
fileName
=
do
let
gdref
=
generatedDumps
dflags
gd
<-
readIORef
gdref
let
mHandle
=
Map
.
lookup
fileName
gd
case
mHandle
of
Just
handle
->
return
handle
Nothing
->
do
createDirectoryIfMissing
True
(
takeDirectory
fileName
)
handle
<-
openFile
fileName
WriteMode
-- We do not want the dump file to be affected by
-- environment variables, but instead to always use
-- UTF8. See:
-- https://ghc.haskell.org/trac/ghc/ticket/10762
hSetEncoding
handle
utf8
writeIORef
gdref
(
Map
.
insert
fileName
handle
gd
)
return
handle
-- | Choose where to put a dump file based on DynFlags
--
...
...
testsuite/tests/driver/Makefile
View file @
c5597bb6
...
...
@@ -609,42 +609,3 @@ T10182:
"
$(TEST_HC)
"
$(TEST_HC_OPTS)
-c
T10182.hs-boot
"
$(TEST_HC)
"
$(TEST_HC_OPTS)
-c
T10182a.hs
"
$(TEST_HC)
"
$(TEST_HC_OPTS)
-c
T10182.hs
.PHONY
:
T10320a
T10320a
:
# check if an empty .dump-rule-rewrites is created when no rules were applied
$(RM)
-rf
T10320dump
$(CP)
T10320-without-rules.hs T10320.hs
"
$(TEST_HC)
"
$(TEST_HC_OPTS)
-O
-c
T10320.hs
-dumpdir
T10320dump
-ddump-to-file
-ddump-rule-rewrites
[
-e
T10320dump/T10320.dump-rule-rewrites
]
.PHONY
:
T10320b
T10320b
:
# check if an empty .dump-rule-firings is created when no rules were applied
$(RM)
-rf
T10320dump
$(CP)
T10320-without-rules.hs T10320.hs
"
$(TEST_HC)
"
$(TEST_HC_OPTS)
-O
-c
T10320.hs
-dumpdir
T10320dump
-ddump-to-file
-ddump-rule-firings
[
-e
T10320dump/T10320.dump-rule-firings
]
.PHONY
:
T10320c
T10320c
:
# check if existing .dump-rule-rewrites has been rewritten by an empty one when no rules were applied
$(RM)
-rf
T10320dump
$(CP)
T10320-with-rule.hs T10320.hs
"
$(TEST_HC)
"
$(TEST_HC_OPTS)
-O
-c
T10320.hs
-dumpdir
T10320dump
-ddump-to-file
-ddump-rule-rewrites
# generate a non-empty dump
$(CP)
T10320-without-rules.hs T10320.hs
"
$(TEST_HC)
"
$(TEST_HC_OPTS)
-O
-c
T10320.hs
-dumpdir
T10320dump
-ddump-to-file
-ddump-rule-rewrites
[
-e
T10320dump/T10320.dump-rule-rewrites
-a
!
-s
T10320dump/T10320.dump-rule-rewrites
]
# check if the file exists and has zero size
.PHONY
:
T10320d
T10320d
:
# check if existing .dump-rule-firings has been rewritten by an empty one when no rules were applied
$(RM)
-rf
T10320dump
$(CP)
T10320-with-rule.hs T10320.hs
"
$(TEST_HC)
"
$(TEST_HC_OPTS)
-O
-c
T10320.hs
-dumpdir
T10320dump
-ddump-to-file
-ddump-rule-firings
# generate a non-empty dump
$(CP)
T10320-without-rules.hs T10320.hs
"
$(TEST_HC)
"
$(TEST_HC_OPTS)
-O
-c
T10320.hs
-dumpdir
T10320dump
-ddump-to-file
-ddump-rule-firings
[
-e
T10320dump/T10320.dump-rule-firings
-a
!
-s
T10320dump/T10320.dump-rule-firings
]
# check if the file exists and has zero size
.PHONY
:
T10320
T10320
:
T10320a T10320b T10320c T10320d
testsuite/tests/driver/T10320-with-rule.hs
deleted
100644 → 0
View file @
a034031a
module
T10320
where
{-# RULES "rule" forall x. f x = 42 #-}
f
::
Int
->
Int
f
x
=
x
{-# NOINLINE [1] f #-}
n
=
f
(
0
::
Int
)
testsuite/tests/driver/T10320-without-rules.hs
deleted
100644 → 0
View file @
a034031a
module
T10320
where
n
::
Int
n
=
42
testsuite/tests/driver/all.T
View file @
c5597bb6
...
...
@@ -460,13 +460,3 @@ test('T9360b', normal, run_command, ['{compiler} -e "" --interactive'])
test
('
T10970
',
normal
,
compile_and_run
,
['
-hide-all-packages -package base -package containers
'])
test
('
T10970a
',
normal
,
compile_and_run
,
[''])
test
('
T4931
',
normal
,
compile_and_run
,
[''])
test
('
T10320
',
[
extra_clean
([
'
T10320dump/T10320.dump-rule-firings
',
'
T10320dump/T10320.dump-rule-rewrites
',
'
T10320dump
',
'
T10320.hs
'
]),
],
run_command
,
['
$MAKE -s --no-print-directory T10320
'])
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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