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

Cabal/Distribution/Simple/GHC.hs

@@ -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

Cabal/Distribution/Simple/LocalBuildInfo.hs

@@ -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
 

Cabal/Distribution/Simple/Test/ExeV10.hs

@@ -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)
 

Cabal/Distribution/Simple/Test/LibV09.hs

@@ -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)
 

Cabal/Distribution/Simple/Utils.hs

@@ -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
 

cabal-install/Distribution/Client/Run.hs

@@ -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