[Git][ghc/ghc][master] Fix space leaks in dynLoadObjs (#16708)

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
76e58890 by Ryan Scott at 2019-06-01T03:57:05Z
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.

- - - - -


1 changed file:

- compiler/ghci/Linker.hs


Changes:

=====================================
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 at 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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/76e5889017ee4ac688901d37f2fa684e807769b6

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/76e5889017ee4ac688901d37f2fa684e807769b6
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190531/771bfe6f/attachment-0001.html>