diff options
| author | Ian Lynagh <ian@well-typed.com> | 2012-10-01 21:39:04 +0100 |
|---|---|---|
| committer | Ian Lynagh <ian@well-typed.com> | 2012-10-02 21:36:38 +0100 |
| commit | 58eaacc9967b7c627a66d49047fb447ac065706e (patch) | |
| tree | bf3fa82d6d9a1abb0586c32f09b4680dfdfc8450 | |
| parent | 483c763341360f810ed2136b95591db1486d0533 (diff) | |
| download | haskell-58eaacc9967b7c627a66d49047fb447ac065706e.tar.gz | |
Add a flag to tell ghc to use $ORIGIN when linking program dynamically
| -rw-r--r-- | compiler/main/DriverPipeline.hs | 14 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 2 | ||||
| -rw-r--r-- | compiler/utils/Util.lhs | 12 |
3 files changed, 26 insertions, 2 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 0566d6ad65..e0bea39020 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -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 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 5e3f7e001b..97d0675802 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -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. diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 87171545f8..f9927de2f0 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -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} %************************************************************************ |