Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/58eaacc9967b7c627a66d49047fb447ac065706e >--------------------------------------------------------------- commit 58eaacc9967b7c627a66d49047fb447ac065706e Author: Ian Lynagh <i...@well-typed.com> Date: Mon Oct 1 21:39:04 2012 +0100 Add a flag to tell ghc to use $ORIGIN when linking program dynamically >--------------------------------------------------------------- compiler/main/DriverPipeline.hs | 14 ++++++++++++-- compiler/main/DynFlags.hs | 2 ++ 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 0566d6a..e0bea39 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 5e3f7e0..97d0675 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 8717154..f9927de 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} %************************************************************************ _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
