Commit 03b02fb6 authored by tibbe's avatar tibbe

Allow using cabal program itself as the external setup method

This fixes issues when the version of Cabal that cabal-install was built
against differs from the one registered in the local package DB. Normally
we compile an external setup against the local Cabal library, which could
lead to failures or inconsistent results compared to using the internal
method.

This fixes #2438 and fixes #1938.
parent 776e9e2c
......@@ -35,6 +35,7 @@ module Distribution.Client.Setup
, initCommand, IT.InitFlags(..)
, sdistCommand, SDistFlags(..), SDistExFlags(..), ArchiveFormat(..)
, win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..)
, actAsSetupCommand, ActAsSetupFlags(..)
, sandboxCommand, defaultSandboxLocation, SandboxFlags(..)
, execCommand, ExecFlags(..)
, userConfigCommand, UserConfigFlags(..)
......@@ -79,7 +80,7 @@ import Distribution.Version
import Distribution.Package
( PackageIdentifier, packageName, packageVersion, Dependency(..) )
import Distribution.PackageDescription
( RepoKind(..) )
( BuildType(..), RepoKind(..) )
import Distribution.Text
( Text(..), display )
import Distribution.ReadE
......@@ -1813,6 +1814,47 @@ instance Monoid Win32SelfUpgradeFlags where
}
where combine field = field a `mappend` field b
-- ------------------------------------------------------------
-- * ActAsSetup flags
-- ------------------------------------------------------------
data ActAsSetupFlags = ActAsSetupFlags {
actAsSetupBuildType :: Flag BuildType
}
defaultActAsSetupFlags :: ActAsSetupFlags
defaultActAsSetupFlags = ActAsSetupFlags {
actAsSetupBuildType = toFlag Simple
}
actAsSetupCommand :: CommandUI ActAsSetupFlags
actAsSetupCommand = CommandUI {
commandName = "act-as-setup",
commandSynopsis = "Run as-if this was a Setup.hs",
commandDescription = Nothing,
commandNotes = Nothing,
commandUsage = \pname ->
"Usage: " ++ pname ++ " act-as-setup\n",
commandDefaultFlags = defaultActAsSetupFlags,
commandOptions = \_ ->
[option "" ["build-type"]
"Use the given build type."
actAsSetupBuildType (\v flags -> flags { actAsSetupBuildType = v })
(reqArg "BUILD-TYPE" (readP_to_E ("Cannot parse build type: "++)
(fmap toFlag parse))
(map display . flagToList))
]
}
instance Monoid ActAsSetupFlags where
mempty = ActAsSetupFlags {
actAsSetupBuildType = mempty
}
mappend a b = ActAsSetupFlags {
actAsSetupBuildType = combine actAsSetupBuildType
}
where combine field = field a `mappend` field b
-- ------------------------------------------------------------
-- * Sandbox-related flags
-- ------------------------------------------------------------
......
......@@ -105,6 +105,7 @@ import Control.Monad ( when, unless )
import Data.List ( foldl1' )
import Data.Maybe ( fromMaybe, isJust )
import Data.Char ( isSpace )
import Distribution.Client.Compat.ExecutablePath ( getExecutablePath )
#ifdef mingw32_HOST_OS
import Distribution.Simple.Utils
......@@ -222,12 +223,22 @@ setupWrapper verbosity options mpkg cmd flags extraArgs = do
--
determineSetupMethod :: SetupScriptOptions -> BuildType -> SetupMethod
determineSetupMethod options buildType'
| forceExternalSetupMethod options = externalSetupMethod
-- This order is picked so that it's stable. The build type and
-- required cabal version are external info, coming from .cabal
-- files and the command line. Those do switch between the
-- external and self & internal methods, but that info itself can
-- be considered stable. The logging and force-external conditions
-- are internally generated choices but now these only switch
-- between the self and internal setup methods, which are
-- consistent with each other.
| buildType' == Custom = externalSetupMethod
| not (cabalVersion `withinRange`
useCabalVersion options) = externalSetupMethod
| isJust (useLoggingHandle options)
|| buildType' == Custom = externalSetupMethod
| cabalVersion `withinRange`
useCabalVersion options = internalSetupMethod
| otherwise = externalSetupMethod
-- Forcing is done to use an external process e.g. due to parallel
-- build concerns.
|| forceExternalSetupMethod options = selfExecSetupMethod
| otherwise = internalSetupMethod
type SetupMethod = Verbosity
-> SetupScriptOptions
......@@ -255,6 +266,34 @@ buildTypeAction Make = Make.defaultMainArgs
buildTypeAction Custom = error "buildTypeAction Custom"
buildTypeAction (UnknownBuildType _) = error "buildTypeAction UnknownBuildType"
-- ------------------------------------------------------------
-- * Self-Exec SetupMethod
-- ------------------------------------------------------------
selfExecSetupMethod :: SetupMethod
selfExecSetupMethod verbosity options _pkg bt mkargs = do
let args = ["act-as-setup",
"--build-type=" ++ display bt,
"--"] ++ mkargs cabalVersion
debug verbosity $ "Using self-exec internal setup method with build-type "
++ show bt ++ " and args:\n " ++ show args
path <- getExecutablePath
info verbosity $ unwords (path : args)
case useLoggingHandle options of
Nothing -> return ()
Just logHandle -> info verbosity $ "Redirecting build log to "
++ show logHandle
searchpath <- programSearchPathAsPATHVar
(getProgramSearchPath (useProgramConfig options))
env <- getEffectiveEnvironment [("PATH", Just searchpath)]
process <- runProcess path args
(useWorkingDir options) env Nothing
(useLoggingHandle options) (useLoggingHandle options)
exitCode <- waitForProcess process
unless (exitCode == ExitSuccess) $ exitWith exitCode
-- ------------------------------------------------------------
-- * External SetupMethod
-- ------------------------------------------------------------
......
......@@ -37,6 +37,7 @@ import Distribution.Client.Setup
, InitFlags(initVerbosity), initCommand
, SDistFlags(..), SDistExFlags(..), sdistCommand
, Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand
, ActAsSetupFlags(..), actAsSetupCommand
, SandboxFlags(..), sandboxCommand
, ExecFlags(..), execCommand
, UserConfigFlags(..), userConfigCommand
......@@ -112,12 +113,14 @@ import Distribution.Client.Utils (determineNumJobs
,existsAndIsMoreRecentThan)
import Distribution.PackageDescription
( Executable(..), benchmarkName, benchmarkBuildInfo, testName
, testBuildInfo, buildable )
( BuildType(..), Executable(..), benchmarkName, benchmarkBuildInfo
, testName, testBuildInfo, buildable )
import Distribution.PackageDescription.Parse
( readPackageDescription )
import Distribution.PackageDescription.PrettyPrint
( writeGenericPackageDescription )
import qualified Distribution.Simple as Simple
import qualified Distribution.Make as Make
import Distribution.Simple.Build
( startInterpreter )
import Distribution.Simple.Command
......@@ -262,6 +265,8 @@ mainWorker args = topHandler $
upgradeCommand `commandAddAction` upgradeAction
,hiddenCommand $
win32SelfUpgradeCommand`commandAddAction` win32SelfUpgradeAction
,hiddenCommand $
actAsSetupCommand`commandAddAction` actAsSetupAction
]
wrapperAction :: Monoid flags
......@@ -1155,3 +1160,17 @@ win32SelfUpgradeAction selfUpgradeFlags (pid:path:_extraArgs) _globalFlags = do
let verbosity = fromFlag (win32SelfUpgradeVerbosity selfUpgradeFlags)
Win32SelfUpgrade.deleteOldExeFile verbosity (read pid) path
win32SelfUpgradeAction _ _ _ = return ()
-- | Used as an entry point when cabal-install needs to invoke itself
-- as a setup script. This can happen e.g. when doing parallel builds.
--
actAsSetupAction :: ActAsSetupFlags -> [String] -> GlobalFlags -> IO ()
actAsSetupAction actAsSetupFlags args _globalFlags =
let bt = fromFlag (actAsSetupBuildType actAsSetupFlags)
in case bt of
Simple -> Simple.defaultMainArgs args
Configure -> Simple.defaultMainWithHooksArgs
Simple.autoconfUserHooks args
Make -> Make.defaultMainArgs args
Custom -> error "actAsSetupAction Custom"
(UnknownBuildType _) -> error "actAsSetupAction UnknownBuildType"
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment