Commit da0a94e5 authored by Christiaan Baaij's avatar Christiaan Baaij
Browse files

Extend dy(ld)_library_path for relocatable 'cabal run'

parent b9c698ea
......@@ -45,7 +45,8 @@ module Distribution.Simple.GHC (
ghcLibDir,
ghcDynamic,
ghcGlobalPackageDB,
pkgRoot
pkgRoot,
toRPaths
) where
import qualified Distribution.Simple.GHC.IPI641 as IPI641
......@@ -874,7 +875,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
else return []
unless (null hObjs && null cObjs && null stubObjs) $ do
rpaths <- toRPaths False pkg_descr lbi clbi
rpaths <- toRPaths False True lbi clbi
let staticObjectFiles =
hObjs
......@@ -937,12 +938,13 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
-- | Derive RPATHs
toRPaths :: Bool -- ^ Building exe?
-> PackageDescription
-> Bool -- ^ Generate prefix-relative rpaths
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO (NubListR FilePath)
toRPaths buildE _pkg_descr lbi clbi = do
let installDirs = absoluteInstallDirs _pkg_descr lbi NoCopyDest
toRPaths buildE mkRelative lbi clbi = do
let pkgDescr = localPkgDescr lbi
installDirs = absoluteInstallDirs pkgDescr lbi NoCopyDest
relDir | buildE = bindir installDirs
| otherwise = libdir installDirs
......@@ -967,7 +969,8 @@ toRPaths buildE _pkg_descr lbi clbi = do
let p = prefix installDirs
prefixRelative l = isJust (stripPrefix p l)
rpaths
| prefixRelative relDir = map (\l ->
| mkRelative &&
prefixRelative relDir = map (\l ->
if prefixRelative l
then hostPref </>
shortRelativePath relDir l
......@@ -1035,7 +1038,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
-- build executables
srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath
rpaths <- toRPaths True _pkg_descr lbi clbi
rpaths <- toRPaths True True lbi clbi
let isGhcDynamic = ghcDynamic comp
dynamicTooSupported = ghcSupportsDynamicToo comp
......@@ -1079,7 +1082,8 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
ghcOptLinkFrameworks = toNubListR $ PD.frameworks exeBi,
ghcOptInputFiles = toNubListR
[exeDir </> x | x <- cObjs],
ghcOptRPaths = if relocatable lbi
ghcOptRPaths = if relocatable lbi &&
withDynExe lbi
then rpaths
else mempty
}
......
......@@ -16,15 +16,21 @@ import Distribution.PackageDescription (Executable (..),
PackageDescription (..))
import Distribution.Simple.Build.PathsModule (pkgPathEnvVar)
import Distribution.Simple.BuildPaths (exeExtension)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo (..))
import Distribution.Simple.LocalBuildInfo (ComponentName (..),
LocalBuildInfo (..),
getComponentLocalBuildInfo)
import Distribution.Simple.GHC (toRPaths)
import Distribution.Simple.Utils (die, notice, rawSystemExitWithEnv)
import Distribution.System (Platform (..), OS (..))
import Distribution.Utils.NubList (fromNubListR)
import Distribution.Verbosity (Verbosity)
import Data.Functor ((<$>))
import Data.List (find)
import Data.List (find, intercalate)
import System.Directory (getCurrentDirectory)
import Distribution.Compat.Environment (getEnvironment)
import System.FilePath ((<.>), (</>))
import Distribution.Client.Compat.Environment (lookupEnv)
import System.FilePath ((<.>), (</>), searchPathSeparator)
-- | Return the executable to run and any extra arguments that should be
......@@ -61,5 +67,25 @@ run verbosity lbi exe exeArgs = do
path <- tryCanonicalizePath $
buildPref </> exeName exe </> (exeName exe <.> exeExtension)
env <- (dataDirEnvVar:) <$> getEnvironment
env' <- addLibraryPath lbi exe env
notice verbosity $ "Running " ++ exeName exe ++ "..."
rawSystemExitWithEnv verbosity path exeArgs env
rawSystemExitWithEnv verbosity path exeArgs env'
addLibraryPath :: LocalBuildInfo -> Executable -> [(String,String)]
-> IO [(String,String)]
addLibraryPath lbi exe env | relocatable lbi && withDynExe lbi = do
let clbi = getComponentLocalBuildInfo lbi (CExeName (exeName exe))
rpaths <- fromNubListR <$> toRPaths True False lbi clbi
let libPaths = intercalate [searchPathSeparator] rpaths
let (Platform _ os) = hostPlatform lbi
ldPath = case os of
OSX -> "DYLD_LIBRARY_PATH"
_ -> "LD_LIBRARY_PATH"
ldEnv <- maybe libPaths (++ (searchPathSeparator:libPaths)) <$>
lookupEnv ldPath
return (env ++ [(ldPath,ldEnv)])
addLibraryPath _ _ env = return env
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