summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/main/DynFlags.hs2
-rw-r--r--docs/users_guide/ghci.rst11
-rw-r--r--ghc/GHCi/Leak.hs59
-rw-r--r--ghc/GHCi/UI.hs15
-rw-r--r--ghc/ghc-bin.cabal.in1
-rw-r--r--testsuite/config/ghc2
-rw-r--r--testsuite/tests/ghci/scripts/T9293.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/ghci057.stdout4
8 files changed, 96 insertions, 2 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 0d49327f47..0406d0e03a 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -534,6 +534,7 @@ data GeneralFlag
| Opt_IgnoreDotGhci
| Opt_GhciSandbox
| Opt_GhciHistory
+ | Opt_GhciLeakCheck
| Opt_LocalGhciHistory
| Opt_NoIt
| Opt_HelpfulErrors
@@ -3893,6 +3894,7 @@ 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,
diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst
index f5dcfe3962..a5f5764a9e 100644
--- a/docs/users_guide/ghci.rst
+++ b/docs/users_guide/ghci.rst
@@ -2025,6 +2025,17 @@ 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
~~~~~~~~
diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs
new file mode 100644
index 0000000000..3f64b5dcf0
--- /dev/null
+++ b/ghc/GHCi/Leak.hs
@@ -0,0 +1,59 @@
+{-# 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!")
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 3ed1c7f6a3..d449b3ca83 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -134,6 +134,8 @@ import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
import GHC.IO.Handle ( hFlushAll )
import GHC.TopHandler ( topHandler )
+import GHCi.Leak
+
-----------------------------------------------------------------------------
data GhciSettings = GhciSettings {
@@ -1642,6 +1644,14 @@ 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
@@ -1649,7 +1659,10 @@ loadModule' files = do
_ <- GHC.load LoadAllTargets
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
addModule :: [FilePath] -> InputT GHCi ()
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index 12812ef07c..6c12941630 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -61,6 +61,7 @@ Executable ghc
CPP-Options: -DGHCI
GHC-Options: -fno-warn-name-shadowing
Other-Modules:
+ GHCi.Leak
GHCi.UI
GHCi.UI.Info
GHCi.UI.Monad
diff --git a/testsuite/config/ghc b/testsuite/config/ghc
index 6296394197..f41f372cb2 100644
--- a/testsuite/config/ghc
+++ b/testsuite/config/ghc
@@ -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', '+RTS', '-I0.1', '-RTS'],
+ 'ghci' : ['--interactive', '-v0', '-ignore-dot-ghci', '-fno-ghci-history', '-fghci-leak-check', '+RTS', '-I0.1', '-RTS'],
'sanity' : ['-debug'],
'threaded1' : ['-threaded', '-debug'],
'threaded1_ls' : ['-threaded', '-debug'],
diff --git a/testsuite/tests/ghci/scripts/T9293.stdout b/testsuite/tests/ghci/scripts/T9293.stdout
index 2e5adc404c..4fdd3504bc 100644
--- a/testsuite/tests/ghci/scripts/T9293.stdout
+++ b/testsuite/tests/ghci/scripts/T9293.stdout
@@ -10,6 +10,7 @@ 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:
@@ -29,6 +30,7 @@ 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:
@@ -47,6 +49,7 @@ 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:
@@ -67,6 +70,7 @@ 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:
diff --git a/testsuite/tests/ghci/scripts/ghci057.stdout b/testsuite/tests/ghci/scripts/ghci057.stdout
index 2e5adc404c..4fdd3504bc 100644
--- a/testsuite/tests/ghci/scripts/ghci057.stdout
+++ b/testsuite/tests/ghci/scripts/ghci057.stdout
@@ -10,6 +10,7 @@ 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:
@@ -29,6 +30,7 @@ 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:
@@ -47,6 +49,7 @@ 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:
@@ -67,6 +70,7 @@ 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:
View Lorry Controller Status