diff options
Diffstat (limited to 'ghc')
-rw-r--r-- | ghc/GHCi/Leak.hs | 11 | ||||
-rw-r--r-- | ghc/Main.hs | 5 |
2 files changed, 13 insertions, 3 deletions
diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs index e99ff405aa..51e3958ba2 100644 --- a/ghc/GHCi/Leak.hs +++ b/ghc/GHCi/Leak.hs @@ -22,6 +22,7 @@ import Prelude import System.Mem import System.Mem.Weak import GHC.Types.Unique.DFM +import Control.Exception -- Checking for space leaks in GHCi. See #15111, and the -- -fghci-leak-check flag. @@ -32,7 +33,7 @@ data LeakModIndicators = LeakModIndicators { leakMod :: Weak HomeModInfo , leakIface :: Weak ModIface , leakDetails :: Weak ModDetails - , leakLinkable :: Maybe (Weak Linkable) + , leakLinkable :: [Maybe (Weak Linkable)] } -- | Grab weak references to some of the data structures representing @@ -44,8 +45,12 @@ getLeakIndicators hsc_env = leakMod <- mkWeakPtr hmi Nothing leakIface <- mkWeakPtr hm_iface Nothing leakDetails <- mkWeakPtr hm_details Nothing - leakLinkable <- mapM (`mkWeakPtr` Nothing) hm_linkable + leakLinkable <- mkWeakLinkables hm_linkable return $ LeakModIndicators{..} + where + mkWeakLinkables :: HomeModLinkable -> IO [Maybe (Weak Linkable)] + mkWeakLinkables (HomeModLinkable mbc mo) = + mapM (\ln -> traverse (flip mkWeakPtr Nothing <=< evaluate) ln) [mbc, mo] -- | Look at the LeakIndicators collected by an earlier call to -- `getLeakIndicators`, and print messasges if any of them are still @@ -63,7 +68,7 @@ checkLeakIndicators dflags (LeakIndicators leakmods) = do Nothing -> return () Just miface -> report ("ModIface:" ++ moduleNameString (moduleName (mi_module miface))) (Just miface) deRefWeak leakDetails >>= report "ModDetails" - forM_ leakLinkable $ \l -> deRefWeak l >>= report "Linkable" + forM_ leakLinkable $ \l -> forM_ l $ \l' -> deRefWeak l' >>= report "Linkable" where report :: String -> Maybe a -> IO () report _ Nothing = return () diff --git a/ghc/Main.hs b/ghc/Main.hs index 45dd5fede1..16075284c0 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -209,6 +209,11 @@ main' postLoadMode units dflags0 args flagWarnings = do where def_ghci_flags = dflags1 `gopt_set` Opt_ImplicitImportQualified `gopt_set` Opt_IgnoreOptimChanges `gopt_set` Opt_IgnoreHpcChanges + -- Setting this by default has the nice effect that + -- -fno-code and --interactive falls back to interpreter rather than + -- object code but has little other effect unless you are also using + -- fat interface files. + `gopt_set` Opt_UseBytecodeRatherThanObjects logger1 <- getLogger let logger2 = setLogFlags logger1 (initLogFlags dflags2) |