Add -fghci-leak-check to check for space leaks
authorSimon Marlow <marlowsd@gmail.com>
Wed, 2 May 2018 10:01:13 +0000 (11:01 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Fri, 25 May 2018 09:07:45 +0000 (10:07 +0100)
Summary:
(re-applying this patch now that D4659 is committed)

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

compiler/main/DynFlags.hs
docs/users_guide/ghci.rst
ghc/GHCi/Leak.hs [new file with mode: 0644]
ghc/GHCi/UI.hs
ghc/ghc-bin.cabal.in
testsuite/config/ghc
testsuite/tests/ghci/scripts/T9293.stdout
testsuite/tests/ghci/scripts/ghci057.stdout

index 0d49327..0406d0e 100644 (file)
@@ -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,
index f5dcfe3..a5f5764 100644 (file)
@@ -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 (file)
index 0000000..3f64b5d
--- /dev/null
@@ -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!")
index 3ed1c7f..d449b3c 100644 (file)
@@ -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 ()
index 12812ef..6c12941 100644 (file)
@@ -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
index 6296394..f41f372 100644 (file)
@@ -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'],
index 2e5adc4..4fdd350 100644 (file)
@@ -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:
index 2e5adc4..4fdd350 100644 (file)
@@ -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: