Commit 58eaacc9 authored by ian@well-typed.com's avatar ian@well-typed.com

Add a flag to tell ghc to use $ORIGIN when linking program dynamically

parent 483c7633
......@@ -1662,13 +1662,23 @@ linkBinary dflags o_files dep_packages = do
-- explicit packages with the auto packages and all of their
-- dependencies, and eliminating duplicates.
full_output_fn <- if isAbsolute output_fn
then return output_fn
else do d <- getCurrentDirectory
return $ normalise (d </> output_fn)
pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
let pkg_lib_path_opts = concat (map get_pkg_lib_path_opts pkg_lib_paths)
let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
get_pkg_lib_path_opts l
| osElfTarget (platformOS platform) &&
dynLibLoader dflags == SystemDependent &&
not (dopt Opt_Static dflags)
= ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
= let libpath = if dopt Opt_RelativeDynlibPaths dflags
then "$ORIGIN" </>
(l `makeRelativeTo` full_output_fn)
else l
in ["-L" ++ l,
"-Wl,-rpath", "-Wl," ++ libpath,
"-Wl,-rpath-link", "-Wl," ++ l]
| otherwise = ["-L" ++ l]
let lib_paths = libraryPaths dflags
......
......@@ -339,6 +339,7 @@ data DynFlag
| Opt_SccProfilingOn
| Opt_Ticky
| Opt_Static
| Opt_RelativeDynlibPaths
| Opt_Hpc
-- output style opts
......@@ -1780,6 +1781,7 @@ dynamic_flags = [
addWay WayDyn))
-- ignored for compat w/ gcc:
, Flag "rdynamic" (NoArg (return ()))
, Flag "relative-dynlib-paths" (NoArg (setDynFlag Opt_RelativeDynlibPaths))
------- Specific phases --------------------------------------------
-- need to appear before -pgmL to be parsed as LLVM flags.
......
......@@ -87,6 +87,7 @@ module Util (
escapeSpaces,
parseSearchPath,
Direction(..), reslash,
makeRelativeTo,
-- * Utils for defining Data instances
abstractConstr, abstractDataType, mkNoRepType,
......@@ -1006,6 +1007,17 @@ reslash d = f
slash = case d of
Forwards -> '/'
Backwards -> '\\'
makeRelativeTo :: FilePath -> FilePath -> FilePath
this `makeRelativeTo` that = directory </> thisFilename
where (thisDirectory, thisFilename) = splitFileName this
thatDirectory = dropFileName that
directory = joinPath $ f (splitPath thisDirectory)
(splitPath thatDirectory)
f (x : xs) (y : ys)
| x == y = f xs ys
f xs ys = replicate (length ys) ".." ++ xs
\end{code}
%************************************************************************
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment