Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
87e169a3
Commit
87e169a3
authored
May 10, 2018
by
Simon Marlow
Browse files
Revert "Add -fghci-leak-check to check for space leaks"
This reverts commit
5fe6aaa3
.
parent
e5bb515e
Changes
8
Hide whitespace changes
Inline
Side-by-side
compiler/main/DynFlags.hs
View file @
87e169a3
...
...
@@ -533,7 +533,6 @@ data GeneralFlag
|
Opt_IgnoreDotGhci
|
Opt_GhciSandbox
|
Opt_GhciHistory
|
Opt_GhciLeakCheck
|
Opt_LocalGhciHistory
|
Opt_NoIt
|
Opt_HelpfulErrors
...
...
@@ -3935,7 +3934,6 @@ fFlagsDeps = [
flagSpec
"fun-to-thunk"
Opt_FunToThunk
,
flagSpec
"gen-manifest"
Opt_GenManifest
,
flagSpec
"ghci-history"
Opt_GhciHistory
,
flagSpec
"ghci-leak-check"
Opt_GhciLeakCheck
,
flagGhciSpec
"local-ghci-history"
Opt_LocalGhciHistory
,
flagGhciSpec
"no-it"
Opt_NoIt
,
flagSpec
"ghci-sandbox"
Opt_GhciSandbox
,
...
...
docs/users_guide/ghci.rst
View file @
87e169a3
...
...
@@ -2025,17 +2025,6 @@ mostly obvious.
It will create ``.ghci-history`` in current folder where GHCi is launched.
.. ghc-flag:: -fghci-leak-check
:shortdesc: (Debugging only) check for space leaks when loading
new modules in GHCi.
:type: dynamic
:reverse: -fno-ghci-leak-check
:category:
(Debugging only) When loading new modules with ``:load``, check
that any previously loaded modules have been correctly garbage
collected. Emits messages if a leak is detected.
Packages
~~~~~~~~
...
...
ghc/GHCi/Leak.hs
deleted
100644 → 0
View file @
e5bb515e
{-# LANGUAGE RecordWildCards, LambdaCase #-}
module
GHCi.Leak
(
LeakIndicators
,
getLeakIndicators
,
checkLeakIndicators
)
where
import
Control.Monad
import
GHC
import
Outputable
import
HscTypes
import
UniqDFM
import
System.Mem
import
System.Mem.Weak
-- Checking for space leaks in GHCi. See #15111, and the
-- -fghci-leak-check flag.
data
LeakIndicators
=
LeakIndicators
[
LeakModIndicators
]
data
LeakModIndicators
=
LeakModIndicators
{
leakMod
::
Weak
HomeModInfo
,
leakIface
::
Weak
ModIface
,
leakDetails
::
Weak
ModDetails
,
leakLinkable
::
Maybe
(
Weak
Linkable
)
}
-- | Grab weak references to some of the data structures representing
-- the currently loaded modules.
getLeakIndicators
::
HscEnv
->
IO
LeakIndicators
getLeakIndicators
HscEnv
{
..
}
=
fmap
LeakIndicators
$
forM
(
eltsUDFM
hsc_HPT
)
$
\
hmi
@
HomeModInfo
{
..
}
->
do
leakMod
<-
mkWeakPtr
hmi
Nothing
leakIface
<-
mkWeakPtr
hm_iface
Nothing
leakDetails
<-
mkWeakPtr
hm_details
Nothing
leakLinkable
<-
mapM
(`
mkWeakPtr
`
Nothing
)
hm_linkable
return
$
LeakModIndicators
{
..
}
-- | Look at the LeakIndicators collected by an earlier call to
-- `getLeakIndicators`, and print messasges if any of them are still
-- alive.
checkLeakIndicators
::
DynFlags
->
LeakIndicators
->
IO
()
checkLeakIndicators
dflags
(
LeakIndicators
leakmods
)
=
do
performGC
forM_
leakmods
$
\
LeakModIndicators
{
..
}
->
do
deRefWeak
leakMod
>>=
\
case
Nothing
->
return
()
Just
hmi
->
report
(
"HomeModInfo for "
++
showSDoc
dflags
(
ppr
(
mi_module
(
hm_iface
hmi
))))
(
Just
hmi
)
deRefWeak
leakIface
>>=
report
"ModIface"
deRefWeak
leakDetails
>>=
report
"ModDetails"
forM_
leakLinkable
$
\
l
->
deRefWeak
l
>>=
report
"Linkable"
where
report
::
String
->
Maybe
a
->
IO
()
report
_
Nothing
=
return
()
report
msg
(
Just
_
)
=
putStrLn
(
"-fghci-leak-check: "
++
msg
++
" is still alive!"
)
ghc/GHCi/UI.hs
View file @
87e169a3
...
...
@@ -134,8 +134,6 @@ import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
import
GHC.IO.Handle
(
hFlushAll
)
import
GHC.TopHandler
(
topHandler
)
import
GHCi.Leak
-----------------------------------------------------------------------------
data
GhciSettings
=
GhciSettings
{
...
...
@@ -1648,14 +1646,6 @@ loadModule' files = do
-- require some re-working of the GHC interface, so we'll leave it
-- as a ToDo for now.
hsc_env
<-
GHC
.
getSession
-- Grab references to the currently loaded modules so that we can
-- see if they leak.
leak_indicators
<-
if
gopt
Opt_GhciLeakCheck
(
hsc_dflags
hsc_env
)
then
liftIO
$
getLeakIndicators
hsc_env
else
return
(
panic
"no leak indicators"
)
-- unload first
_
<-
GHC
.
abandonAll
lift
discardActiveBreakPoints
...
...
@@ -1663,10 +1653,7 @@ loadModule' files = do
_
<-
GHC
.
load
LoadAllTargets
GHC
.
setTargets
targets
success
<-
doLoadAndCollectInfo
False
LoadAllTargets
when
(
gopt
Opt_GhciLeakCheck
(
hsc_dflags
hsc_env
))
$
liftIO
$
checkLeakIndicators
(
hsc_dflags
hsc_env
)
leak_indicators
return
success
doLoadAndCollectInfo
False
LoadAllTargets
-- | @:add@ command
addModule
::
[
FilePath
]
->
InputT
GHCi
()
...
...
ghc/ghc-bin.cabal.in
View file @
87e169a3
...
...
@@ -61,7 +61,6 @@ Executable ghc
CPP-Options: -DGHCI
GHC-Options: -fno-warn-name-shadowing
Other-Modules:
GHCi.Leak
GHCi.UI
GHCi.UI.Info
GHCi.UI.Monad
...
...
testsuite/config/ghc
View file @
87e169a3
...
...
@@ -80,7 +80,7 @@ config.way_flags = {
'prof_no_auto' : ['-prof', '-static', '-fasm'],
'profasm' : ['-O', '-prof', '-static', '-fprof-auto'],
'profthreaded' : ['-O', '-prof', '-static', '-fprof-auto', '-threaded'],
'ghci' : ['--interactive', '-v0', '-ignore-dot-ghci', '-fno-ghci-history',
'-fghci-leak-check',
'+RTS', '-I0.1', '-RTS'],
'ghci' : ['--interactive', '-v0', '-ignore-dot-ghci', '-fno-ghci-history', '+RTS', '-I0.1', '-RTS'],
'sanity' : ['-debug'],
'threaded1' : ['-threaded', '-debug'],
'threaded1_ls' : ['-threaded', '-debug'],
...
...
testsuite/tests/ghci/scripts/T9293.stdout
View file @
87e169a3
...
...
@@ -10,7 +10,6 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes
-fignore-hpc-changes
-fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified
-fshow-warning-groups
warning settings:
...
...
@@ -30,7 +29,6 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes
-fignore-hpc-changes
-fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified
-fshow-warning-groups
warning settings:
...
...
@@ -49,7 +47,6 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes
-fignore-hpc-changes
-fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified
-fshow-warning-groups
warning settings:
...
...
@@ -70,7 +67,6 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes
-fignore-hpc-changes
-fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified
-fshow-warning-groups
warning settings:
...
...
testsuite/tests/ghci/scripts/ghci057.stdout
View file @
87e169a3
...
...
@@ -10,7 +10,6 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes
-fignore-hpc-changes
-fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified
-fshow-warning-groups
warning settings:
...
...
@@ -30,7 +29,6 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes
-fignore-hpc-changes
-fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified
-fshow-warning-groups
warning settings:
...
...
@@ -49,7 +47,6 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes
-fignore-hpc-changes
-fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified
-fshow-warning-groups
warning settings:
...
...
@@ -70,7 +67,6 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes
-fignore-hpc-changes
-fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified
-fshow-warning-groups
warning settings:
...
...
Write
Preview
Markdown
is supported
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