From 06a713e1cf96482e325df09dd28770687f151dc9 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Fri, 21 Nov 2014 16:55:56 +0100 Subject: [PATCH 01/33] Start support of relocatable builds --- Cabal/Distribution/Simple/Configure.hs | 13 ++++++++++++- Cabal/Distribution/Simple/GHC.hs | 21 +++++++++++++++++---- Cabal/Distribution/Simple/LocalBuildInfo.hs | 3 ++- Cabal/Distribution/Simple/Program/GHC.hs | 4 ++++ Cabal/Distribution/Simple/Setup.hs | 17 +++++++++++++---- cabal-install/Distribution/Client/Config.hs | 3 ++- 6 files changed, 50 insertions(+), 11 deletions(-) diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index ba8a65a039d..340699b0350 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -601,6 +601,16 @@ configure (pkg_descr0, pbi) cfg GHC.ghcDynamic comp _ -> False + reloc <- + if not (fromFlag $ configRelocatable cfg) + then return False + else case flavor of + GHC | version >= Version [7,8] [] -> return True + _ -> do warn verbosity + ("this compiler does not support " ++ + "--enable-relocatable; ignoring") + return False + let lbi = LocalBuildInfo { configFlags = cfg, extraConfigArgs = [], -- Currently configure does not @@ -631,7 +641,8 @@ configure (pkg_descr0, pbi) cfg stripLibs = fromFlag $ configStripLibs cfg, withPackageDB = packageDbs, progPrefix = fromFlag $ configProgPrefix cfg, - progSuffix = fromFlag $ configProgSuffix cfg + progSuffix = fromFlag $ configProgSuffix cfg, + relocatable = reloc } let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 66cef777b89..74e44a3c92b 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -102,7 +102,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(..)) @@ -906,11 +906,18 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do ghcOptPackageKey = toFlag (pkgKey lbi), ghcOptNoAutoLinkPackages = toFlag True, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi , + ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptLinkOptions = if (hostOS == OSX + && relocatable lbi) + then toRPaths lbi clbi + else mempty, ghcOptLinkLibs = toNubListR $ extraLibs libBi, - ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi + ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, + ghcOptNoRPath = toFlag (relocatable lbi) } + info verbosity (show (ghcOptPackages ghcSharedLinkArgs)) + whenVanillaLib False $ do Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles @@ -925,6 +932,11 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do whenSharedLib False $ runGhcProg ghcSharedLinkArgs +toRPaths :: LocalBuildInfo + -> ComponentLocalBuildInfo + -> NubListR String +toRPaths = undefined + -- | Start a REPL without loading any source files. startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler -> PackageDBStack -> IO () @@ -1022,7 +1034,8 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi ghcOptLinkLibPath = toNubListR $ extraLibDirs exeBi, ghcOptLinkFrameworks = toNubListR $ PD.frameworks exeBi, ghcOptInputFiles = toNubListR - [exeDir x | x <- cObjs] + [exeDir x | x <- cObjs], + ghcOptNoRPath = toFlag (relocatable lbi) } replOpts = baseOpts { ghcOptExtra = overNubListR filterGhciFlags diff --git a/Cabal/Distribution/Simple/LocalBuildInfo.hs b/Cabal/Distribution/Simple/LocalBuildInfo.hs index 98f1ddaf597..460af60ae6e 100644 --- a/Cabal/Distribution/Simple/LocalBuildInfo.hs +++ b/Cabal/Distribution/Simple/LocalBuildInfo.hs @@ -139,7 +139,8 @@ data LocalBuildInfo = LocalBuildInfo { stripExes :: Bool, -- ^Whether to strip executables during install stripLibs :: Bool, -- ^Whether to strip libraries during install progPrefix :: PathTemplate, -- ^Prefix to be prepended to installed executables - progSuffix :: PathTemplate -- ^Suffix to be appended to installed executables + progSuffix :: PathTemplate, -- ^Suffix to be appended to installed executables + relocatable :: Bool -- ^Whether to build a relocatable package } deriving (Generic, Read, Show) instance Binary LocalBuildInfo diff --git a/Cabal/Distribution/Simple/Program/GHC.hs b/Cabal/Distribution/Simple/Program/GHC.hs index ccbf87b809c..b956cb5d78a 100644 --- a/Cabal/Distribution/Simple/Program/GHC.hs +++ b/Cabal/Distribution/Simple/Program/GHC.hs @@ -189,6 +189,7 @@ data GhcOptions = GhcOptions { ghcOptShared :: Flag Bool, ghcOptFPic :: Flag Bool, ghcOptDylibName :: Flag String, + ghcOptNoRPath :: Flag Bool, -- ^ Don't embed any runtime paths. --------------- -- Misc flags @@ -336,6 +337,7 @@ renderGhcOptions comp opts , ["-L" ++ dir | dir <- flags ghcOptLinkLibPath ] , concat [ ["-framework", fmwk] | fmwk <- flags ghcOptLinkFrameworks ] , [ "-no-hs-main" | flagBool ghcOptLinkNoHsMain ] + , [ "-dynload deploy" | flagBool ghcOptNoRPath ] ------------- -- Packages @@ -488,6 +490,7 @@ instance Monoid GhcOptions where ghcOptShared = mempty, ghcOptFPic = mempty, ghcOptDylibName = mempty, + ghcOptNoRPath = mempty, ghcOptVerbosity = mempty, ghcOptCabal = mempty } @@ -539,6 +542,7 @@ instance Monoid GhcOptions where ghcOptShared = combine ghcOptShared, ghcOptFPic = combine ghcOptFPic, ghcOptDylibName = combine ghcOptDylibName, + ghcOptNoRPath = combine ghcOptNoRPath, ghcOptVerbosity = combine ghcOptVerbosity, ghcOptCabal = combine ghcOptCabal } diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 43d68ced78f..a4be6ef5098 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -304,8 +304,9 @@ data ConfigFlags = ConfigFlags { configExactConfiguration :: Flag Bool, -- ^All direct dependencies and flags are provided on the command line by -- the user via the '--dependency' and '--flags' options. - configFlagError :: Flag String + configFlagError :: Flag String, -- ^Halt and show an error message indicating an error in flag assignment + configRelocatable :: Flag Bool -- ^ Enable relocatable package built } deriving (Generic, Read, Show) @@ -346,7 +347,8 @@ defaultConfigFlags progConf = emptyConfigFlags { configCoverage = Flag False, configLibCoverage = NoFlag, configExactConfiguration = Flag False, - configFlagError = NoFlag + configFlagError = NoFlag, + configRelocatable = Flag False } configureCommand :: ProgramConfiguration -> CommandUI ConfigFlags @@ -549,6 +551,11 @@ configureOptions showOrParseArgs = "dependency checking and compilation for benchmarks listed in the package description file." configBenchmarks (\v flags -> flags { configBenchmarks = v }) (boolOpt [] []) + + ,option "" ["relocatable"] + "building a package that is relocatable. (GHC only)" + configRelocatable (\v flags -> flags { configRelocatable = v}) + (boolOpt [] []) ] where readFlagList :: String -> FlagAssignment @@ -702,7 +709,8 @@ instance Monoid ConfigFlags where configLibCoverage = mempty, configExactConfiguration = mempty, configBenchmarks = mempty, - configFlagError = mempty + configFlagError = mempty, + configRelocatable = mempty } mappend a b = ConfigFlags { configPrograms = configPrograms b, @@ -742,7 +750,8 @@ instance Monoid ConfigFlags where configLibCoverage = combine configLibCoverage, configExactConfiguration = combine configExactConfiguration, configBenchmarks = combine configBenchmarks, - configFlagError = combine configFlagError + configFlagError = combine configFlagError, + configRelocatable = combine configRelocatable } where combine field = field a `mappend` field b diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index bc70b8ffa09..095ce819c0d 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -293,7 +293,8 @@ instance Monoid SavedConfig where configCoverage = combine configCoverage, configLibCoverage = combine configLibCoverage, configExactConfiguration = combine configExactConfiguration, - configFlagError = combine configFlagError + configFlagError = combine configFlagError, + configRelocatable = combine configRelocatable } where combine = combine' savedConfigureFlags From 6c9dce4c0686061cfb8e2575dbe459c50701646d Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Mon, 24 Nov 2014 11:19:02 +0100 Subject: [PATCH 02/33] Enable support for relocatable libraries --- Cabal/Distribution/Simple/GHC.hs | 38 +++++++++++++++++------- Cabal/Distribution/Simple/Program/GHC.hs | 10 ++++--- 2 files changed, 34 insertions(+), 14 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 74e44a3c92b..1309cd49743 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -93,7 +93,7 @@ import qualified Distribution.Simple.Setup as Cabal import Distribution.Simple.Compiler ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion , OptimisationLevel(..), PackageDB(..), PackageDBStack, AbiTag(..) - , Flag ) + , Flag, packageKeySupported ) import Distribution.Version ( Version(..), anyVersion, orLaterVersion ) import Distribution.System @@ -907,13 +907,12 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do ghcOptNoAutoLinkPackages = toFlag True, ghcOptPackageDBs = withPackageDB lbi, ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, - ghcOptLinkOptions = if (hostOS == OSX - && relocatable lbi) - then toRPaths lbi clbi - else mempty, ghcOptLinkLibs = toNubListR $ extraLibs libBi, ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, - ghcOptNoRPath = toFlag (relocatable lbi) + ghcOptRPaths = if (hostOS == OSX + && relocatable lbi) + then toRPaths False lbi clbi + else mempty } info verbosity (show (ghcOptPackages ghcSharedLinkArgs)) @@ -932,10 +931,25 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do whenSharedLib False $ runGhcProg ghcSharedLinkArgs -toRPaths :: LocalBuildInfo +-- | Derive relative RPATHs +toRPaths :: Bool -- ^ Building exe? + -> LocalBuildInfo -> ComponentLocalBuildInfo - -> NubListR String -toRPaths = undefined + -> NubListR FilePath +toRPaths buildE lbi clbi = toNubListR $ map (libPref ) depsK + where + (Platform _hostArch hostOS) = hostPlatform lbi + ipkgs = installedPkgs lbi + deps = map fst (componentPackageDeps clbi) + depsP = catMaybes (map (PackageIndex.lookupInstalledPackageId ipkgs) deps) + depsK = if packageKeySupported (compiler lbi) + then map (display . InstalledPackageInfo.packageKey) depsP + else map (display . snd) (componentPackageDeps clbi) + + hostPref = case hostOS of + OSX -> "@origin" + _ -> "$ORIGIN" + libPref = hostPref (if buildE then ".." "lib" else "..") -- | Start a REPL without loading any source files. startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler @@ -966,6 +980,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) let comp = compiler lbi runGhcProg = runGHC verbosity ghcProg comp + (Platform _hostArch hostOS) = hostPlatform lbi exeBi <- hackThreadedFlag verbosity comp (withProfExe lbi) (buildInfo exe) @@ -1035,7 +1050,10 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi ghcOptLinkFrameworks = toNubListR $ PD.frameworks exeBi, ghcOptInputFiles = toNubListR [exeDir x | x <- cObjs], - ghcOptNoRPath = toFlag (relocatable lbi) + ghcOptRPaths = if (hostOS == OSX + && relocatable lbi) + then toRPaths True lbi clbi + else mempty } replOpts = baseOpts { ghcOptExtra = overNubListR filterGhciFlags diff --git a/Cabal/Distribution/Simple/Program/GHC.hs b/Cabal/Distribution/Simple/Program/GHC.hs index b956cb5d78a..c07ff31820c 100644 --- a/Cabal/Distribution/Simple/Program/GHC.hs +++ b/Cabal/Distribution/Simple/Program/GHC.hs @@ -189,7 +189,7 @@ data GhcOptions = GhcOptions { ghcOptShared :: Flag Bool, ghcOptFPic :: Flag Bool, ghcOptDylibName :: Flag String, - ghcOptNoRPath :: Flag Bool, -- ^ Don't embed any runtime paths. + ghcOptRPaths :: NubListR FilePath, --------------- -- Misc flags @@ -337,7 +337,9 @@ renderGhcOptions comp opts , ["-L" ++ dir | dir <- flags ghcOptLinkLibPath ] , concat [ ["-framework", fmwk] | fmwk <- flags ghcOptLinkFrameworks ] , [ "-no-hs-main" | flagBool ghcOptLinkNoHsMain ] - , [ "-dynload deploy" | flagBool ghcOptNoRPath ] + , [ "-dynload deploy" | not (null (flags ghcOptRPaths)) ] + , concat [ [ "-optl-Wl,-rpath," ++ dir] + | dir <- flags ghcOptRPaths ] ------------- -- Packages @@ -490,7 +492,7 @@ instance Monoid GhcOptions where ghcOptShared = mempty, ghcOptFPic = mempty, ghcOptDylibName = mempty, - ghcOptNoRPath = mempty, + ghcOptRPaths = mempty, ghcOptVerbosity = mempty, ghcOptCabal = mempty } @@ -542,7 +544,7 @@ instance Monoid GhcOptions where ghcOptShared = combine ghcOptShared, ghcOptFPic = combine ghcOptFPic, ghcOptDylibName = combine ghcOptDylibName, - ghcOptNoRPath = combine ghcOptNoRPath, + ghcOptRPaths = combine ghcOptRPaths, ghcOptVerbosity = combine ghcOptVerbosity, ghcOptCabal = combine ghcOptCabal } From 859a576bd0325d66f5ea02ced6be9217bffa3ffd Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Mon, 24 Nov 2014 15:38:08 +0100 Subject: [PATCH 03/33] Enable registration of relocatable packages --- Cabal/Distribution/Simple/Register.hs | 35 +++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index 819afbeb3a9..d7a121e52d7 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -98,8 +98,9 @@ register :: PackageDescription -> LocalBuildInfo register pkg@PackageDescription { library = Just lib } lbi regFlags = do let clbi = getComponentLocalBuildInfo lbi CLibName + installedPkgInfo <- generateRegistrationInfo - verbosity pkg lib lbi clbi inplace distPref + verbosity pkg lib lbi clbi inplace reloc distPref when (fromFlag (regPrintId regFlags)) $ do putStrLn (display (IPI.installedPackageId installedPkgInfo)) @@ -119,6 +120,7 @@ register pkg@PackageDescription { library = Just lib } lbi regFlags modeGenerateRegScript = fromFlag (regGenScript regFlags) inplace = fromFlag (regInPlace regFlags) + reloc = relocatable lbi -- FIXME: there's really no guarantee this will work. -- registering into a totally different db stack can -- fail if dependencies cannot be satisfied. @@ -152,9 +154,10 @@ generateRegistrationInfo :: Verbosity -> LocalBuildInfo -> ComponentLocalBuildInfo -> Bool + -> Bool -> FilePath -> IO InstalledPackageInfo -generateRegistrationInfo verbosity pkg lib lbi clbi inplace distPref = do +generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref = do --TODO: eliminate pwd! pwd <- getCurrentDirectory @@ -172,6 +175,8 @@ generateRegistrationInfo verbosity pkg lib lbi clbi inplace distPref = do let installedPkgInfo | inplace = inplaceInstalledPackageInfo pwd distPref pkg ipid lib lbi clbi + | reloc = relocatableInstalledPackageInfo + pkg ipid lib lbi clbi | otherwise = absoluteInstalledPackageInfo pkg ipid lib lbi clbi @@ -372,6 +377,32 @@ absoluteInstalledPackageInfo pkg ipid lib lbi clbi = bi = libBuildInfo lib installDirs = absoluteInstallDirs pkg lbi NoCopyDest + +relocatableInstalledPackageInfo :: PackageDescription + -> InstalledPackageId + -> Library + -> LocalBuildInfo + -> ComponentLocalBuildInfo + -> InstalledPackageInfo +relocatableInstalledPackageInfo pkg ipid lib lbi clbi = + generalInstalledPackageInfo adjustReativeIncludeDirs + pkg ipid lib lbi clbi installDirs + where + -- For installed packages we install all include files into one dir, + -- whereas in the build tree they may live in multiple local dirs. + adjustReativeIncludeDirs _ + | null (installIncludes bi) = [] + | otherwise = [includedir installDirs] + bi = libBuildInfo lib + installDirs = + (absoluteInstallDirs pkg lbi NoCopyDest) { + libdir = "${pkgroot}" display (pkgKey lbi), + haddockdir = "${pkgroot}" "share" "doc" "ghc" "html" + "libraries" display (package pkg), + htmldir = "${pkgrooturl}/../share/doc/ghc/html/libraries/" ++ + display (package pkg) + } + -- ----------------------------------------------------------------------------- -- Unregistration From cf218c711863b7a03b176b1172ebc52ba2ae3421 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Mon, 24 Nov 2014 16:40:10 +0100 Subject: [PATCH 04/33] Fix library documentation paths --- Cabal/Distribution/Simple/Register.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index d7a121e52d7..3b446779e4f 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -397,9 +397,9 @@ relocatableInstalledPackageInfo pkg ipid lib lbi clbi = installDirs = (absoluteInstallDirs pkg lbi NoCopyDest) { libdir = "${pkgroot}" display (pkgKey lbi), - haddockdir = "${pkgroot}" "share" "doc" "ghc" "html" - "libraries" display (package pkg), - htmldir = "${pkgrooturl}/../share/doc/ghc/html/libraries/" ++ + haddockdir = "${pkgroot}" ".." ".." "share" "doc" + "ghc" "html" "libraries" display (package pkg), + htmldir = "${pkgrooturl}/../../share/doc/ghc/html/libraries/" ++ display (package pkg) } From a650e8da5e5b8394a82371c02ae9e2c16c65b2d1 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Tue, 25 Nov 2014 16:27:17 +0100 Subject: [PATCH 05/33] Setup correct package registration paths for relocatable packages --- Cabal/Distribution/Simple/InstallDirs.hs | 37 ++++++++++++++++++++ Cabal/Distribution/Simple/Register.hs | 14 +++----- cabal-install/Distribution/Client/Install.hs | 2 +- 3 files changed, 42 insertions(+), 11 deletions(-) diff --git a/Cabal/Distribution/Simple/InstallDirs.hs b/Cabal/Distribution/Simple/InstallDirs.hs index 33dd41ba254..390ecf3ea14 100644 --- a/Cabal/Distribution/Simple/InstallDirs.hs +++ b/Cabal/Distribution/Simple/InstallDirs.hs @@ -28,6 +28,7 @@ module Distribution.Simple.InstallDirs ( CopyDest(..), prefixRelativeInstallDirs, substituteInstallDirTemplates, + substituteInstallDirTemplatesNP, PathTemplate, PathTemplateVariable(..), @@ -280,6 +281,42 @@ substituteInstallDirTemplates env dirs = dirs' prefixBinLibVars = [prefixVar, bindirVar, libdirVar, libsubdirVar] prefixBinLibDataVars = prefixBinLibVars ++ [datadirVar, datasubdirVar] +-- | Like 'substituteInstallDirTemplates', but does not allow substitution of +-- the 'prefix' variable +substituteInstallDirTemplatesNP :: PathTemplateEnv + -> InstallDirTemplates -> InstallDirTemplates +substituteInstallDirTemplatesNP env dirs = dirs' + where + dirs' = InstallDirs { + -- So this specifies exactly which vars are allowed in each template + prefix = subst prefix [], + bindir = subst bindir [], + libdir = subst libdir [bindirVar], + libsubdir = subst libsubdir [], + dynlibdir = subst dynlibdir [bindirVar, libdirVar], + libexecdir = subst libexecdir prefixBinLibVars, + includedir = subst includedir prefixBinLibVars, + datadir = subst datadir prefixBinLibVars, + datasubdir = subst datasubdir [], + docdir = subst docdir prefixBinLibDataVars, + mandir = subst mandir (prefixBinLibDataVars ++ [docdirVar]), + htmldir = subst htmldir (prefixBinLibDataVars ++ [docdirVar]), + haddockdir = subst haddockdir (prefixBinLibDataVars ++ + [docdirVar, htmldirVar]), + sysconfdir = subst sysconfdir prefixBinLibVars + } + subst dir env' = substPathTemplate (env'++env) (dir dirs) + + bindirVar = (BindirVar, bindir dirs') + libdirVar = (LibdirVar, libdir dirs') + libsubdirVar = (LibsubdirVar, libsubdir dirs') + datadirVar = (DatadirVar, datadir dirs') + datasubdirVar = (DatasubdirVar, datasubdir dirs') + docdirVar = (DocdirVar, docdir dirs') + htmldirVar = (HtmldirVar, htmldir dirs') + prefixBinLibVars = [bindirVar, libdirVar, libsubdirVar] + prefixBinLibDataVars = prefixBinLibVars ++ [datadirVar, datasubdirVar] + -- | Convert from abstract install directories to actual absolute ones by -- substituting for all the variables in the abstract paths, to get real -- absolute path. diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index 3b446779e4f..1cf77c64990 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -40,7 +40,7 @@ import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) , ComponentName(..), getComponentLocalBuildInfo , LibraryName(..) - , InstallDirs(..), absoluteInstallDirs ) + , InstallDirs(..), absoluteInstallDirs, prefixRelativeInstallDirs ) import Distribution.Simple.BuildPaths (haddockName) import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.LHC as LHC @@ -84,7 +84,7 @@ import System.Directory import Control.Monad (when) import Data.Maybe - ( isJust, fromMaybe, maybeToList ) + ( isJust, fromJust, fromMaybe, maybeToList ) import Data.List ( partition, nub ) import qualified Data.ByteString.Lazy.Char8 as BS.Char8 @@ -394,14 +394,8 @@ relocatableInstalledPackageInfo pkg ipid lib lbi clbi = | null (installIncludes bi) = [] | otherwise = [includedir installDirs] bi = libBuildInfo lib - installDirs = - (absoluteInstallDirs pkg lbi NoCopyDest) { - libdir = "${pkgroot}" display (pkgKey lbi), - haddockdir = "${pkgroot}" ".." ".." "share" "doc" - "ghc" "html" "libraries" display (package pkg), - htmldir = "${pkgrooturl}/../../share/doc/ghc/html/libraries/" ++ - display (package pkg) - } + installDirs = fmap (((("${pkgroot}" "..") "..") ) . fromJust) + $ prefixRelativeInstallDirs (packageId pkg) lbi -- ----------------------------------------------------------------------------- -- Unregistration diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 0ae8c00f1f3..cdb8c5026f2 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -1421,7 +1421,7 @@ installUnpackedPackage verbosity buildLimit installLock numJobs pkg_key defInstallDirs <- InstallDirs.defaultInstallDirs flavor userInstall False return $ configFlags' { configInstallDirs = fmap Cabal.Flag . - InstallDirs.substituteInstallDirTemplates env $ + InstallDirs.substituteInstallDirTemplatesNP env $ InstallDirs.combineInstallDirs fromFlagOrDefault defInstallDirs (configInstallDirs configFlags) } From da41e21078b2f8a05bd37659c57c24dbd5b6ea2f Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Tue, 25 Nov 2014 16:28:20 +0100 Subject: [PATCH 06/33] Relocatable flag not passed to older versions of Cabal --- cabal-install/Distribution/Client/Setup.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 8f4538444b8..066787e9feb 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -276,13 +276,16 @@ filterConfigureFlags flags cabalLibVersion | cabalLibVersion < Version [1,18,0] [] = flags_1_18_0 | cabalLibVersion < Version [1,19,1] [] = flags_1_19_0 | cabalLibVersion < Version [1,19,2] [] = flags_1_19_1 + | cabalLibVersion < Version [1,21,1] [] = flags_1_21_1 | otherwise = flags_latest where -- Cabal >= 1.19.1 uses '--dependency' and does not need '--constraint'. flags_latest = flags { configConstraints = [] } + -- Cabal < 1.21.1 doesn't know about 'disable-relocatable' + flags_1_21_1 = flags_latest { configRelocatable = NoFlag } -- Cabal < 1.19.2 doesn't know about '--exact-configuration'. - flags_1_19_1 = flags_latest { configExactConfiguration = NoFlag } + flags_1_19_1 = flags_1_21_1 { configExactConfiguration = NoFlag } -- Cabal < 1.19.1 uses '--constraint' instead of '--dependency'. flags_1_19_0 = flags_1_19_1 { configDependencies = [] , configConstraints = configConstraints flags } From ae56bb3915ae6383ca5706e398521989c11434e2 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Tue, 25 Nov 2014 19:35:09 +0100 Subject: [PATCH 07/33] Correctly set rpaths --- Cabal/Distribution/Simple/GHC.hs | 45 +++++++++++++++++++++++--------- 1 file changed, 33 insertions(+), 12 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 1309cd49743..c25f307fa90 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -62,13 +62,14 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) - , LibraryName(..), absoluteInstallDirs ) + , LibraryName(..), absoluteInstallDirs, prefixRelativeInstallDirs ) import qualified Distribution.Simple.Hpc as Hpc -import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs ) +import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs, + prefixRelativeInstallDirs ) import Distribution.Simple.BuildPaths import Distribution.Simple.Utils import Distribution.Package - ( PackageName(..), InstalledPackageId, PackageId ) + ( PackageName(..), Package(..), InstalledPackageId, PackageId ) import qualified Distribution.ModuleName as ModuleName import Distribution.Simple.Program ( Program(..), ConfiguredProgram(..), ProgramConfiguration @@ -110,13 +111,13 @@ 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 ) +import Data.Maybe ( catMaybes, fromJust, fromMaybe, maybeToList ) import Data.Monoid ( Monoid(..) ) import System.Directory ( getDirectoryContents, doesFileExist, getTemporaryDirectory ) import System.FilePath ( (), (<.>), takeExtension, takeDirectory, replaceExtension, - splitExtension ) + splitExtension, splitDirectories, joinPath ) import System.IO (hClose, hPutStrLn) import System.Environment (getEnv) import Distribution.Compat.Exception (catchExit, catchIO) @@ -911,7 +912,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, ghcOptRPaths = if (hostOS == OSX && relocatable lbi) - then toRPaths False lbi clbi + then toRPaths False pkg_descr lbi clbi else mempty } @@ -933,10 +934,11 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do -- | Derive relative RPATHs toRPaths :: Bool -- ^ Building exe? + -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> NubListR FilePath -toRPaths buildE lbi clbi = toNubListR $ map (libPref ) depsK +toRPaths buildE _pkg_descr lbi clbi = toNubListR $ map (libPref ) depsK where (Platform _hostArch hostOS) = hostPlatform lbi ipkgs = installedPkgs lbi @@ -946,10 +948,29 @@ toRPaths buildE lbi clbi = toNubListR $ map (libPref ) depsK then map (display . InstalledPackageInfo.packageKey) depsP else map (display . snd) (componentPackageDeps clbi) - hostPref = case hostOS of - OSX -> "@origin" - _ -> "$ORIGIN" - libPref = hostPref (if buildE then ".." "lib" else "..") + + installDirs = fmap fromJust (prefixRelativeInstallDirs (packageId _pkg_descr) lbi) + + relPref = shortRelativePath (bindir installDirs) + (takeDirectory (libdir installDirs)) + + libPref = case hostOS of + OSX -> if buildE + then "@loader_path" relPref + else "@origin" ".." + _ -> if buildE + then "$ORIGIN" relPref + else "$ORIGIN" ".." + + dropCommonPrefix :: Eq a => [a] -> [a] -> ([a],[a]) + dropCommonPrefix (x:xs) (y:ys) + | x == y = dropCommonPrefix xs ys + dropCommonPrefix xs ys = (xs,ys) + + shortRelativePath :: FilePath -> FilePath -> FilePath + shortRelativePath from to = + case dropCommonPrefix (splitDirectories from) (splitDirectories to) of + (stuff, path) -> joinPath (map (const "..") stuff ++ path) -- | Start a REPL without loading any source files. startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler @@ -1052,7 +1073,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi [exeDir x | x <- cObjs], ghcOptRPaths = if (hostOS == OSX && relocatable lbi) - then toRPaths True lbi clbi + then toRPaths True _pkg_descr lbi clbi else mempty } replOpts = baseOpts { From a1328251ca09c26025b3af80d932d9d751e04a70 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Tue, 25 Nov 2014 19:35:25 +0100 Subject: [PATCH 08/33] Correctly name flag restriction --- cabal-install/Distribution/Client/Setup.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 066787e9feb..7083c84a3b0 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -276,16 +276,16 @@ filterConfigureFlags flags cabalLibVersion | cabalLibVersion < Version [1,18,0] [] = flags_1_18_0 | cabalLibVersion < Version [1,19,1] [] = flags_1_19_0 | cabalLibVersion < Version [1,19,2] [] = flags_1_19_1 - | cabalLibVersion < Version [1,21,1] [] = flags_1_21_1 + | cabalLibVersion < Version [1,21,1] [] = flags_1_20_0 | otherwise = flags_latest where -- Cabal >= 1.19.1 uses '--dependency' and does not need '--constraint'. flags_latest = flags { configConstraints = [] } -- Cabal < 1.21.1 doesn't know about 'disable-relocatable' - flags_1_21_1 = flags_latest { configRelocatable = NoFlag } + flags_1_20_0 = flags_latest { configRelocatable = NoFlag } -- Cabal < 1.19.2 doesn't know about '--exact-configuration'. - flags_1_19_1 = flags_1_21_1 { configExactConfiguration = NoFlag } + flags_1_19_1 = flags_1_20_0 { configExactConfiguration = NoFlag } -- Cabal < 1.19.1 uses '--constraint' instead of '--dependency'. flags_1_19_0 = flags_1_19_1 { configDependencies = [] , configConstraints = configConstraints flags } From 717cf359c98e0601d372385484329e3a120b6d12 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Wed, 26 Nov 2014 15:16:14 +0100 Subject: [PATCH 09/33] Correctly calculate relative paths for relocatable packages --- Cabal/Distribution/Simple/GHC.hs | 63 +++++++------------ Cabal/Distribution/Simple/InstallDirs.hs | 37 ----------- Cabal/Distribution/Simple/Program/HcPkg.hs | 43 +++++++++++++ Cabal/Distribution/Simple/Register.hs | 65 +++++++++++++++----- Cabal/Distribution/Simple/Utils.hs | 13 +++- cabal-install/Distribution/Client/Install.hs | 2 +- 6 files changed, 127 insertions(+), 96 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index c25f307fa90..e487f5474b7 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -62,14 +62,13 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) - , LibraryName(..), absoluteInstallDirs, prefixRelativeInstallDirs ) + , LibraryName(..), absoluteInstallDirs ) import qualified Distribution.Simple.Hpc as Hpc -import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs, - prefixRelativeInstallDirs ) +import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs ) import Distribution.Simple.BuildPaths import Distribution.Simple.Utils import Distribution.Package - ( PackageName(..), Package(..), InstalledPackageId, PackageId ) + ( PackageName(..), InstalledPackageId, PackageId ) import qualified Distribution.ModuleName as ModuleName import Distribution.Simple.Program ( Program(..), ConfiguredProgram(..), ProgramConfiguration @@ -94,7 +93,7 @@ import qualified Distribution.Simple.Setup as Cabal import Distribution.Simple.Compiler ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion , OptimisationLevel(..), PackageDB(..), PackageDBStack, AbiTag(..) - , Flag, packageKeySupported ) + , Flag ) import Distribution.Version ( Version(..), anyVersion, orLaterVersion ) import Distribution.System @@ -111,13 +110,13 @@ 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, fromJust, fromMaybe, maybeToList ) +import Data.Maybe ( catMaybes, fromMaybe, maybeToList ) import Data.Monoid ( Monoid(..) ) import System.Directory ( getDirectoryContents, doesFileExist, getTemporaryDirectory ) import System.FilePath ( (), (<.>), takeExtension, takeDirectory, replaceExtension, - splitExtension, splitDirectories, joinPath ) + splitExtension ) import System.IO (hClose, hPutStrLn) import System.Environment (getEnv) import Distribution.Compat.Exception (catchExit, catchIO) @@ -912,7 +911,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, ghcOptRPaths = if (hostOS == OSX && relocatable lbi) - then toRPaths False pkg_descr lbi clbi + then toRPaths False pkg_descr lbi else mempty } @@ -936,41 +935,21 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do toRPaths :: Bool -- ^ Building exe? -> PackageDescription -> LocalBuildInfo - -> ComponentLocalBuildInfo -> NubListR FilePath -toRPaths buildE _pkg_descr lbi clbi = toNubListR $ map (libPref ) depsK +toRPaths buildE _pkg_descr lbi = toNubListR (map (hostPref ) refDirs) where - (Platform _hostArch hostOS) = hostPlatform lbi - ipkgs = installedPkgs lbi - deps = map fst (componentPackageDeps clbi) - depsP = catMaybes (map (PackageIndex.lookupInstalledPackageId ipkgs) deps) - depsK = if packageKeySupported (compiler lbi) - then map (display . InstalledPackageInfo.packageKey) depsP - else map (display . snd) (componentPackageDeps clbi) - - - installDirs = fmap fromJust (prefixRelativeInstallDirs (packageId _pkg_descr) lbi) - - relPref = shortRelativePath (bindir installDirs) - (takeDirectory (libdir installDirs)) - - libPref = case hostOS of - OSX -> if buildE - then "@loader_path" relPref - else "@origin" ".." - _ -> if buildE - then "$ORIGIN" relPref - else "$ORIGIN" ".." - - dropCommonPrefix :: Eq a => [a] -> [a] -> ([a],[a]) - dropCommonPrefix (x:xs) (y:ys) - | x == y = dropCommonPrefix xs ys - dropCommonPrefix xs ys = (xs,ys) - - shortRelativePath :: FilePath -> FilePath -> FilePath - shortRelativePath from to = - case dropCommonPrefix (splitDirectories from) (splitDirectories to) of - (stuff, path) -> joinPath (map (const "..") stuff ++ path) + installDirs = absoluteInstallDirs _pkg_descr lbi NoCopyDest + relDir | buildE = bindir installDirs + | otherwise = libdir installDirs + + ipkgs = PackageIndex.allPackages (installedPkgs lbi) + allDepLibDirs = concatMap InstalledPackageInfo.libraryDirs ipkgs + refDirs = map (shortRelativePath relDir) allDepLibDirs + + (Platform _ hostOS) = hostPlatform lbi + hostPref = case hostOS of + OSX -> "@loader_path" + _ -> "$ORIGIN" -- | Start a REPL without loading any source files. startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler @@ -1073,7 +1052,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi [exeDir x | x <- cObjs], ghcOptRPaths = if (hostOS == OSX && relocatable lbi) - then toRPaths True _pkg_descr lbi clbi + then toRPaths True _pkg_descr lbi else mempty } replOpts = baseOpts { diff --git a/Cabal/Distribution/Simple/InstallDirs.hs b/Cabal/Distribution/Simple/InstallDirs.hs index 390ecf3ea14..33dd41ba254 100644 --- a/Cabal/Distribution/Simple/InstallDirs.hs +++ b/Cabal/Distribution/Simple/InstallDirs.hs @@ -28,7 +28,6 @@ module Distribution.Simple.InstallDirs ( CopyDest(..), prefixRelativeInstallDirs, substituteInstallDirTemplates, - substituteInstallDirTemplatesNP, PathTemplate, PathTemplateVariable(..), @@ -281,42 +280,6 @@ substituteInstallDirTemplates env dirs = dirs' prefixBinLibVars = [prefixVar, bindirVar, libdirVar, libsubdirVar] prefixBinLibDataVars = prefixBinLibVars ++ [datadirVar, datasubdirVar] --- | Like 'substituteInstallDirTemplates', but does not allow substitution of --- the 'prefix' variable -substituteInstallDirTemplatesNP :: PathTemplateEnv - -> InstallDirTemplates -> InstallDirTemplates -substituteInstallDirTemplatesNP env dirs = dirs' - where - dirs' = InstallDirs { - -- So this specifies exactly which vars are allowed in each template - prefix = subst prefix [], - bindir = subst bindir [], - libdir = subst libdir [bindirVar], - libsubdir = subst libsubdir [], - dynlibdir = subst dynlibdir [bindirVar, libdirVar], - libexecdir = subst libexecdir prefixBinLibVars, - includedir = subst includedir prefixBinLibVars, - datadir = subst datadir prefixBinLibVars, - datasubdir = subst datasubdir [], - docdir = subst docdir prefixBinLibDataVars, - mandir = subst mandir (prefixBinLibDataVars ++ [docdirVar]), - htmldir = subst htmldir (prefixBinLibDataVars ++ [docdirVar]), - haddockdir = subst haddockdir (prefixBinLibDataVars ++ - [docdirVar, htmldirVar]), - sysconfdir = subst sysconfdir prefixBinLibVars - } - subst dir env' = substPathTemplate (env'++env) (dir dirs) - - bindirVar = (BindirVar, bindir dirs') - libdirVar = (LibdirVar, libdir dirs') - libsubdirVar = (LibsubdirVar, libsubdir dirs') - datadirVar = (DatadirVar, datadir dirs') - datasubdirVar = (DatasubdirVar, datasubdir dirs') - docdirVar = (DocdirVar, docdir dirs') - htmldirVar = (HtmldirVar, htmldir dirs') - prefixBinLibVars = [bindirVar, libdirVar, libsubdirVar] - prefixBinLibDataVars = prefixBinLibVars ++ [datadirVar, datasubdirVar] - -- | Convert from abstract install directories to actual absolute ones by -- substituting for all the variables in the abstract paths, to get real -- absolute path. diff --git a/Cabal/Distribution/Simple/Program/HcPkg.hs b/Cabal/Distribution/Simple/Program/HcPkg.hs index 9d80005bbbf..507e39d3f2d 100644 --- a/Cabal/Distribution/Simple/Program/HcPkg.hs +++ b/Cabal/Distribution/Simple/Program/HcPkg.hs @@ -19,6 +19,7 @@ module Distribution.Simple.Program.HcPkg ( hide, dump, list, + pkgRoot, -- * Program invocations initInvocation, @@ -271,6 +272,48 @@ list verbosity hcPkg packagedb = do where parsePackageIds = sequence . map simpleParse . words +-- | Call @hc-pkg@ to get the location of PackageDB. +pkgRoot :: Verbosity -> ConfiguredProgram -> PackageDB -> IO (Maybe FilePath) +pkgRoot _ _ (SpecificPackageDB fp) = return (Just fp) +pkgRoot verbosity hcPkg packagedb = do + + output <- getProgramInvocationOutput verbosity + (dumpInvocation hcPkg verbosity packagedb) + `catchExit` \_ -> die $ programId hcPkg ++ " pkgRoot failed" + + case parsePkgRoot output of + Left ok -> return ok + _ -> die $ "failed to parse output of '" + ++ programId hcPkg ++ " pkgRoot'" + + where + parsePkgRoot str = case splitPkgs str of + [] -> Left Nothing + (pkg:_) -> case parsePkgRoot' pkg of + ParseOk _ pkgroot -> Left pkgroot + ParseFailed msg -> Right msg + + parsePkgRoot' = parseFieldsFlat [pkgrootField] Nothing + where + pkgrootField = + simpleField "pkgroot" + showFilePath parseFilePathQ + (fromMaybe "") (\x _ -> Just x) + + --TODO: this could be a lot faster. We're doing normaliseLineEndings twice + -- and converting back and forth with lines/unlines. + splitPkgs :: String -> [String] + splitPkgs = checkEmpty . map unlines . splitWith ("---" ==) . lines + where + -- Handle the case of there being no packages at all. + checkEmpty [s] | all isSpace s = [] + checkEmpty ss = ss + + splitWith :: (a -> Bool) -> [a] -> [[a]] + splitWith p xs = ys : case zs of + [] -> [] + _:ws -> splitWith p ws + where (ys,zs) = break p xs -------------------------- -- The program invocations diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index 1cf77c64990..695d19593a3 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -40,7 +40,7 @@ import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) , ComponentName(..), getComponentLocalBuildInfo , LibraryName(..) - , InstallDirs(..), absoluteInstallDirs, prefixRelativeInstallDirs ) + , InstallDirs(..), absoluteInstallDirs ) import Distribution.Simple.BuildPaths (haddockName) import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.LHC as LHC @@ -48,7 +48,8 @@ import qualified Distribution.Simple.UHC as UHC import qualified Distribution.Simple.HaskellSuite as HaskellSuite import Distribution.Simple.Compiler ( compilerVersion, Compiler, CompilerFlavor(..), compilerFlavor - , PackageDBStack, registrationPackageDB ) + , PackageDB, PackageDBStack, absolutePackageDBPaths + , registrationPackageDB ) import Distribution.Simple.Program ( ProgramConfiguration, ConfiguredProgram , runProgramInvocation, requireProgram, lookupProgram @@ -69,7 +70,7 @@ import Distribution.InstalledPackageInfo import qualified Distribution.InstalledPackageInfo as IPI import Distribution.Simple.Utils ( writeUTF8File, writeFileAtomic, setFileExecutable - , die, notice, setupMessage ) + , die, notice, setupMessage, shortRelativePath ) import Distribution.System ( OS(..), buildOS ) import Distribution.Text @@ -84,7 +85,7 @@ import System.Directory import Control.Monad (when) import Data.Maybe - ( isJust, fromJust, fromMaybe, maybeToList ) + ( isJust, fromMaybe, maybeToList ) import Data.List ( partition, nub ) import qualified Data.ByteString.Lazy.Char8 as BS.Char8 @@ -99,8 +100,10 @@ register pkg@PackageDescription { library = Just lib } lbi regFlags = do let clbi = getComponentLocalBuildInfo lbi CLibName + absPackageDBs <- absolutePackageDBPaths packageDbs installedPkgInfo <- generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref + (registrationPackageDB absPackageDBs) when (fromFlag (regPrintId regFlags)) $ do putStrLn (display (IPI.installedPackageId installedPkgInfo)) @@ -156,8 +159,9 @@ generateRegistrationInfo :: Verbosity -> Bool -> Bool -> FilePath + -> PackageDB -> IO InstalledPackageInfo -generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref = do +generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref packageDb = do --TODO: eliminate pwd! pwd <- getCurrentDirectory @@ -172,16 +176,45 @@ generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref = do _other -> do return (InstalledPackageId (display (packageId pkg))) - let installedPkgInfo - | inplace = inplaceInstalledPackageInfo pwd distPref - pkg ipid lib lbi clbi - | reloc = relocatableInstalledPackageInfo - pkg ipid lib lbi clbi - | otherwise = absoluteInstalledPackageInfo - pkg ipid lib lbi clbi + -- let installedPkgInfo + -- | inplace = inplaceInstalledPackageInfo pwd distPref + -- pkg ipid lib lbi clbi + -- | reloc = relocatableInstalledPackageInfo + -- pkg ipid lib lbi clbi undefined + -- | otherwise = absoluteInstalledPackageInfo + -- pkg ipid lib lbi clbi + + installedPkgInfo <- if inplace then + return (inplaceInstalledPackageInfo pwd distPref + pkg ipid lib lbi clbi) + else if reloc then + relocRegistrationInfo verbosity pkg lib lbi clbi ipid + packageDb + else + return (absoluteInstalledPackageInfo + pkg ipid lib lbi clbi) + return installedPkgInfo{ IPI.installedPackageId = ipid } +relocRegistrationInfo :: Verbosity + -> PackageDescription + -> Library + -> LocalBuildInfo + -> ComponentLocalBuildInfo + -> InstalledPackageId + -> PackageDB + -> IO InstalledPackageInfo +relocRegistrationInfo verbosity pkg lib lbi clbi ipid packageDb = + case (compilerFlavor (compiler lbi)) of + GHC -> do let Just ghcPkg = lookupProgram ghcPkgProgram (withPrograms lbi) + fsM <- HcPkg.pkgRoot verbosity ghcPkg packageDb + case fsM of + Just fs -> return (relocatableInstalledPackageInfo + pkg ipid lib lbi clbi fs) + Nothing -> die "Cannot register relocatable package with empty ${pkgroot}" + _ -> die "Distribution.Simple.Register.relocRegistrationInfo: \ + \not implemented for this compiler" -- | Create an empty package DB at the specified location. initPackageDB :: Verbosity -> Compiler -> ProgramConfiguration -> FilePath @@ -383,8 +416,9 @@ relocatableInstalledPackageInfo :: PackageDescription -> Library -> LocalBuildInfo -> ComponentLocalBuildInfo + -> FilePath -> InstalledPackageInfo -relocatableInstalledPackageInfo pkg ipid lib lbi clbi = +relocatableInstalledPackageInfo pkg ipid lib lbi clbi pkgroot = generalInstalledPackageInfo adjustReativeIncludeDirs pkg ipid lib lbi clbi installDirs where @@ -394,8 +428,9 @@ relocatableInstalledPackageInfo pkg ipid lib lbi clbi = | null (installIncludes bi) = [] | otherwise = [includedir installDirs] bi = libBuildInfo lib - installDirs = fmap (((("${pkgroot}" "..") "..") ) . fromJust) - $ prefixRelativeInstallDirs (packageId pkg) lbi + + installDirs = fmap (("${pkgroot}" ) . shortRelativePath pkgroot) + $ absoluteInstallDirs pkg lbi NoCopyDest -- ----------------------------------------------------------------------------- -- Unregistration diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs index a83ac8dd70f..c306a23134d 100644 --- a/Cabal/Distribution/Simple/Utils.hs +++ b/Cabal/Distribution/Simple/Utils.hs @@ -62,6 +62,7 @@ module Distribution.Simple.Utils ( -- * file names currentDir, + shortRelativePath, -- * finding files findFile, @@ -150,7 +151,7 @@ import System.Exit ( exitWith, ExitCode(..) ) import System.FilePath ( normalise, (), (<.>) - , getSearchPath, takeDirectory, splitFileName + , getSearchPath, joinPath, takeDirectory, splitFileName , splitExtension, splitExtensions, splitDirectories ) import System.Directory ( createDirectory, renameFile, removeDirectoryRecursive ) @@ -1063,6 +1064,16 @@ rewriteFile path newContent = currentDir :: FilePath currentDir = "." +shortRelativePath :: FilePath -> FilePath -> FilePath +shortRelativePath from to = + case dropCommonPrefix (splitDirectories from) (splitDirectories to) of + (stuff, path) -> joinPath (map (const "..") stuff ++ path) + where + dropCommonPrefix :: Eq a => [a] -> [a] -> ([a],[a]) + dropCommonPrefix (x:xs) (y:ys) + | x == y = dropCommonPrefix xs ys + dropCommonPrefix xs ys = (xs,ys) + -- ------------------------------------------------------------ -- * Finding the description file -- ------------------------------------------------------------ diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index cdb8c5026f2..0ae8c00f1f3 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -1421,7 +1421,7 @@ installUnpackedPackage verbosity buildLimit installLock numJobs pkg_key defInstallDirs <- InstallDirs.defaultInstallDirs flavor userInstall False return $ configFlags' { configInstallDirs = fmap Cabal.Flag . - InstallDirs.substituteInstallDirTemplatesNP env $ + InstallDirs.substituteInstallDirTemplates env $ InstallDirs.combineInstallDirs fromFlagOrDefault defInstallDirs (configInstallDirs configFlags) } From aee97a5b8dee10e7b42f8f5e89f3fdefa71b6259 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Wed, 26 Nov 2014 16:24:57 +0100 Subject: [PATCH 10/33] Canonicalise rpath library paths --- Cabal/Distribution/Simple/GHC.hs | 39 +++++++++++++++++++------------- 1 file changed, 23 insertions(+), 16 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index e487f5474b7..a8517106048 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -113,7 +113,8 @@ import qualified Data.Map as M ( Map, fromList, lookup ) import Data.Maybe ( catMaybes, fromMaybe, maybeToList ) import Data.Monoid ( Monoid(..) ) import System.Directory - ( getDirectoryContents, doesFileExist, getTemporaryDirectory ) + ( getDirectoryContents, doesFileExist, getTemporaryDirectory, + canonicalizePath ) import System.FilePath ( (), (<.>), takeExtension, takeDirectory, replaceExtension, splitExtension ) @@ -870,6 +871,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 let staticObjectFiles = hObjs @@ -911,7 +913,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, ghcOptRPaths = if (hostOS == OSX && relocatable lbi) - then toRPaths False pkg_descr lbi + then rpaths else mempty } @@ -935,21 +937,24 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do toRPaths :: Bool -- ^ Building exe? -> PackageDescription -> LocalBuildInfo - -> NubListR FilePath -toRPaths buildE _pkg_descr lbi = toNubListR (map (hostPref ) refDirs) - where - installDirs = absoluteInstallDirs _pkg_descr lbi NoCopyDest - relDir | buildE = bindir installDirs - | otherwise = libdir installDirs + -> IO (NubListR FilePath) +toRPaths buildE _pkg_descr lbi = do + let installDirs = absoluteInstallDirs _pkg_descr lbi NoCopyDest + relDir | buildE = bindir installDirs + | otherwise = libdir installDirs + + let ipkgs = PackageIndex.allPackages (installedPkgs lbi) + allDepLibDirs = concatMap InstalledPackageInfo.libraryDirs ipkgs + allDepLibDirsC <- mapM canonicalizePath allDepLibDirs + let refDirs = map (shortRelativePath relDir) allDepLibDirsC - ipkgs = PackageIndex.allPackages (installedPkgs lbi) - allDepLibDirs = concatMap InstalledPackageInfo.libraryDirs ipkgs - refDirs = map (shortRelativePath relDir) allDepLibDirs + let (Platform _ hostOS) = hostPlatform lbi + hostPref = case hostOS of + OSX -> "@loader_path" + _ -> "$ORIGIN" - (Platform _ hostOS) = hostPlatform lbi - hostPref = case hostOS of - OSX -> "@loader_path" - _ -> "$ORIGIN" + + return (toNubListR (map (hostPref ) refDirs)) -- | Start a REPL without loading any source files. startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler @@ -1008,6 +1013,8 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi -- build executables srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath + rpaths <- toRPaths True _pkg_descr lbi + let isGhcDynamic = ghcDynamic comp dynamicTooSupported = ghcSupportsDynamicToo comp isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"] @@ -1052,7 +1059,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi [exeDir x | x <- cObjs], ghcOptRPaths = if (hostOS == OSX && relocatable lbi) - then toRPaths True _pkg_descr lbi + then rpaths else mempty } replOpts = baseOpts { From d47cfcb8b2a4b14fc4eed3fbecf3ff2420288d69 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Wed, 26 Nov 2014 17:50:37 +0100 Subject: [PATCH 11/33] Add support for relocatable Paths module --- .../Distribution/Simple/Build/PathsModule.hs | 51 ++++++++++++++++++- 1 file changed, 50 insertions(+), 1 deletion(-) diff --git a/Cabal/Distribution/Simple/Build/PathsModule.hs b/Cabal/Distribution/Simple/Build/PathsModule.hs index 73e31cc5906..25d8716ee1a 100644 --- a/Cabal/Distribution/Simple/Build/PathsModule.hs +++ b/Cabal/Distribution/Simple/Build/PathsModule.hs @@ -32,6 +32,8 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Setup ( CopyDest(NoCopyDest) ) import Distribution.Simple.BuildPaths ( autogenModuleName ) +import Distribution.Simple.Utils + ( shortRelativePath ) import Distribution.Text ( display ) import Distribution.Version @@ -62,6 +64,11 @@ generate pkg_descr lbi = "import Foreign\n"++ "import Foreign.C\n" + reloc_imports + | reloc = + "import System.Environment (getExecutablePath)\n" + | otherwise = "" + header = pragmas++ "module " ++ display paths_modulename ++ " (\n"++ @@ -74,16 +81,36 @@ generate pkg_descr lbi = "import qualified Control.Exception as Exception\n"++ "import Data.Version (Version(..))\n"++ "import System.Environment (getEnv)\n"++ + reloc_imports ++ "import Prelude\n"++ "\n"++ "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"++ "catchIO = Exception.catch\n" ++ "\n"++ - "\nversion :: Version"++ + "version :: Version"++ "\nversion = Version " ++ show branch ++ " " ++ show tags where Version branch tags = packageVersion pkg_descr body + | reloc = + "\n\nbindirrel :: FilePath\n" ++ + "bindirrel = " ++ show flat_bindirreloc ++ + "\n"++ + "\ngetBinDir, getLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath\n"++ + "getBinDir = "++mkGetEnvOrReloc "bindir" flat_bindirreloc++"\n"++ + "getLibDir = "++mkGetEnvOrReloc "libdir" flat_libdirreloc++"\n"++ + "getDataDir = "++mkGetEnvOrReloc "datadir" flat_datadirreloc++"\n"++ + "getLibexecDir = "++mkGetEnvOrReloc "libexecdir" flat_libexecdirreloc++"\n"++ + "getSysconfDir = "++mkGetEnvOrReloc "sysconfdir" flat_sysconfdirreloc++"\n"++ + "\n"++ + "getDataFileName :: FilePath -> IO FilePath\n"++ + "getDataFileName name = do\n"++ + " dir <- getDataDir\n"++ + " return (dir `joinFileName` name)\n"++ + "\n"++ + get_prefix_reloc_stuff++ + "\n"++ + filename_stuff | absolute = "\nbindir, libdir, datadir, libexecdir, sysconfdir :: FilePath\n"++ "\nbindir = " ++ show flat_bindir ++ @@ -146,9 +173,20 @@ generate pkg_descr lbi = sysconfdir = flat_sysconfdirrel } = prefixRelativeInstallDirs (packageId pkg_descr) lbi + flat_bindirreloc = shortRelativePath flat_prefix flat_bindir + flat_libdirreloc = shortRelativePath flat_prefix flat_libdir + flat_datadirreloc = shortRelativePath flat_prefix flat_datadir + flat_libexecdirreloc = shortRelativePath flat_prefix flat_libexecdir + flat_sysconfdirreloc = shortRelativePath flat_prefix flat_sysconfdir + mkGetDir _ (Just dirrel) = "getPrefixDirRel " ++ show dirrel mkGetDir dir Nothing = "return " ++ show dir + mkGetEnvOrReloc var dirrel = "catchIO (getEnv \""++var'++"\")" ++ + " (\\_ -> getPrefixDirReloc \"" ++ dirrel ++ + "\")" + where var' = pkgPathEnvVar pkg_descr var + mkGetEnvOr var expr = "catchIO (getEnv \""++var'++"\")"++ " (\\_ -> "++expr++")" where var' = pkgPathEnvVar pkg_descr var @@ -159,6 +197,8 @@ generate pkg_descr lbi = || isNothing flat_bindirrel -- if the bin dir is an absolute path || not (supportsRelocatableProgs (compilerFlavor (compiler lbi))) + reloc = relocatable lbi + supportsRelocatableProgs GHC = case buildOS of Windows -> True _ -> False @@ -188,6 +228,15 @@ pkgPathEnvVar pkg_descr var = fixchar '-' = '_' fixchar c = c +get_prefix_reloc_stuff :: String +get_prefix_reloc_stuff = + "getPrefixDirReloc :: FilePath -> IO FilePath\n"++ + "getPrefixDirReloc dirRel = do\n"++ + " exePath <- getExecutablePath\n"++ + " let (bindir,_) = splitFileName exePath\n"++ + " return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n"++ + "\n" + get_prefix_win32 :: Arch -> String get_prefix_win32 arch = "getPrefixDirRel :: FilePath -> IO FilePath\n"++ From ea249752de99d3e55feab3a32c92c4580636ab12 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Wed, 26 Nov 2014 17:50:56 +0100 Subject: [PATCH 12/33] Wobble whitespace --- Cabal/Distribution/Simple/GHC.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index a8517106048..ee865aea969 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -953,7 +953,6 @@ toRPaths buildE _pkg_descr lbi = do OSX -> "@loader_path" _ -> "$ORIGIN" - return (toNubListR (map (hostPref ) refDirs)) -- | Start a REPL without loading any source files. From beaefd2d661602b13fdd9838e4dc45f7d792155d Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Wed, 26 Nov 2014 17:54:20 +0100 Subject: [PATCH 13/33] Whitespace wobble in generated Paths module --- Cabal/Distribution/Simple/Build/PathsModule.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Cabal/Distribution/Simple/Build/PathsModule.hs b/Cabal/Distribution/Simple/Build/PathsModule.hs index 25d8716ee1a..505222be2a9 100644 --- a/Cabal/Distribution/Simple/Build/PathsModule.hs +++ b/Cabal/Distribution/Simple/Build/PathsModule.hs @@ -234,8 +234,7 @@ get_prefix_reloc_stuff = "getPrefixDirReloc dirRel = do\n"++ " exePath <- getExecutablePath\n"++ " let (bindir,_) = splitFileName exePath\n"++ - " return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n"++ - "\n" + " return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n" get_prefix_win32 :: Arch -> String get_prefix_win32 arch = From 1ac8c31495a95b316215785589e69a40f3b2b33f Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 27 Nov 2014 12:34:25 +0100 Subject: [PATCH 14/33] Add support for executables depending on packaged libraries --- Cabal/Distribution/Simple/GHC.hs | 50 ++++++++++++++++++++------------ 1 file changed, 31 insertions(+), 19 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index ee865aea969..505dd984247 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -68,7 +68,7 @@ import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs ) import Distribution.Simple.BuildPaths import Distribution.Simple.Utils import Distribution.Package - ( PackageName(..), InstalledPackageId, PackageId ) + ( PackageName(..), InstalledPackageId, PackageId, packageId ) import qualified Distribution.ModuleName as ModuleName import Distribution.Simple.Program ( Program(..), ConfiguredProgram(..), ProgramConfiguration @@ -871,7 +871,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 + rpaths <- toRPaths False pkg_descr lbi clbi let staticObjectFiles = hObjs @@ -937,23 +937,35 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do toRPaths :: Bool -- ^ Building exe? -> PackageDescription -> LocalBuildInfo + -> ComponentLocalBuildInfo -> IO (NubListR FilePath) -toRPaths buildE _pkg_descr lbi = do - let installDirs = absoluteInstallDirs _pkg_descr lbi NoCopyDest - relDir | buildE = bindir installDirs - | otherwise = libdir installDirs - - let ipkgs = PackageIndex.allPackages (installedPkgs lbi) - allDepLibDirs = concatMap InstalledPackageInfo.libraryDirs ipkgs - allDepLibDirsC <- mapM canonicalizePath allDepLibDirs - let refDirs = map (shortRelativePath relDir) allDepLibDirsC - - let (Platform _ hostOS) = hostPlatform lbi - hostPref = case hostOS of - OSX -> "@loader_path" - _ -> "$ORIGIN" - - return (toNubListR (map (hostPref ) refDirs)) +toRPaths buildE _pkg_descr lbi clbi = do + let installDirs = absoluteInstallDirs _pkg_descr 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 refDirs = map (shortRelativePath relDir) allDepLibDirsC + + let (Platform _ hostOS) = hostPlatform lbi + hostPref = case hostOS of + OSX -> "@loader_path" + _ -> "$ORIGIN" + + return (toNubListR (map (hostPref ) refDirs)) + where + internal pkgid = pkgid == packageId (localPkgDescr lbi) -- | Start a REPL without loading any source files. startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler @@ -1012,7 +1024,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi -- build executables srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath - rpaths <- toRPaths True _pkg_descr lbi + rpaths <- toRPaths True _pkg_descr lbi clbi let isGhcDynamic = ghcDynamic comp dynamicTooSupported = ghcSupportsDynamicToo comp From e2b81b09a2b0943a7cf4feac506e118837033184 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 27 Nov 2014 15:25:02 +0100 Subject: [PATCH 15/33] Enable installation into empty user package database --- Cabal/Distribution/Simple/GHC.hs | 24 +++++++++++- Cabal/Distribution/Simple/Program/HcPkg.hs | 44 ---------------------- Cabal/Distribution/Simple/Register.hs | 9 ++--- 3 files changed, 26 insertions(+), 51 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 505dd984247..e2660677d53 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -45,6 +45,7 @@ module Distribution.Simple.GHC ( ghcLibDir, ghcDynamic, ghcGlobalPackageDB, + pkgRoot ) where import qualified Distribution.Simple.GHC.IPI641 as IPI641 @@ -112,12 +113,14 @@ import Data.List import qualified Data.Map as M ( Map, fromList, lookup ) import Data.Maybe ( catMaybes, fromMaybe, maybeToList ) import Data.Monoid ( Monoid(..) ) +import Data.Version ( showVersion ) import System.Directory ( getDirectoryContents, doesFileExist, getTemporaryDirectory, - canonicalizePath ) + canonicalizePath, getAppUserDataDirectory, createDirectoryIfMissing ) import System.FilePath ( (), (<.>), takeExtension, takeDirectory, replaceExtension, splitExtension ) +import qualified System.Info import System.IO (hClose, hPutStrLn) import System.Environment (getEnv) import Distribution.Compat.Exception (catchExit, catchIO) @@ -1422,6 +1425,25 @@ registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do let Just ghcPkg = lookupProgram ghcPkgProgram (withPrograms lbi) HcPkg.reregister verbosity ghcPkg packageDbs (Right installedPkgInfo) +pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath +pkgRoot verbosity lbi = pkgRoot' + where + pkgRoot' GlobalPackageDB = + let Just ghcProg = lookupProgram ghcProgram (withPrograms lbi) + in fmap takeDirectory (ghcGlobalPackageDB verbosity ghcProg) + pkgRoot' UserPackageDB = do + appDir <- getAppUserDataDirectory "ghc" + let ver = compilerVersion (compiler lbi) + subdir = System.Info.arch ++ '-':System.Info.os ++ '-':showVersion ver + rootDir = appDir subdir + -- We must create the root directory for the user package database if it + -- does not yet exists. Otherwise '${pkgroot}' will resolve to a + -- directory at the time of 'ghc-pkg register', and registration will + -- fail. + createDirectoryIfMissing True rootDir + return rootDir + pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp) + -- ----------------------------------------------------------------------------- -- Utils diff --git a/Cabal/Distribution/Simple/Program/HcPkg.hs b/Cabal/Distribution/Simple/Program/HcPkg.hs index 507e39d3f2d..6b9d350efa6 100644 --- a/Cabal/Distribution/Simple/Program/HcPkg.hs +++ b/Cabal/Distribution/Simple/Program/HcPkg.hs @@ -19,7 +19,6 @@ module Distribution.Simple.Program.HcPkg ( hide, dump, list, - pkgRoot, -- * Program invocations initInvocation, @@ -272,49 +271,6 @@ list verbosity hcPkg packagedb = do where parsePackageIds = sequence . map simpleParse . words --- | Call @hc-pkg@ to get the location of PackageDB. -pkgRoot :: Verbosity -> ConfiguredProgram -> PackageDB -> IO (Maybe FilePath) -pkgRoot _ _ (SpecificPackageDB fp) = return (Just fp) -pkgRoot verbosity hcPkg packagedb = do - - output <- getProgramInvocationOutput verbosity - (dumpInvocation hcPkg verbosity packagedb) - `catchExit` \_ -> die $ programId hcPkg ++ " pkgRoot failed" - - case parsePkgRoot output of - Left ok -> return ok - _ -> die $ "failed to parse output of '" - ++ programId hcPkg ++ " pkgRoot'" - - where - parsePkgRoot str = case splitPkgs str of - [] -> Left Nothing - (pkg:_) -> case parsePkgRoot' pkg of - ParseOk _ pkgroot -> Left pkgroot - ParseFailed msg -> Right msg - - parsePkgRoot' = parseFieldsFlat [pkgrootField] Nothing - where - pkgrootField = - simpleField "pkgroot" - showFilePath parseFilePathQ - (fromMaybe "") (\x _ -> Just x) - - --TODO: this could be a lot faster. We're doing normaliseLineEndings twice - -- and converting back and forth with lines/unlines. - splitPkgs :: String -> [String] - splitPkgs = checkEmpty . map unlines . splitWith ("---" ==) . lines - where - -- Handle the case of there being no packages at all. - checkEmpty [s] | all isSpace s = [] - checkEmpty ss = ss - - splitWith :: (a -> Bool) -> [a] -> [[a]] - splitWith p xs = ys : case zs of - [] -> [] - _:ws -> splitWith p ws - where (ys,zs) = break p xs - -------------------------- -- The program invocations -- diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index 695d19593a3..259108c32b2 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -207,12 +207,9 @@ relocRegistrationInfo :: Verbosity -> IO InstalledPackageInfo relocRegistrationInfo verbosity pkg lib lbi clbi ipid packageDb = case (compilerFlavor (compiler lbi)) of - GHC -> do let Just ghcPkg = lookupProgram ghcPkgProgram (withPrograms lbi) - fsM <- HcPkg.pkgRoot verbosity ghcPkg packageDb - case fsM of - Just fs -> return (relocatableInstalledPackageInfo - pkg ipid lib lbi clbi fs) - Nothing -> die "Cannot register relocatable package with empty ${pkgroot}" + GHC -> do fs <- GHC.pkgRoot verbosity lbi packageDb + return (relocatableInstalledPackageInfo + pkg ipid lib lbi clbi fs) _ -> die "Distribution.Simple.Register.relocRegistrationInfo: \ \not implemented for this compiler" From 0e4e0eb6d69a9811cb4edc4a2d18738d4db53985 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 27 Nov 2014 15:25:26 +0100 Subject: [PATCH 16/33] Wobble layout --- Cabal/Distribution/Simple/Register.hs | 26 +++++++++----------------- 1 file changed, 9 insertions(+), 17 deletions(-) diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index 259108c32b2..ca073df56a3 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -176,23 +176,15 @@ generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref packa _other -> do return (InstalledPackageId (display (packageId pkg))) - -- let installedPkgInfo - -- | inplace = inplaceInstalledPackageInfo pwd distPref - -- pkg ipid lib lbi clbi - -- | reloc = relocatableInstalledPackageInfo - -- pkg ipid lib lbi clbi undefined - -- | otherwise = absoluteInstalledPackageInfo - -- pkg ipid lib lbi clbi - - installedPkgInfo <- if inplace then - return (inplaceInstalledPackageInfo pwd distPref - pkg ipid lib lbi clbi) - else if reloc then - relocRegistrationInfo verbosity pkg lib lbi clbi ipid - packageDb - else - return (absoluteInstalledPackageInfo - pkg ipid lib lbi clbi) + installedPkgInfo <- + if inplace + then return (inplaceInstalledPackageInfo pwd distPref + pkg ipid lib lbi clbi) + else if reloc + then relocRegistrationInfo verbosity + pkg lib lbi clbi ipid packageDb + else return (absoluteInstalledPackageInfo + pkg ipid lib lbi clbi) return installedPkgInfo{ IPI.installedPackageId = ipid } From 94402031d608de38af77afe84fd1f4fbc5c6c7f8 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 27 Nov 2014 17:52:15 +0100 Subject: [PATCH 17/33] Extend checking whether a relocatable package is feasible --- Cabal/Distribution/Simple/Configure.hs | 71 ++++++++++++++++++++++---- Cabal/Distribution/Simple/GHC.hs | 7 +-- 2 files changed, 64 insertions(+), 14 deletions(-) diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 340699b0350..1fbc76fc9ad 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | @@ -104,7 +105,7 @@ import Distribution.Simple.Utils , writeFileAtomic , withTempFile ) import Distribution.System - ( OS(..), buildOS, Platform, buildPlatform ) + ( OS(..), buildOS, Platform (..), buildPlatform ) import Distribution.Version ( Version(..), anyVersion, orLaterVersion, withinRange, isAnyVersion ) import Distribution.Verbosity @@ -126,9 +127,9 @@ import Data.Binary ( decodeOrFail, encode ) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy.Char8 as BS import Data.List - ( (\\), nub, partition, isPrefixOf, inits ) + ( (\\), nub, partition, isPrefixOf, inits, stripPrefix ) import Data.Maybe - ( isNothing, catMaybes, fromMaybe ) + ( isNothing, catMaybes, fromMaybe, isJust ) import Data.Either ( partitionEithers ) import qualified Data.Set as Set @@ -604,12 +605,7 @@ configure (pkg_descr0, pbi) cfg reloc <- if not (fromFlag $ configRelocatable cfg) then return False - else case flavor of - GHC | version >= Version [7,8] [] -> return True - _ -> do warn verbosity - ("this compiler does not support " ++ - "--enable-relocatable; ignoring") - return False + else return True let lbi = LocalBuildInfo { configFlags = cfg, @@ -645,6 +641,8 @@ configure (pkg_descr0, pbi) cfg relocatable = reloc } + when reloc (checkRelocatable pkg_descr lbi) + let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi @@ -1565,3 +1563,58 @@ checkPackageProblems verbosity gpkg pkg = do if null errors then mapM_ (warn verbosity) warnings else die (intercalate "\n\n" errors) + +-- | Preform checks if a relocatable build is allowed +checkRelocatable :: PackageDescription + -> LocalBuildInfo + -> IO () +checkRelocatable pkg lbi = sequence_ [ checkOS + , checkCompiler + , packagePrefixRelative + , depsPrefixRelative + ] + where + -- Check if the OS support relocatable builds + checkOS + = unless (os `elem` [ OSX ]) + $ die $ "Operating system: " ++ display os ++ + ", does not support relocatable builds" + where + (Platform _ os) = hostPlatform lbi + + -- Check if the Compiler support relocatable builds + checkCompiler + = unless (compilerFlavor comp `elem` [ GHC ]) + $ die $ "Compiler: " ++ show comp ++ + ", does not support relocatable builds" + where + comp = compiler lbi + + -- Check if all the install dirs are relative to same prefix + packagePrefixRelative + = unless (relativeInstallDirs installDirs) + $ die $ "Installation directories are not prefix_relative:\n" ++ + show installDirs + where + installDirs = absoluteInstallDirs pkg lbi NoCopyDest + p = prefix installDirs + relativeInstallDirs (InstallDirs {..}) = + all isJust + (fmap (stripPrefix p) + [ bindir, libdir, dynlibdir, libexecdir, includedir, datadir + , docdir, mandir, htmldir, haddockdir, sysconfdir] ) + + -- Check if the library dirs of the dependencies are relative to the + -- prefix of the package + depsPrefixRelative + = mapM_ (\l -> when (isNothing $ stripPrefix p l) (die (msg l))) + allDepLibDirs + where + installDirs = absoluteInstallDirs pkg lbi NoCopyDest + p = prefix installDirs + ipkgs = PackageIndex.allPackages (installedPkgs lbi) + allDepLibDirs = concatMap Installed.libraryDirs ipkgs + msg l = "Library directory of a dependency: " ++ show l ++ + "\nis not relative to the installation prefix:\n" ++ + show p + diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index e2660677d53..416da373eac 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -914,8 +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 (hostOS == OSX - && relocatable lbi) + ghcOptRPaths = if relocatable lbi then rpaths else mempty } @@ -999,7 +998,6 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) let comp = compiler lbi runGhcProg = runGHC verbosity ghcProg comp - (Platform _hostArch hostOS) = hostPlatform lbi exeBi <- hackThreadedFlag verbosity comp (withProfExe lbi) (buildInfo exe) @@ -1071,8 +1069,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi ghcOptLinkFrameworks = toNubListR $ PD.frameworks exeBi, ghcOptInputFiles = toNubListR [exeDir x | x <- cObjs], - ghcOptRPaths = if (hostOS == OSX - && relocatable lbi) + ghcOptRPaths = if relocatable lbi then rpaths else mempty } From 67f608e812052ebf3b3c130046b474fe017fba99 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Fri, 28 Nov 2014 17:04:16 +0100 Subject: [PATCH 18/33] Generate absolute rpaths for libraries that are not prefix-relative --- Cabal/Distribution/Simple/GHC.hs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 416da373eac..97d4f13dfee 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -111,7 +111,7 @@ 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 ) +import Data.Maybe ( catMaybes, fromMaybe, maybeToList, isJust ) import Data.Monoid ( Monoid(..) ) import Data.Version ( showVersion ) import System.Directory @@ -935,7 +935,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do whenSharedLib False $ runGhcProg ghcSharedLinkArgs --- | Derive relative RPATHs +-- | Derive RPATHs toRPaths :: Bool -- ^ Building exe? -> PackageDescription -> LocalBuildInfo @@ -958,14 +958,24 @@ toRPaths buildE _pkg_descr lbi clbi = do then (libdir installDirs) : allDepLibDirs else allDepLibDirs allDepLibDirsC <- mapM canonicalizePath allDepLibDirs' - let refDirs = map (shortRelativePath relDir) allDepLibDirsC let (Platform _ hostOS) = hostPlatform lbi hostPref = case hostOS of OSX -> "@loader_path" _ -> "$ORIGIN" - return (toNubListR (map (hostPref ) refDirs)) + let p = prefix installDirs + prefixRelative l = isJust (stripPrefix p l) + rpaths + | 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) From b9c698eaa2d736be189940b8d3f4895c6f8f3c38 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Fri, 28 Nov 2014 17:05:22 +0100 Subject: [PATCH 19/33] Relocatable packages in the same database must share the same prefix --- Cabal/Distribution/InstalledPackageInfo.hs | 12 ++++-- Cabal/Distribution/Simple/Configure.hs | 45 +++++++++++++--------- Cabal/Distribution/Simple/GHC/IPI641.hs | 3 +- Cabal/Distribution/Simple/GHC/IPI642.hs | 3 +- Cabal/Distribution/Simple/Program/HcPkg.hs | 19 ++------- Cabal/Distribution/Simple/Register.hs | 3 +- 6 files changed, 44 insertions(+), 41 deletions(-) diff --git a/Cabal/Distribution/InstalledPackageInfo.hs b/Cabal/Distribution/InstalledPackageInfo.hs index bf2845cc838..13332ce9dc7 100644 --- a/Cabal/Distribution/InstalledPackageInfo.hs +++ b/Cabal/Distribution/InstalledPackageInfo.hs @@ -61,7 +61,8 @@ import Distribution.Text import Text.PrettyPrint as Disp import qualified Distribution.Compat.ReadP as Parse -import Data.Binary (Binary) +import Data.Binary (Binary) +import Data.Maybe (fromMaybe) import GHC.Generics (Generic) -- ----------------------------------------------------------------------------- @@ -104,7 +105,8 @@ data InstalledPackageInfo_ m frameworkDirs :: [FilePath], frameworks :: [String], haddockInterfaces :: [FilePath], - haddockHTMLs :: [FilePath] + haddockHTMLs :: [FilePath], + pkgRoot :: Maybe FilePath } deriving (Generic, Read, Show) @@ -155,7 +157,8 @@ emptyInstalledPackageInfo frameworkDirs = [], frameworks = [], haddockInterfaces = [], - haddockHTMLs = [] + haddockHTMLs = [], + pkgRoot = Nothing } noVersion :: Version @@ -375,6 +378,9 @@ installedFieldDescrs = [ , listField "haddock-html" showFilePath parseFilePathQ haddockHTMLs (\xs pkg -> pkg{haddockHTMLs=xs}) + , simpleField "pkgroot" + (const Disp.empty) parseFilePathQ + (fromMaybe "" . pkgRoot) (\xs pkg -> pkg{pkgRoot=Just xs}) ] deprecatedFieldDescrs :: [FieldDescr InstalledPackageInfo] diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 1fbc76fc9ad..dcf22628fb1 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -641,7 +641,7 @@ configure (pkg_descr0, pbi) cfg relocatable = reloc } - when reloc (checkRelocatable pkg_descr lbi) + when reloc (checkRelocatable verbosity pkg_descr lbi) let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi @@ -1565,14 +1565,16 @@ checkPackageProblems verbosity gpkg pkg = do else die (intercalate "\n\n" errors) -- | Preform checks if a relocatable build is allowed -checkRelocatable :: PackageDescription +checkRelocatable :: Verbosity + -> PackageDescription -> LocalBuildInfo -> IO () -checkRelocatable pkg lbi = sequence_ [ checkOS - , checkCompiler - , packagePrefixRelative - , depsPrefixRelative - ] +checkRelocatable verbosity pkg lbi + = sequence_ [ checkOS + , checkCompiler + , packagePrefixRelative + , depsPrefixRelative + ] where -- Check if the OS support relocatable builds checkOS @@ -1604,17 +1606,22 @@ checkRelocatable pkg lbi = sequence_ [ checkOS [ bindir, libdir, dynlibdir, libexecdir, includedir, datadir , docdir, mandir, htmldir, haddockdir, sysconfdir] ) - -- Check if the library dirs of the dependencies are relative to the + -- Check if the library dirs of the dependencies that are in the package + -- database to which the package is installed are relative to the -- prefix of the package - depsPrefixRelative - = mapM_ (\l -> when (isNothing $ stripPrefix p l) (die (msg l))) - allDepLibDirs + depsPrefixRelative = do + pkgr <- GHC.pkgRoot verbosity lbi (last (withPackageDB lbi)) + mapM_ (doCheck pkgr) ipkgs where - installDirs = absoluteInstallDirs pkg lbi NoCopyDest - p = prefix installDirs - ipkgs = PackageIndex.allPackages (installedPkgs lbi) - allDepLibDirs = concatMap Installed.libraryDirs ipkgs - msg l = "Library directory of a dependency: " ++ show l ++ - "\nis not relative to the installation prefix:\n" ++ - show p - + doCheck pkgr ipkg + | maybe False (== pkgr) (Installed.pkgRoot ipkg) + = mapM_ (\l -> when (isNothing $ stripPrefix p l) (die (msg l))) + (Installed.libraryDirs ipkg) + | otherwise + = return () + installDirs = absoluteInstallDirs pkg lbi NoCopyDest + p = prefix installDirs + ipkgs = PackageIndex.allPackages (installedPkgs lbi) + msg l = "Library directory of a dependency: " ++ show l ++ + "\nis not relative to the installation prefix:\n" ++ + show p diff --git a/Cabal/Distribution/Simple/GHC/IPI641.hs b/Cabal/Distribution/Simple/GHC/IPI641.hs index a836e418654..84cda21f616 100644 --- a/Cabal/Distribution/Simple/GHC/IPI641.hs +++ b/Cabal/Distribution/Simple/GHC/IPI641.hs @@ -101,5 +101,6 @@ toCurrent ipi@InstalledPackageInfo{} = Current.frameworkDirs = frameworkDirs ipi, Current.frameworks = frameworks ipi, Current.haddockInterfaces = haddockInterfaces ipi, - Current.haddockHTMLs = haddockHTMLs ipi + Current.haddockHTMLs = haddockHTMLs ipi, + Current.pkgRoot = Nothing } diff --git a/Cabal/Distribution/Simple/GHC/IPI642.hs b/Cabal/Distribution/Simple/GHC/IPI642.hs index 87a07977e28..512949c1646 100644 --- a/Cabal/Distribution/Simple/GHC/IPI642.hs +++ b/Cabal/Distribution/Simple/GHC/IPI642.hs @@ -136,5 +136,6 @@ toCurrent ipi@InstalledPackageInfo{} = Current.frameworkDirs = frameworkDirs ipi, Current.frameworks = frameworks ipi, Current.haddockInterfaces = haddockInterfaces ipi, - Current.haddockHTMLs = haddockHTMLs ipi + Current.haddockHTMLs = haddockHTMLs ipi, + Current.pkgRoot = Nothing } diff --git a/Cabal/Distribution/Simple/Program/HcPkg.hs b/Cabal/Distribution/Simple/Program/HcPkg.hs index 6b9d350efa6..0b19d845be8 100644 --- a/Cabal/Distribution/Simple/Program/HcPkg.hs +++ b/Cabal/Distribution/Simple/Program/HcPkg.hs @@ -59,8 +59,6 @@ import Distribution.Compat.Exception import Data.Char ( isSpace ) -import Data.Maybe - ( fromMaybe ) import Data.List ( stripPrefix ) import System.FilePath as FilePath @@ -162,24 +160,13 @@ dump verbosity hcPkg packagedb = do let parsed = map parseInstalledPackageInfo' (splitPkgs str) in case [ msg | ParseFailed msg <- parsed ] of [] -> Left [ setInstalledPackageId - . maybe id mungePackagePaths pkgroot + . maybe id mungePackagePaths (pkgRoot pkg) $ pkg - | ParseOk _ (pkgroot, pkg) <- parsed ] + | ParseOk _ pkg <- parsed ] msgs -> Right msgs parseInstalledPackageInfo' = - parseFieldsFlat fields (Nothing, emptyInstalledPackageInfo) - where - fields = liftFieldFst pkgrootField - : map liftFieldSnd fieldsInstalledPackageInfo - - pkgrootField = - simpleField "pkgroot" - showFilePath parseFilePathQ - (fromMaybe "") (\x _ -> Just x) - - liftFieldFst = liftField fst (\x (_x,y) -> (x,y)) - liftFieldSnd = liftField snd (\y (x,_y) -> (x,y)) + parseFieldsFlat fieldsInstalledPackageInfo emptyInstalledPackageInfo --TODO: this could be a lot faster. We're doing normaliseLineEndings twice -- and converting back and forth with lines/unlines. diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index ca073df56a3..fd312b9653f 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -327,7 +327,8 @@ generalInstalledPackageInfo adjustRelIncDirs pkg ipid lib lbi clbi installDirs = IPI.frameworkDirs = [], IPI.frameworks = frameworks bi, IPI.haddockInterfaces = [haddockdir installDirs haddockName pkg], - IPI.haddockHTMLs = [htmldir installDirs] + IPI.haddockHTMLs = [htmldir installDirs], + IPI.pkgRoot = Nothing } where bi = libBuildInfo lib From da0a94e5d3ca8601f75877381a2c8a1b5ad53ab6 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Tue, 2 Dec 2014 17:43:18 +0100 Subject: [PATCH 20/33] Extend dy(ld)_library_path for relocatable 'cabal run' --- Cabal/Distribution/Simple/GHC.hs | 20 ++++++++------ cabal-install/Distribution/Client/Run.hs | 34 +++++++++++++++++++++--- 2 files changed, 42 insertions(+), 12 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 97d4f13dfee..24db06c9299 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -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 } diff --git a/cabal-install/Distribution/Client/Run.hs b/cabal-install/Distribution/Client/Run.hs index 530ee3b2b2d..d5578ae4936 100644 --- a/cabal-install/Distribution/Client/Run.hs +++ b/cabal-install/Distribution/Client/Run.hs @@ -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 From 52f96e184db572f26bb80ec219b482c9871a3349 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Wed, 3 Dec 2014 12:06:19 +0100 Subject: [PATCH 21/33] Add (DY)LD_LIBRARY_PATH for 'run' and 'test' commands --- Cabal/Distribution/Simple/GHC.hs | 63 +++------------------ Cabal/Distribution/Simple/LocalBuildInfo.hs | 63 ++++++++++++++++++++- Cabal/Distribution/Simple/Test/ExeV10.hs | 19 ++++++- Cabal/Distribution/Simple/Test/LibV09.hs | 21 ++++++- Cabal/Distribution/Simple/Utils.hs | 24 +++++++- cabal-install/Distribution/Client/Run.hs | 43 ++++++-------- 6 files changed, 142 insertions(+), 91 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 24db06c9299..5958ecc3389 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/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 diff --git a/Cabal/Distribution/Simple/LocalBuildInfo.hs b/Cabal/Distribution/Simple/LocalBuildInfo.hs index 460af60ae6e..7f115ec097b 100644 --- a/Cabal/Distribution/Simple/LocalBuildInfo.hs +++ b/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 diff --git a/Cabal/Distribution/Simple/Test/ExeV10.hs b/Cabal/Distribution/Simple/Test/ExeV10.hs index b11e2e31e60..25ab36d1a36 100644 --- a/Cabal/Distribution/Simple/Test/ExeV10.hs +++ b/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) diff --git a/Cabal/Distribution/Simple/Test/LibV09.hs b/Cabal/Distribution/Simple/Test/LibV09.hs index 3da69539f36..3f1755671fb 100644 --- a/Cabal/Distribution/Simple/Test/LibV09.hs +++ b/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) diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs index c306a23134d..7f67c642e71 100644 --- a/Cabal/Distribution/Simple/Utils.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/Run.hs b/cabal-install/Distribution/Client/Run.hs index d5578ae4936..992ce9e8e19 100644 --- a/cabal-install/Distribution/Client/Run.hs +++ b/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 From bb273e7c4c30f4bf9fffe7505c112a7177f0e1aa Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Wed, 3 Dec 2014 16:56:53 +0100 Subject: [PATCH 22/33] Don't fail canonicalizePath when libdir doesn't exist --- Cabal/Distribution/Simple/LocalBuildInfo.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/Cabal/Distribution/Simple/LocalBuildInfo.hs b/Cabal/Distribution/Simple/LocalBuildInfo.hs index 7f115ec097b..cdb1d426a00 100644 --- a/Cabal/Distribution/Simple/LocalBuildInfo.hs +++ b/Cabal/Distribution/Simple/LocalBuildInfo.hs @@ -97,7 +97,7 @@ import Data.Tree (flatten) import GHC.Generics (Generic) import Data.Map (Map) -import System.Directory (canonicalizePath) +import System.Directory (doesDirectoryExist, canonicalizePath) import System.FilePath (()) -- | Data cached after configuration step. See also @@ -437,7 +437,7 @@ depLibraryPaths inplace relative lbi clbi = do allDepLibDirs' = if hasInternalDeps then (libdir installDirs) : allDepLibDirs else allDepLibDirs - allDepLibDirsC <- mapM canonicalizePath allDepLibDirs' + allDepLibDirsC <- mapM canonicalizePathNoFail allDepLibDirs' let (Platform _ hostOS) = hostPlatform lbi hostPref = case hostOS of @@ -459,6 +459,11 @@ depLibraryPaths inplace relative lbi clbi = do return (toNubListR rpaths) where internal pkgid = pkgid == packageId (localPkgDescr lbi) + canonicalizePathNoFail p = do + exists <- doesDirectoryExist p + if exists + then canonicalizePath p + else return p -- ----------------------------------------------------------------------------- From fdcb0d9d4c0a989caae3a5efc91b5c7a4078867c Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Wed, 3 Dec 2014 17:01:47 +0100 Subject: [PATCH 23/33] Correctly determine location of internal library --- Cabal/Distribution/Simple/LocalBuildInfo.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Cabal/Distribution/Simple/LocalBuildInfo.hs b/Cabal/Distribution/Simple/LocalBuildInfo.hs index cdb1d426a00..ba4e6b05140 100644 --- a/Cabal/Distribution/Simple/LocalBuildInfo.hs +++ b/Cabal/Distribution/Simple/LocalBuildInfo.hs @@ -434,8 +434,11 @@ depLibraryPaths inplace relative lbi clbi = do let ipkgs = allPackages (installedPkgs lbi) allDepLibDirs = concatMap Installed.libraryDirs ipkgs + internalLib + | inplace = buildDir lbi + | otherwise = libdir installDirs allDepLibDirs' = if hasInternalDeps - then (libdir installDirs) : allDepLibDirs + then internalLib : allDepLibDirs else allDepLibDirs allDepLibDirsC <- mapM canonicalizePathNoFail allDepLibDirs' From 7e364430aec3530510691304b54b439e4b1afb80 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Wed, 3 Dec 2014 17:43:52 +0100 Subject: [PATCH 24/33] Split RPath calculation from dependent library calculation --- Cabal/Distribution/Simple/GHC.hs | 52 ++++++++++++++++----- Cabal/Distribution/Simple/LocalBuildInfo.hs | 28 +++++------ Cabal/Distribution/Simple/Test/ExeV10.hs | 5 +- Cabal/Distribution/Simple/Test/LibV09.hs | 7 +-- cabal-install/Distribution/Client/Run.hs | 4 +- 5 files changed, 56 insertions(+), 40 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 5958ecc3389..7408e35155d 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -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. diff --git a/Cabal/Distribution/Simple/LocalBuildInfo.hs b/Cabal/Distribution/Simple/LocalBuildInfo.hs index ba4e6b05140..3f7a5827133 100644 --- a/Cabal/Distribution/Simple/LocalBuildInfo.hs +++ b/Cabal/Distribution/Simple/LocalBuildInfo.hs @@ -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 diff --git a/Cabal/Distribution/Simple/Test/ExeV10.hs b/Cabal/Distribution/Simple/Test/ExeV10.hs index 25ab36d1a36..6a5cd24b7c2 100644 --- a/Cabal/Distribution/Simple/Test/ExeV10.hs +++ b/Cabal/Distribution/Simple/Test/ExeV10.hs @@ -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 diff --git a/Cabal/Distribution/Simple/Test/LibV09.hs b/Cabal/Distribution/Simple/Test/LibV09.hs index 3f1755671fb..29a31a06b42 100644 --- a/Cabal/Distribution/Simple/Test/LibV09.hs +++ b/Cabal/Distribution/Simple/Test/LibV09.hs @@ -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') diff --git a/cabal-install/Distribution/Client/Run.hs b/cabal-install/Distribution/Client/Run.hs index 992ce9e8e19..bece958669b 100644 --- a/cabal-install/Distribution/Client/Run.hs +++ b/cabal-install/Distribution/Client/Run.hs @@ -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 ++ "..." From 17474f58aae21326c26147bf176cce72764b97ff Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Wed, 3 Dec 2014 17:44:13 +0100 Subject: [PATCH 25/33] Add comment on canonicalizePathNoFail --- Cabal/Distribution/Simple/LocalBuildInfo.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Cabal/Distribution/Simple/LocalBuildInfo.hs b/Cabal/Distribution/Simple/LocalBuildInfo.hs index 3f7a5827133..ac69a76091c 100644 --- a/Cabal/Distribution/Simple/LocalBuildInfo.hs +++ b/Cabal/Distribution/Simple/LocalBuildInfo.hs @@ -456,6 +456,8 @@ depLibraryPaths inplace relative lbi clbi = do return libPaths where internal pkgid = pkgid == packageId (localPkgDescr lbi) + -- 'canonicalizePath' fails on UNIX when the directory does not exists. + -- So just don't canonicalize when it doesn't exist. canonicalizePathNoFail p = do exists <- doesDirectoryExist p if exists From 2dd28dcab90e123f824f06eebd6585f0135f465c Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 4 Dec 2014 10:32:15 +0100 Subject: [PATCH 26/33] Ensure we add overwrite existing (DY)LD_LIBRARY_PATH --- Cabal/Distribution/Simple/Utils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs index 7f67c642e71..ded151247e9 100644 --- a/Cabal/Distribution/Simple/Utils.hs +++ b/Cabal/Distribution/Simple/Utils.hs @@ -712,7 +712,7 @@ addLibraryPath os paths env = do ldEnv <- maybe libPaths (++ (searchPathSeparator:libPaths)) <$> lookupEnv ldPath - return ((ldPath,ldEnv):env) + return (env ++ (ldPath,ldEnv)) ---------------- -- File globbing From 5ccaabf598121710392a67a8496c75242a8a7235 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 4 Dec 2014 10:33:46 +0100 Subject: [PATCH 27/33] wobble typo --- Cabal/Distribution/Simple/Utils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs index ded151247e9..e67e70d7b93 100644 --- a/Cabal/Distribution/Simple/Utils.hs +++ b/Cabal/Distribution/Simple/Utils.hs @@ -712,7 +712,7 @@ addLibraryPath os paths env = do ldEnv <- maybe libPaths (++ (searchPathSeparator:libPaths)) <$> lookupEnv ldPath - return (env ++ (ldPath,ldEnv)) + return (env ++ [(ldPath,ldEnv)]) ---------------- -- File globbing From 6df115142e489cf124b2d5b1f0010fdc450a4d37 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 4 Dec 2014 10:38:25 +0100 Subject: [PATCH 28/33] Add support for linux --- Cabal/Distribution/Simple/Configure.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index dcf22628fb1..3c1ce8d1e31 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -1578,7 +1578,7 @@ checkRelocatable verbosity pkg lbi where -- Check if the OS support relocatable builds checkOS - = unless (os `elem` [ OSX ]) + = unless (os `elem` [ OSX, Linux ]) $ die $ "Operating system: " ++ display os ++ ", does not support relocatable builds" where From 649cffc1835ef985248bc67cef7f7cdcb35f33f0 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 4 Dec 2014 10:42:26 +0100 Subject: [PATCH 29/33] Add comment on RPATH support --- Cabal/Distribution/Simple/Configure.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 3c1ce8d1e31..3a42513ed94 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -1576,7 +1576,11 @@ checkRelocatable verbosity pkg lbi , depsPrefixRelative ] where - -- Check if the OS support relocatable builds + -- Check if the OS support relocatable builds. + -- + -- If you add new OS' to this list, and your OS supports dynamic libraries + -- and RPATH, make sure you add your OS to RPATH-support list of: + -- Cabal.Simple.GHC.getRPaths checkOS = unless (os `elem` [ OSX, Linux ]) $ die $ "Operating system: " ++ display os ++ From aa0168b909e5d459898324acdfa886bf4b3ff2db Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 4 Dec 2014 11:51:08 +0100 Subject: [PATCH 30/33] Cabal handles RPATHs on supported platform. Before, RPATH handling was left to GHC. But this causes problems when a package contains both a Library section and an Executable section which depends on the library, and the executable is dynamically linked. See e.g. #1568 --- Cabal/Distribution/Simple/GHC.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 7408e35155d..1f3e3513b73 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -1122,8 +1122,8 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi getRPaths :: LocalBuildInfo -> ComponentLocalBuildInfo -- ^ Component we are building -> IO (NubListR FilePath) -getRPaths lbi clbi | relocatable lbi && supportRPaths hostOS = do - libraryPaths <- depLibraryPaths False True lbi clbi +getRPaths lbi clbi | supportRPaths hostOS = do + libraryPaths <- depLibraryPaths False (relocatable lbi) lbi clbi let hostPref = case hostOS of OSX -> "@loader_path" _ -> "$ORIGIN" From dd0eaeba0b44b3d9a120b300f2071e079ac4bf08 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 4 Dec 2014 12:26:00 +0100 Subject: [PATCH 31/33] Disable Cabal RPath handling on untested Operating Systems These operating systems do support RPath, but they are untested with regards to Cabal's RPATH calculation, so we will leave RPATH handling on those operating systems to GHC. --- Cabal/Distribution/Simple/GHC.hs | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 1f3e3513b73..af87b47a761 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -1133,14 +1133,21 @@ getRPaths lbi clbi | supportRPaths hostOS = do where (Platform _ hostOS) = hostPlatform lbi + -- The list of RPath-supported operating systems below reflects the + -- platforms on which Cabal's RPATH handling is tested. It does _NOT_ + -- reflect whether the OS supports RPATH. + + -- E.g. when this comment was written, the *BSD operating systems were + -- untested with regards to Cabal RPATH handling, and were hence set to + -- 'False', while those operating systems themselves do support RPATH. 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 FreeBSD   = False + supportRPaths OpenBSD   = False + supportRPaths NetBSD   = False + supportRPaths DragonFly = False + supportRPaths Solaris = False supportRPaths AIX = False supportRPaths HPUX = False supportRPaths IRIX = False From d53b4fb56d89aab0c4a51365b45d9499a625e205 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 4 Dec 2014 14:31:30 +0100 Subject: [PATCH 32/33] Don't use 'lookupEnv' in 'addLibraryPaths' --- Cabal/Distribution/Simple/Test/ExeV10.hs | 2 +- Cabal/Distribution/Simple/Test/LibV09.hs | 2 +- Cabal/Distribution/Simple/Utils.hs | 29 +++++++++++++----------- cabal-install/Distribution/Client/Run.hs | 2 +- 4 files changed, 19 insertions(+), 16 deletions(-) diff --git a/Cabal/Distribution/Simple/Test/ExeV10.hs b/Cabal/Distribution/Simple/Test/ExeV10.hs index 6a5cd24b7c2..09221b6c64a 100644 --- a/Cabal/Distribution/Simple/Test/ExeV10.hs +++ b/Cabal/Distribution/Simple/Test/ExeV10.hs @@ -87,7 +87,7 @@ runTest pkg_descr lbi flags suite = do clbi = LBI.getComponentLocalBuildInfo lbi (LBI.CTestName (PD.testName suite)) paths <- LBI.depLibraryPaths True False lbi clbi - addLibraryPath os paths shellEnv + return (addLibraryPath os paths shellEnv) else return shellEnv exit <- rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv') diff --git a/Cabal/Distribution/Simple/Test/LibV09.hs b/Cabal/Distribution/Simple/Test/LibV09.hs index 29a31a06b42..accb492d338 100644 --- a/Cabal/Distribution/Simple/Test/LibV09.hs +++ b/Cabal/Distribution/Simple/Test/LibV09.hs @@ -98,7 +98,7 @@ runTest pkg_descr lbi flags suite = do (PD.testName suite)) paths <- LBI.depLibraryPaths True False lbi clbi - addLibraryPath os paths shellEnv + return (addLibraryPath os paths shellEnv) else return shellEnv rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv') -- these handles are closed automatically diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs index e67e70d7b93..a4e5a0119d5 100644 --- a/Cabal/Distribution/Simple/Utils.hs +++ b/Cabal/Distribution/Simple/Utils.hs @@ -128,8 +128,6 @@ module Distribution.Simple.Utils ( wrapLine, ) where -import Data.Functor - ( (<$>) ) import Control.Monad ( join, when, unless, filterM ) import Control.Concurrent.MVar @@ -149,7 +147,7 @@ import System.Directory , doesDirectoryExist, doesFileExist, removeFile, findExecutable , getModificationTime ) import System.Environment - ( getProgName, lookupEnv ) + ( getProgName ) import System.Exit ( exitWith, ExitCode(..) ) import System.FilePath @@ -703,16 +701,21 @@ 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 (env ++ [(ldPath,ldEnv)]) + -> [(String,String)] +addLibraryPath os paths = addEnv + where + pathsString = intercalate [searchPathSeparator] paths + ldPath = case os of + OSX -> "DYLD_LIBRARY_PATH" + _ -> "LD_LIBRARY_PATH" + + addEnv [] = [(ldPath,pathsString)] + addEnv ((key,value):xs) + | key == ldPath = + if null value + then (key,pathsString):xs + else (key,value ++ (searchPathSeparator:pathsString)):xs + | otherwise = (key,value):addEnv xs ---------------- -- File globbing diff --git a/cabal-install/Distribution/Client/Run.hs b/cabal-install/Distribution/Client/Run.hs index bece958669b..9ff83db36e7 100644 --- a/cabal-install/Distribution/Client/Run.hs +++ b/cabal-install/Distribution/Client/Run.hs @@ -72,7 +72,7 @@ run verbosity lbi exe exeArgs = do clbi = getComponentLocalBuildInfo lbi (CExeName (exeName exe)) paths <- depLibraryPaths True False lbi clbi - addLibraryPath os paths env + return (addLibraryPath os paths env) else return env notice verbosity $ "Running " ++ exeName exe ++ "..." rawSystemExitWithEnv verbosity path exeArgs env' From 3f361de6871bb78c8622dfdc3213f46643762d06 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 4 Dec 2014 15:10:26 +0100 Subject: [PATCH 33/33] Wobble comment --- Cabal/Distribution/Simple/Configure.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 3a42513ed94..705d6e60a46 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -1580,7 +1580,7 @@ checkRelocatable verbosity pkg lbi -- -- If you add new OS' to this list, and your OS supports dynamic libraries -- and RPATH, make sure you add your OS to RPATH-support list of: - -- Cabal.Simple.GHC.getRPaths + -- Distribution.Simple.GHC.getRPaths checkOS = unless (os `elem` [ OSX, Linux ]) $ die $ "Operating system: " ++ display os ++