never executed always true always false

    1 {-# LANGUAGE RecordWildCards, LambdaCase #-}
    2 module GHCi.Leak
    3   ( LeakIndicators
    4   , getLeakIndicators
    5   , checkLeakIndicators
    6   ) where
    7 
    8 import Control.Monad
    9 import Data.Bits
   10 import Foreign.Ptr (ptrToIntPtr, intPtrToPtr)
   11 import GHC
   12 import GHC.Ptr (Ptr (..))
   13 import GHCi.Util
   14 import GHC.Driver.Env
   15 import GHC.Driver.Ppr
   16 import GHC.Utils.Outputable
   17 import GHC.Unit.Module.ModDetails
   18 import GHC.Unit.Home.ModInfo
   19 import GHC.Platform (target32Bit)
   20 import GHC.Linker.Types
   21 import Prelude
   22 import System.Mem
   23 import System.Mem.Weak
   24 import GHC.Types.Unique.DFM
   25 
   26 -- Checking for space leaks in GHCi. See #15111, and the
   27 -- -fghci-leak-check flag.
   28 
   29 data LeakIndicators = LeakIndicators [LeakModIndicators]
   30 
   31 data LeakModIndicators = LeakModIndicators
   32   { leakMod :: Weak HomeModInfo
   33   , leakIface :: Weak ModIface
   34   , leakDetails :: Weak ModDetails
   35   , leakLinkable :: Maybe (Weak Linkable)
   36   }
   37 
   38 -- | Grab weak references to some of the data structures representing
   39 -- the currently loaded modules.
   40 getLeakIndicators :: HscEnv -> IO LeakIndicators
   41 getLeakIndicators hsc_env =
   42   fmap LeakIndicators $
   43     forM (eltsUDFM (hsc_HPT hsc_env)) $ \hmi@HomeModInfo{..} -> do
   44       leakMod <- mkWeakPtr hmi Nothing
   45       leakIface <- mkWeakPtr hm_iface Nothing
   46       leakDetails <- mkWeakPtr hm_details Nothing
   47       leakLinkable <- mapM (`mkWeakPtr` Nothing) hm_linkable
   48       return $ LeakModIndicators{..}
   49 
   50 -- | Look at the LeakIndicators collected by an earlier call to
   51 -- `getLeakIndicators`, and print messasges if any of them are still
   52 -- alive.
   53 checkLeakIndicators :: DynFlags -> LeakIndicators -> IO ()
   54 checkLeakIndicators dflags (LeakIndicators leakmods)  = do
   55   performGC
   56   forM_ leakmods $ \LeakModIndicators{..} -> do
   57     deRefWeak leakMod >>= \case
   58       Nothing -> return ()
   59       Just hmi ->
   60         report ("HomeModInfo for " ++
   61           showSDoc dflags (ppr (mi_module (hm_iface hmi)))) (Just hmi)
   62     deRefWeak leakIface >>= \case
   63       Nothing -> return ()
   64       Just miface -> report ("ModIface:" ++ moduleNameString (moduleName (mi_module miface))) (Just miface)
   65     deRefWeak leakDetails >>= report "ModDetails"
   66     forM_ leakLinkable $ \l -> deRefWeak l >>= report "Linkable"
   67  where
   68   report :: String -> Maybe a -> IO ()
   69   report _ Nothing = return ()
   70   report msg (Just a) = do
   71     addr <- anyToPtr a
   72     putStrLn ("-fghci-leak-check: " ++ msg ++ " is still alive at " ++
   73               show (maskTagBits addr))
   74 
   75   tagBits
   76     | target32Bit (targetPlatform dflags) = 2
   77     | otherwise = 3
   78 
   79   maskTagBits :: Ptr a -> Ptr a
   80   maskTagBits p = intPtrToPtr (ptrToIntPtr p .&. complement (shiftL 1 tagBits - 1))