Commit 5fe6aaa3 authored by Simon Marlow's avatar Simon Marlow

Add -fghci-leak-check to check for space leaks

Summary:
Space leaks in GHCi emerge from time to time and tend to come back again
after they get fixed. This is an attempt to limit regressions by

* adding a reliable detection for some classes of space leaks in GHCi
* turning on leak checking for all GHCi tests in the test suite, so that
  we'll notice if the leak appears again.

The idea for detecting space leaks is quite simple:

* find some data that we expect to be GC'd later, make a weak pointer to it
* when we expect the data to be dead, do a `performGC` and then check
  the status of the weak pointer.

It would be nice to apply this trick to lots of things in GHC,
e.g. ensuring that HsSyn is not retained after the desugarer, or
ensuring that CoreSyn from the previous simplifier pass is not retained.

Test Plan: validate

Reviewers: bgamari, simonpj, erikd, niteria

Subscribers: thomie, carter

GHC Trac Issues: #15111

Differential Revision: https://phabricator.haskell.org/D4658
parent ba6e445e
...@@ -533,6 +533,7 @@ data GeneralFlag ...@@ -533,6 +533,7 @@ data GeneralFlag
| Opt_IgnoreDotGhci | Opt_IgnoreDotGhci
| Opt_GhciSandbox | Opt_GhciSandbox
| Opt_GhciHistory | Opt_GhciHistory
| Opt_GhciLeakCheck
| Opt_LocalGhciHistory | Opt_LocalGhciHistory
| Opt_NoIt | Opt_NoIt
| Opt_HelpfulErrors | Opt_HelpfulErrors
...@@ -3934,6 +3935,7 @@ fFlagsDeps = [ ...@@ -3934,6 +3935,7 @@ fFlagsDeps = [
flagSpec "fun-to-thunk" Opt_FunToThunk, flagSpec "fun-to-thunk" Opt_FunToThunk,
flagSpec "gen-manifest" Opt_GenManifest, flagSpec "gen-manifest" Opt_GenManifest,
flagSpec "ghci-history" Opt_GhciHistory, flagSpec "ghci-history" Opt_GhciHistory,
flagSpec "ghci-leak-check" Opt_GhciLeakCheck,
flagGhciSpec "local-ghci-history" Opt_LocalGhciHistory, flagGhciSpec "local-ghci-history" Opt_LocalGhciHistory,
flagGhciSpec "no-it" Opt_NoIt, flagGhciSpec "no-it" Opt_NoIt,
flagSpec "ghci-sandbox" Opt_GhciSandbox, flagSpec "ghci-sandbox" Opt_GhciSandbox,
......
...@@ -2025,6 +2025,17 @@ mostly obvious. ...@@ -2025,6 +2025,17 @@ mostly obvious.
It will create ``.ghci-history`` in current folder where GHCi is launched. 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 Packages
~~~~~~~~ ~~~~~~~~
......
{-# 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!")
...@@ -134,6 +134,8 @@ import GHC.IO.Exception ( IOErrorType(InvalidArgument) ) ...@@ -134,6 +134,8 @@ import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
import GHC.IO.Handle ( hFlushAll ) import GHC.IO.Handle ( hFlushAll )
import GHC.TopHandler ( topHandler ) import GHC.TopHandler ( topHandler )
import GHCi.Leak
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
data GhciSettings = GhciSettings { data GhciSettings = GhciSettings {
...@@ -1646,6 +1648,14 @@ loadModule' files = do ...@@ -1646,6 +1648,14 @@ loadModule' files = do
-- require some re-working of the GHC interface, so we'll leave it -- require some re-working of the GHC interface, so we'll leave it
-- as a ToDo for now. -- 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 -- unload first
_ <- GHC.abandonAll _ <- GHC.abandonAll
lift discardActiveBreakPoints lift discardActiveBreakPoints
...@@ -1653,7 +1663,10 @@ loadModule' files = do ...@@ -1653,7 +1663,10 @@ loadModule' files = do
_ <- GHC.load LoadAllTargets _ <- GHC.load LoadAllTargets
GHC.setTargets targets GHC.setTargets targets
doLoadAndCollectInfo False LoadAllTargets success <- doLoadAndCollectInfo False LoadAllTargets
when (gopt Opt_GhciLeakCheck (hsc_dflags hsc_env)) $
liftIO $ checkLeakIndicators (hsc_dflags hsc_env) leak_indicators
return success
-- | @:add@ command -- | @:add@ command
addModule :: [FilePath] -> InputT GHCi () addModule :: [FilePath] -> InputT GHCi ()
......
...@@ -61,6 +61,7 @@ Executable ghc ...@@ -61,6 +61,7 @@ Executable ghc
CPP-Options: -DGHCI CPP-Options: -DGHCI
GHC-Options: -fno-warn-name-shadowing GHC-Options: -fno-warn-name-shadowing
Other-Modules: Other-Modules:
GHCi.Leak
GHCi.UI GHCi.UI
GHCi.UI.Info GHCi.UI.Info
GHCi.UI.Monad GHCi.UI.Monad
......
...@@ -80,7 +80,7 @@ config.way_flags = { ...@@ -80,7 +80,7 @@ config.way_flags = {
'prof_no_auto' : ['-prof', '-static', '-fasm'], 'prof_no_auto' : ['-prof', '-static', '-fasm'],
'profasm' : ['-O', '-prof', '-static', '-fprof-auto'], 'profasm' : ['-O', '-prof', '-static', '-fprof-auto'],
'profthreaded' : ['-O', '-prof', '-static', '-fprof-auto', '-threaded'], 'profthreaded' : ['-O', '-prof', '-static', '-fprof-auto', '-threaded'],
'ghci' : ['--interactive', '-v0', '-ignore-dot-ghci', '-fno-ghci-history', '+RTS', '-I0.1', '-RTS'], 'ghci' : ['--interactive', '-v0', '-ignore-dot-ghci', '-fno-ghci-history', '-fghci-leak-check', '+RTS', '-I0.1', '-RTS'],
'sanity' : ['-debug'], 'sanity' : ['-debug'],
'threaded1' : ['-threaded', '-debug'], 'threaded1' : ['-threaded', '-debug'],
'threaded1_ls' : ['-threaded', '-debug'], 'threaded1_ls' : ['-threaded', '-debug'],
......
...@@ -10,6 +10,7 @@ other dynamic, non-language, flag settings: ...@@ -10,6 +10,7 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes -fignore-optim-changes
-fignore-hpc-changes -fignore-hpc-changes
-fno-ghci-history -fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified -fimplicit-import-qualified
-fshow-warning-groups -fshow-warning-groups
warning settings: warning settings:
...@@ -29,6 +30,7 @@ other dynamic, non-language, flag settings: ...@@ -29,6 +30,7 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes -fignore-optim-changes
-fignore-hpc-changes -fignore-hpc-changes
-fno-ghci-history -fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified -fimplicit-import-qualified
-fshow-warning-groups -fshow-warning-groups
warning settings: warning settings:
...@@ -47,6 +49,7 @@ other dynamic, non-language, flag settings: ...@@ -47,6 +49,7 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes -fignore-optim-changes
-fignore-hpc-changes -fignore-hpc-changes
-fno-ghci-history -fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified -fimplicit-import-qualified
-fshow-warning-groups -fshow-warning-groups
warning settings: warning settings:
...@@ -67,6 +70,7 @@ other dynamic, non-language, flag settings: ...@@ -67,6 +70,7 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes -fignore-optim-changes
-fignore-hpc-changes -fignore-hpc-changes
-fno-ghci-history -fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified -fimplicit-import-qualified
-fshow-warning-groups -fshow-warning-groups
warning settings: warning settings:
......
...@@ -10,6 +10,7 @@ other dynamic, non-language, flag settings: ...@@ -10,6 +10,7 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes -fignore-optim-changes
-fignore-hpc-changes -fignore-hpc-changes
-fno-ghci-history -fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified -fimplicit-import-qualified
-fshow-warning-groups -fshow-warning-groups
warning settings: warning settings:
...@@ -29,6 +30,7 @@ other dynamic, non-language, flag settings: ...@@ -29,6 +30,7 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes -fignore-optim-changes
-fignore-hpc-changes -fignore-hpc-changes
-fno-ghci-history -fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified -fimplicit-import-qualified
-fshow-warning-groups -fshow-warning-groups
warning settings: warning settings:
...@@ -47,6 +49,7 @@ other dynamic, non-language, flag settings: ...@@ -47,6 +49,7 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes -fignore-optim-changes
-fignore-hpc-changes -fignore-hpc-changes
-fno-ghci-history -fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified -fimplicit-import-qualified
-fshow-warning-groups -fshow-warning-groups
warning settings: warning settings:
...@@ -67,6 +70,7 @@ other dynamic, non-language, flag settings: ...@@ -67,6 +70,7 @@ other dynamic, non-language, flag settings:
-fignore-optim-changes -fignore-optim-changes
-fignore-hpc-changes -fignore-hpc-changes
-fno-ghci-history -fno-ghci-history
-fghci-leak-check
-fimplicit-import-qualified -fimplicit-import-qualified
-fshow-warning-groups -fshow-warning-groups
warning settings: warning settings:
......
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