...
 
Commits (2)
......@@ -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
......
T13786 :
$(TEST_HC) -c -fPIC T13786a.c T13786b.c
$(TEST_HC_INTERACTIVE) T13786a.o T13786b.o T13786.hs < T13786.script
{-# LANGUAGE ForeignFunctionInterface #-}
foreign import ccall unsafe "hello_a" helloA :: IO ()
#include <stdio.h>
#include <stdbool.h>
static bool flag_a = false;
extern void hello_b();
void hello_a() {
if (! flag_a) {
flag_a = true;
hello_b();
}
printf("hello world A\n");
}
#include <stdio.h>
#include <stdbool.h>
static bool flag_b = false;
extern void hello_a();
void hello_b() {
if (! flag_b) {
flag_b = true;
hello_a();
}
printf("hello world B\n");
}
test('T13786', normal, makefile_test, [])