Skip to content
GitLab
Commit 7e364430 authored by Christiaan Baaij's avatar Christiaan Baaij
Browse files

Split RPath calculation from dependent library calculation

parent fdcb0d9d
Hide whitespace changes
Inline Side-by-side
Cabal/Distribution/Simple/GHC.hs
View file @ 7e364430
......@@ -103,7 +103,7 @@ import Distribution.Verbosity
import Distribution.Text
( display, simpleParse )
import Distribution.Utils.NubList
( overNubListR, toNubListR )
( NubListR, overNubListR, toNubListR )
import Language.Haskell.Extension (Language(..), Extension(..)
,KnownExtension(..))
......@@ -119,7 +119,7 @@ import System.Directory
getAppUserDataDirectory, createDirectoryIfMissing )
import System.FilePath ( (</>), (<.>), takeExtension,
takeDirectory, replaceExtension,
splitExtension )
splitExtension, isRelative )
import qualified System.Info
import System.IO (hClose, hPutStrLn)
import System.Environment (getEnv)
......@@ -874,7 +874,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
else return []
unless (null hObjs && null cObjs && null stubObjs) $ do
rpaths <- depLibraryPaths False True lbi clbi
rpaths <- getRPaths lbi clbi
let staticObjectFiles =
hObjs
......@@ -914,9 +914,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
ghcOptPackages = toNubListR $ mkGhcOptPackages clbi,
ghcOptLinkLibs = toNubListR $ extraLibs libBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi,
ghcOptRPaths = if relocatable lbi
then rpaths
else mempty
ghcOptRPaths = rpaths
}
info verbosity (show (ghcOptPackages ghcSharedLinkArgs))
......@@ -991,7 +989,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
-- build executables
srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath
rpaths <- depLibraryPaths False True lbi clbi
rpaths <- getRPaths lbi clbi
let isGhcDynamic = ghcDynamic comp
dynamicTooSupported = ghcSupportsDynamicToo comp
......@@ -1035,10 +1033,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
ghcOptLinkFrameworks = toNubListR $ PD.frameworks exeBi,
ghcOptInputFiles = toNubListR
[exeDir </> x | x <- cObjs],
ghcOptRPaths = if relocatable lbi &&
withDynExe lbi
then rpaths
else mempty
ghcOptRPaths = rpaths
}
replOpts = baseOpts {
ghcOptExtra = overNubListR filterGhciFlags
......@@ -1121,6 +1116,41 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
info verbosity "Linking..."
runGhcProg linkOpts { ghcOptOutputFile = toFlag (targetDir </> exeNameReal) }
-- | Calculate the RPATHs for the component we are building.
--
-- Calculates relative RPATHs when 'relocatable' is set.
getRPaths :: LocalBuildInfo
-> ComponentLocalBuildInfo -- ^ Component we are building
-> IO (NubListR FilePath)
getRPaths lbi clbi | relocatable lbi && supportRPaths hostOS = do
libraryPaths <- depLibraryPaths False True lbi clbi
let hostPref = case hostOS of
OSX -> "@loader_path"
_ -> "$ORIGIN"
relPath p = if isRelative p then hostPref </> p else p
rpaths = toNubListR (map relPath libraryPaths)
return rpaths
where
(Platform _ hostOS) = hostPlatform lbi
supportRPaths Linux   = True
supportRPaths Windows = False
supportRPaths OSX   = True
supportRPaths FreeBSD   = True
supportRPaths OpenBSD   = True
supportRPaths NetBSD   = True
supportRPaths DragonFly = True
supportRPaths Solaris = True
supportRPaths AIX = False
supportRPaths HPUX = False
supportRPaths IRIX = False
supportRPaths HaLVM = False
supportRPaths IOS = False
supportRPaths (OtherOS _) = False
-- Do _not_ add a default case so that we get a warning here when a new OS
-- is added.
getRPaths _ _ = return mempty
-- | Filter the "-threaded" flag when profiling as it does not
-- work with ghc-6.8 and older.
......
Cabal/Distribution/Simple/LocalBuildInfo.hs
View file @ 7e364430
......@@ -84,9 +84,7 @@ import Distribution.Simple.Utils
import Distribution.Text
( display )
import Distribution.System
( Platform (..), OS (..) )
import Distribution.Utils.NubList
( NubListR, toNubListR )
( Platform (..) )
import Data.Array ((!))
import Data.Binary (Binary)
......@@ -98,7 +96,6 @@ import GHC.Generics (Generic)
import Data.Map (Map)
import System.Directory (doesDirectoryExist, canonicalizePath)
import System.FilePath ((</>))
-- | Data cached after configuration step. See also
-- 'Distribution.Simple.Setup.ConfigFlags'.
......@@ -411,12 +408,15 @@ checkComponentsCyclic es =
[] -> Nothing
(c:_) -> Just (map vertexToNode c)
-- | Determine the directories containing the dynamic libraries of the
-- transitive dependencies of the component we are building.
--
-- When wanted, and possible, returns paths relative to the installDirs 'prefix'
depLibraryPaths :: Bool -- ^ Building for inplace?
-> Bool -- ^ Generate prefix-relative rpaths
-> Bool -- ^ Generate prefix-relative library paths
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO (NubListR FilePath)
-> ComponentLocalBuildInfo -- ^ Component that is being built
-> IO [FilePath]
depLibraryPaths inplace relative lbi clbi = do
let pkgDescr = localPkgDescr lbi
installDirs = absoluteInstallDirs pkgDescr lbi NoCopyDest
......@@ -442,24 +442,18 @@ depLibraryPaths inplace relative lbi clbi = do
else allDepLibDirs
allDepLibDirsC <- mapM canonicalizePathNoFail 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
libPaths
| relative &&
prefixRelative relDir = map (\l ->
if prefixRelative l
then hostPref </>
shortRelativePath relDir l
then shortRelativePath relDir l
else l
) allDepLibDirsC
| otherwise = allDepLibDirsC
return (toNubListR rpaths)
return libPaths
where
internal pkgid = pkgid == packageId (localPkgDescr lbi)
canonicalizePathNoFail p = do
......
Cabal/Distribution/Simple/Test/ExeV10.hs
View file @ 7e364430
......@@ -21,12 +21,10 @@ import Distribution.Simple.Utils
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 )
......@@ -88,8 +86,7 @@ runTest pkg_descr lbi flags suite = do
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
paths <- LBI.depLibraryPaths True False lbi clbi
addLibraryPath os paths shellEnv
else return shellEnv
......
Cabal/Distribution/Simple/Test/LibV09.hs
View file @ 7e364430
......@@ -27,12 +27,10 @@ import Distribution.Simple.Utils
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
......@@ -98,9 +96,8 @@ runTest pkg_descr lbi flags suite = do
lbi
(LBI.CTestName
(PD.testName suite))
paths <- fromNubListR <$>
LBI.depLibraryPaths
True False lbi clbi
paths <- LBI.depLibraryPaths
True False lbi clbi
addLibraryPath os paths shellEnv
else return shellEnv
rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv')
......
cabal-install/Distribution/Client/Run.hs
View file @ 7e364430
......@@ -23,7 +23,6 @@ import Distribution.Simple.LocalBuildInfo (ComponentName (..),
import Distribution.Simple.Utils (die, notice, rawSystemExitWithEnv,
addLibraryPath)
import Distribution.System (Platform (..))
import Distribution.Utils.NubList (fromNubListR)
import Distribution.Verbosity (Verbosity)
import Data.Functor ((<$>))
......@@ -72,8 +71,7 @@ run verbosity lbi exe exeArgs = do
then do let (Platform _ os) = hostPlatform lbi
clbi = getComponentLocalBuildInfo lbi
(CExeName (exeName exe))
paths <- fromNubListR <$> depLibraryPaths True False
lbi clbi
paths <- depLibraryPaths True False lbi clbi
addLibraryPath os paths env
else return env
notice verbosity $ "Running " ++ exeName exe ++ "..."
......
Supports Markdown
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