diff options
Diffstat (limited to 'compiler/ghci/Linker.hs')
| -rw-r--r-- | compiler/ghci/Linker.hs | 44 |
1 files changed, 31 insertions, 13 deletions
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index e26dcce1ee..a360aa2265 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -352,8 +352,10 @@ linkCmdLineLibs' hsc_env pls = all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env + let merged_specs = mergeStaticObjects cmdline_lib_specs pls1 <- foldM (preloadLib hsc_env lib_paths framework_paths) pls - cmdline_lib_specs + merged_specs + maybePutStr dflags "final link ... " ok <- resolveObjs hsc_env @@ -365,6 +367,19 @@ linkCmdLineLibs' hsc_env pls = return pls1 +-- | Merge runs of consecutive of 'Objects'. This allows for resolution of +-- cyclic symbol references when dynamically linking. Specifically, we link +-- together all of the static objects into a single shared object, avoiding +-- the issue we saw in #13786. +mergeStaticObjects :: [LibrarySpec] -> [LibrarySpec] +mergeStaticObjects specs = go [] specs + where + go :: [FilePath] -> [LibrarySpec] -> [LibrarySpec] + go accum (Objects objs : rest) = go (objs ++ accum) rest + go accum@(_:_) rest = Objects (reverse accum) : go [] rest + go [] (spec:rest) = spec : go [] rest + go [] [] = [] + {- Note [preload packages] Why do we need to preload packages from the command line? This is an @@ -392,7 +407,7 @@ users? classifyLdInput :: DynFlags -> FilePath -> IO (Maybe LibrarySpec) classifyLdInput dflags f - | isObjectFilename platform f = return (Just (Object f)) + | isObjectFilename platform f = return (Just (Objects [f])) | isDynLibFilename platform f = return (Just (DLLPath f)) | otherwise = do putLogMsg dflags NoReason SevInfo noSrcSpan @@ -407,8 +422,8 @@ preloadLib preloadLib hsc_env lib_paths framework_paths pls lib_spec = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ") case lib_spec of - Object static_ish -> do - (b, pls1) <- preload_static lib_paths static_ish + Objects static_ishs -> do + (b, pls1) <- preload_statics lib_paths static_ishs maybePutStrLn dflags (if b then "done" else "not found") return pls1 @@ -467,13 +482,13 @@ preloadLib hsc_env lib_paths framework_paths pls lib_spec = do intercalate "\n" (map (" "++) paths))) -- Not interested in the paths in the static case. - preload_static _paths name - = do b <- doesFileExist name + preload_statics _paths names + = do b <- or <$> mapM doesFileExist names if not b then return (False, pls) else if dynamicGhc - then do pls1 <- dynLoadObjs hsc_env pls [name] + then do pls1 <- dynLoadObjs hsc_env pls names return (True, pls1) - else do loadObj hsc_env name + else do mapM_ (loadObj hsc_env) names return (True, pls) preload_static_archive _paths name @@ -1139,7 +1154,9 @@ unload_wkr hsc_env keep_linkables pls@PersistentLinkerState{..} = do ********************************************************************* -} data LibrarySpec - = Object FilePath -- Full path name of a .o file, including trailing .o + = Objects [FilePath] -- Full path names of set of .o files, including trailing .o + -- We allow batched loading to ensure that cyclic symbol + -- references can be resolved (see #13786). -- For dynamic objects only, try to find the object -- file in all the directories specified in -- v_Library_paths before giving up. @@ -1173,7 +1190,7 @@ partOfGHCi ["base", "template-haskell", "editline"] showLS :: LibrarySpec -> String -showLS (Object nm) = "(static) " ++ nm +showLS (Objects nms) = "(static) [" ++ intercalate ", " nms ++ "]" showLS (Archive nm) = "(static archive) " ++ nm showLS (DLL nm) = "(dynamic) " ++ nm showLS (DLLPath nm) = "(dynamic) " ++ nm @@ -1270,7 +1287,8 @@ linkPackage hsc_env pkg -- Complication: all the .so's must be loaded before any of the .o's. let known_dlls = [ dll | DLLPath dll <- classifieds ] dlls = [ dll | DLL dll <- classifieds ] - objs = [ obj | Object obj <- classifieds ] + objs = [ obj | Objects objs <- classifieds + , obj <- objs ] archs = [ arch | Archive arch <- classifieds ] -- Add directories to library search paths @@ -1478,8 +1496,8 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib (ArchX86_64, OSSolaris2) -> "64" </> so_name _ -> so_name - findObject = liftM (fmap Object) $ findFile dirs obj_file - findDynObject = liftM (fmap Object) $ findFile dirs dyn_obj_file + findObject = liftM (fmap $ Objects . (:[])) $ findFile dirs obj_file + findDynObject = liftM (fmap $ Objects . (:[])) $ findFile dirs dyn_obj_file findArchive = let local name = liftM (fmap Archive) $ findFile dirs name in apply (map local arch_files) findHSDll = liftM (fmap DLLPath) $ findFile dirs hs_dyn_lib_file |