diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2019-05-30 11:09:13 -0400 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-05-31 23:57:05 -0400 |
| commit | 76e5889017ee4ac688901d37f2fa684e807769b6 (patch) | |
| tree | 81534f1cf5d98ed52b3ae67c1215003e9a60424e | |
| parent | 45f88494293bea20cc3aca025ee6fe84087987ce (diff) | |
| download | haskell-76e5889017ee4ac688901d37f2fa684e807769b6.tar.gz | |
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.
| -rw-r--r-- | compiler/ghci/Linker.hs | 14 |
1 files 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 |