From 76e5889017ee4ac688901d37f2fa684e807769b6 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Thu, 30 May 2019 11:09:13 -0400 Subject: Fix space leaks in dynLoadObjs (#16708) When running the test suite on a GHC built with the `quick` build flavour, `-fghci-leak-check` noticed some space leaks. Careful investigation led to `Linker.dynLoadObjs` being the culprit. Pattern-matching on `PeristentLinkerState` and a dash of `$!` were sufficient to fix the issue. (ht to mpickering for his suggestions, which were crucial to discovering a fix) Fixes #16708. --- compiler/ghci/Linker.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 077b067c3c..4f938a9a5f 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -115,7 +115,7 @@ readPLS dl = modifyMbPLS_ :: DynLinker -> (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO () -modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f +modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f emptyPLS :: DynFlags -> PersistentLinkerState emptyPLS _ = PersistentLinkerState { @@ -881,8 +881,8 @@ dynLinkObjs hsc_env pls objs = do dynLoadObjs :: HscEnv -> PersistentLinkerState -> [FilePath] -> IO PersistentLinkerState -dynLoadObjs _ pls [] = return pls -dynLoadObjs hsc_env pls objs = do +dynLoadObjs _ pls [] = return pls +dynLoadObjs hsc_env pls@PersistentLinkerState{..} objs = do let dflags = hsc_dflags hsc_env let platform = targetPlatform dflags let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ] @@ -899,13 +899,13 @@ dynLoadObjs hsc_env pls objs = do -- library. ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) - (nub $ snd <$> temp_sos pls) + (nub $ snd <$> temp_sos) ++ concatMap (\lp -> [ Option ("-L" ++ lp) , Option "-Xlinker" , Option "-rpath" , Option "-Xlinker" , Option lp ]) - (nub $ fst <$> temp_sos pls) + (nub $ fst <$> temp_sos) ++ concatMap (\lp -> [ Option ("-L" ++ lp) @@ -933,13 +933,13 @@ dynLoadObjs hsc_env pls objs = do -- link all "loaded packages" so symbols in those can be resolved -- Note: We are loading packages with local scope, so to see the -- symbols in this link we must link all loaded packages again. - linkDynLib dflags2 objs (pkgs_loaded pls) + linkDynLib dflags2 objs pkgs_loaded -- if we got this far, extend the lifetime of the library file changeTempFilesLifetime dflags TFL_GhcSession [soFile] m <- loadDLL hsc_env soFile case m of - Nothing -> return pls { temp_sos = (libPath, libName) : temp_sos pls } + Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos } Just err -> panic ("Loading temp shared object failed: " ++ err) rmDupLinkables :: [Linkable] -- Already loaded -- cgit v1.2.1