Commit 52f96e18 authored by Christiaan Baaij's avatar Christiaan Baaij

Add (DY)LD_LIBRARY_PATH for 'run' and 'test' commands

parent da0a94e5
......@@ -45,8 +45,7 @@ module Distribution.Simple.GHC (
ghcLibDir,
ghcDynamic,
ghcGlobalPackageDB,
pkgRoot,
toRPaths
pkgRoot
) where
import qualified Distribution.Simple.GHC.IPI641 as IPI641
......@@ -64,13 +63,13 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
, LibraryName(..), absoluteInstallDirs )
, LibraryName(..), absoluteInstallDirs, depLibraryPaths )
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Package
( PackageName(..), InstalledPackageId, PackageId, packageId )
( PackageName(..), InstalledPackageId, PackageId )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), ProgramConfiguration
......@@ -104,7 +103,7 @@ import Distribution.Verbosity
import Distribution.Text
( display, simpleParse )
import Distribution.Utils.NubList
( NubListR, overNubListR, toNubListR )
( overNubListR, toNubListR )
import Language.Haskell.Extension (Language(..), Extension(..)
,KnownExtension(..))
......@@ -112,12 +111,12 @@ import Control.Monad ( unless, when )
import Data.Char ( isDigit, isSpace )
import Data.List
import qualified Data.Map as M ( Map, fromList, lookup )
import Data.Maybe ( catMaybes, fromMaybe, maybeToList, isJust )
import Data.Maybe ( catMaybes, fromMaybe, maybeToList )
import Data.Monoid ( Monoid(..) )
import Data.Version ( showVersion )
import System.Directory
( getDirectoryContents, doesFileExist, getTemporaryDirectory,
canonicalizePath, getAppUserDataDirectory, createDirectoryIfMissing )
getAppUserDataDirectory, createDirectoryIfMissing )
import System.FilePath ( (</>), (<.>), takeExtension,
takeDirectory, replaceExtension,
splitExtension )
......@@ -875,7 +874,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
else return []
unless (null hObjs && null cObjs && null stubObjs) $ do
rpaths <- toRPaths False True lbi clbi
rpaths <- depLibraryPaths False True lbi clbi
let staticObjectFiles =
hObjs
......@@ -936,52 +935,6 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
whenSharedLib False $
runGhcProg ghcSharedLinkArgs
-- | Derive RPATHs
toRPaths :: Bool -- ^ Building exe?
-> Bool -- ^ Generate prefix-relative rpaths
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO (NubListR FilePath)
toRPaths buildE mkRelative lbi clbi = do
let pkgDescr = localPkgDescr lbi
installDirs = absoluteInstallDirs pkgDescr lbi NoCopyDest
relDir | buildE = bindir installDirs
| otherwise = libdir installDirs
let hasInternalDeps = not $ null
$ [ pkgid
| (_,pkgid) <- componentPackageDeps clbi
, internal pkgid
]
let ipkgs = PackageIndex.allPackages (installedPkgs lbi)
allDepLibDirs = concatMap InstalledPackageInfo.libraryDirs ipkgs
allDepLibDirs' = if hasInternalDeps
then (libdir installDirs) : allDepLibDirs
else allDepLibDirs
allDepLibDirsC <- mapM canonicalizePath allDepLibDirs'
let (Platform _ hostOS) = hostPlatform lbi
hostPref = case hostOS of
OSX -> "@loader_path"
_ -> "$ORIGIN"
let p = prefix installDirs
prefixRelative l = isJust (stripPrefix p l)
rpaths
| mkRelative &&
prefixRelative relDir = map (\l ->
if prefixRelative l
then hostPref </>
shortRelativePath relDir l
else l
) allDepLibDirsC
| otherwise = allDepLibDirsC
return (toNubListR rpaths)
where
internal pkgid = pkgid == packageId (localPkgDescr lbi)
-- | Start a REPL without loading any source files.
startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler
-> PackageDBStack -> IO ()
......@@ -1038,7 +991,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
-- build executables
srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath
rpaths <- toRPaths True True lbi clbi
rpaths <- depLibraryPaths False True lbi clbi
let isGhcDynamic = ghcDynamic comp
dynamicTooSupported = ghcSupportsDynamicToo comp
......
......@@ -42,6 +42,7 @@ module Distribution.Simple.LocalBuildInfo (
allComponentsInBuildOrder,
componentsInBuildOrder,
checkComponentsCyclic,
depLibraryPaths,
withAllComponentsInBuildOrder,
withComponentsInBuildOrder,
......@@ -74,24 +75,31 @@ import Distribution.Package
import Distribution.Simple.Compiler
( Compiler, compilerInfo, PackageDBStack, OptimisationLevel )
import Distribution.Simple.PackageIndex
( InstalledPackageIndex )
( InstalledPackageIndex, allPackages )
import Distribution.ModuleName ( ModuleName )
import Distribution.Simple.Setup
( ConfigFlags )
import Distribution.Simple.Utils
( shortRelativePath )
import Distribution.Text
( display )
import Distribution.System
( Platform )
( Platform (..), OS (..) )
import Distribution.Utils.NubList
( NubListR, toNubListR )
import Data.Array ((!))
import Data.Binary (Binary)
import Data.Graph
import Data.List (nub, find)
import Data.List (nub, find, stripPrefix)
import Data.Maybe
import Data.Tree (flatten)
import GHC.Generics (Generic)
import Data.Map (Map)
import System.Directory (canonicalizePath)
import System.FilePath ((</>))
-- | Data cached after configuration step. See also
-- 'Distribution.Simple.Setup.ConfigFlags'.
data LocalBuildInfo = LocalBuildInfo {
......@@ -404,6 +412,55 @@ checkComponentsCyclic es =
(c:_) -> Just (map vertexToNode c)
depLibraryPaths :: Bool -- ^ Building for inplace?
-> Bool -- ^ Generate prefix-relative rpaths
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO (NubListR FilePath)
depLibraryPaths inplace relative lbi clbi = do
let pkgDescr = localPkgDescr lbi
installDirs = absoluteInstallDirs pkgDescr lbi NoCopyDest
executable = case clbi of
ExeComponentLocalBuildInfo {} -> True
_ -> False
relDir | executable = bindir installDirs
| otherwise = libdir installDirs
let hasInternalDeps = not $ null
$ [ pkgid
| (_,pkgid) <- componentPackageDeps clbi
, internal pkgid
]
let ipkgs = allPackages (installedPkgs lbi)
allDepLibDirs = concatMap Installed.libraryDirs ipkgs
allDepLibDirs' = if hasInternalDeps
then (libdir installDirs) : allDepLibDirs
else allDepLibDirs
allDepLibDirsC <- mapM canonicalizePath allDepLibDirs'
let (Platform _ hostOS) = hostPlatform lbi
hostPref = case hostOS of
OSX -> "@loader_path"
_ -> "$ORIGIN"
let p = prefix installDirs
prefixRelative l = isJust (stripPrefix p l)
rpaths
| relative &&
prefixRelative relDir = map (\l ->
if prefixRelative l
then hostPref </>
shortRelativePath relDir l
else l
) allDepLibDirsC
| otherwise = allDepLibDirsC
return (toNubListR rpaths)
where
internal pkgid = pkgid == packageId (localPkgDescr lbi)
-- -----------------------------------------------------------------------------
-- Wrappers for a couple functions from InstallDirs
......
......@@ -16,13 +16,17 @@ import qualified Distribution.Simple.LocalBuildInfo as LBI
import Distribution.Simple.Setup
( TestFlags(..), TestShowDetails(..), fromFlag, configCoverage )
import Distribution.Simple.Test.Log
import Distribution.Simple.Utils ( die, notice, rawSystemIOWithEnv )
import Distribution.Simple.Utils
( die, notice, rawSystemIOWithEnv, addLibraryPath )
import Distribution.System ( Platform (..) )
import Distribution.TestSuite
import Distribution.Text
import Distribution.Utils.NubList ( fromNubListR )
import Distribution.Verbosity ( normal )
import Control.Concurrent (forkIO)
import Control.Monad ( unless, void, when )
import Data.Functor ( (<$>) )
import System.Directory
( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
, getCurrentDirectory, removeDirectoryRecursive )
......@@ -78,7 +82,18 @@ runTest pkg_descr lbi flags suite = do
pkgPathEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath)
: existingEnv
shellEnv = [("HPCTIXFILE", tixFile) | isCoverageEnabled] ++ pkgPathEnv
exit <- rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv)
-- Add (DY)LD_LIBRARY_PATH if needed
shellEnv' <- if LBI.relocatable lbi && LBI.withDynExe lbi
then do let (Platform _ os) = LBI.hostPlatform lbi
clbi = LBI.getComponentLocalBuildInfo lbi
(LBI.CTestName (PD.testName suite))
paths <- fromNubListR <$> LBI.depLibraryPaths
True False lbi clbi
addLibraryPath os paths shellEnv
else return shellEnv
exit <- rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv')
-- these handles are automatically closed
Nothing (Just wOut) (Just wOut)
......
......@@ -22,13 +22,17 @@ import qualified Distribution.Simple.LocalBuildInfo as LBI
import Distribution.Simple.Setup
( TestFlags(..), TestShowDetails(..), fromFlag, configCoverage )
import Distribution.Simple.Test.Log
import Distribution.Simple.Utils ( die, notice, rawSystemIOWithEnv )
import Distribution.Simple.Utils
( die, notice, rawSystemIOWithEnv, addLibraryPath )
import Distribution.System ( Platform (..) )
import Distribution.TestSuite
import Distribution.Text
import Distribution.Utils.NubList ( fromNubListR )
import Distribution.Verbosity ( normal )
import Control.Exception ( bracket )
import Control.Monad ( when, unless )
import Data.Functor ( (<$>) )
import Data.Maybe ( mapMaybe )
import System.Directory
( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
......@@ -86,7 +90,20 @@ runTest pkg_descr lbi flags suite = do
: existingEnv
shellEnv = [("HPCTIXFILE", tixFile) | isCoverageEnabled]
++ pkgPathEnv
rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv)
-- Add (DY)LD_LIBRARY_PATH if needed
shellEnv' <- if LBI.relocatable lbi && LBI.withDynExe lbi
then do
let (Platform _ os) = LBI.hostPlatform lbi
clbi = LBI.getComponentLocalBuildInfo
lbi
(LBI.CTestName
(PD.testName suite))
paths <- fromNubListR <$>
LBI.depLibraryPaths
True False lbi clbi
addLibraryPath os paths shellEnv
else return shellEnv
rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv')
-- these handles are closed automatically
(Just rIn) (Just wOut) (Just wOut)
......
......@@ -75,6 +75,7 @@ module Distribution.Simple.Utils (
-- * environment variables
isInSearchPath,
addLibraryPath,
-- * simple file globbing
matchFileGlob,
......@@ -127,6 +128,8 @@ module Distribution.Simple.Utils (
wrapLine,
) where
import Data.Functor
( (<$>) )
import Control.Monad
( join, when, unless, filterM )
import Control.Concurrent.MVar
......@@ -146,13 +149,14 @@ import System.Directory
, doesDirectoryExist, doesFileExist, removeFile, findExecutable
, getModificationTime )
import System.Environment
( getProgName )
( getProgName, lookupEnv )
import System.Exit
( exitWith, ExitCode(..) )
import System.FilePath
( normalise, (</>), (<.>)
, getSearchPath, joinPath, takeDirectory, splitFileName
, splitExtension, splitExtensions, splitDirectories )
, splitExtension, splitExtensions, splitDirectories
, searchPathSeparator )
import System.Directory
( createDirectory, renameFile, removeDirectoryRecursive )
import System.IO
......@@ -174,6 +178,8 @@ import Distribution.Package
( PackageIdentifier )
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
import Distribution.System
( OS (..) )
import Distribution.Version
(Version(..))
......@@ -694,6 +700,20 @@ getDirectoryContentsRecursive topdir = recurseDirectories [""]
isInSearchPath :: FilePath -> IO Bool
isInSearchPath path = fmap (elem path) getSearchPath
addLibraryPath :: OS
-> [FilePath]
-> [(String,String)]
-> IO [(String,String)]
addLibraryPath os paths env = do
let libPaths = intercalate [searchPathSeparator] paths
ldPath = case os of
OSX -> "DYLD_LIBRARY_PATH"
_ -> "LD_LIBRARY_PATH"
ldEnv <- maybe libPaths (++ (searchPathSeparator:libPaths)) <$>
lookupEnv ldPath
return ((ldPath,ldEnv):env)
----------------
-- File globbing
......
......@@ -18,19 +18,19 @@ import Distribution.Simple.Build.PathsModule (pkgPathEnvVar)
import Distribution.Simple.BuildPaths (exeExtension)
import Distribution.Simple.LocalBuildInfo (ComponentName (..),
LocalBuildInfo (..),
getComponentLocalBuildInfo)
import Distribution.Simple.GHC (toRPaths)
import Distribution.Simple.Utils (die, notice, rawSystemExitWithEnv)
import Distribution.System (Platform (..), OS (..))
getComponentLocalBuildInfo,
depLibraryPaths)
import Distribution.Simple.Utils (die, notice, rawSystemExitWithEnv,
addLibraryPath)
import Distribution.System (Platform (..))
import Distribution.Utils.NubList (fromNubListR)
import Distribution.Verbosity (Verbosity)
import Data.Functor ((<$>))
import Data.List (find, intercalate)
import Data.List (find)
import System.Directory (getCurrentDirectory)
import Distribution.Compat.Environment (getEnvironment)
import Distribution.Client.Compat.Environment (lookupEnv)
import System.FilePath ((<.>), (</>), searchPathSeparator)
import System.FilePath ((<.>), (</>))
-- | Return the executable to run and any extra arguments that should be
......@@ -67,25 +67,14 @@ run verbosity lbi exe exeArgs = do
path <- tryCanonicalizePath $
buildPref </> exeName exe </> (exeName exe <.> exeExtension)
env <- (dataDirEnvVar:) <$> getEnvironment
env' <- addLibraryPath lbi exe env
-- Add (DY)LD_LIBRARY_PATH if needed
env' <- if relocatable lbi && withDynExe lbi
then do let (Platform _ os) = hostPlatform lbi
clbi = getComponentLocalBuildInfo lbi
(CExeName (exeName exe))
paths <- fromNubListR <$> depLibraryPaths True False
lbi clbi
addLibraryPath os paths env
else return env
notice verbosity $ "Running " ++ exeName exe ++ "..."
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