Skip to content

Commit

Permalink
Never use --enable-profiling when invoking Setup.
Browse files Browse the repository at this point in the history
In Cabal 1.22.5.0, the semantics of
--disable-profiling/--enable-profiling depend on ordering (because there
is a hack that operates by looking at the current flag assignment and
doing something). In particular, if I specify --enable-library-profiling
--disable-profiling, I end up with library profiling DISABLED.

The fix is that we NEVER pass --enable-profiling or --disable-profiling
to Cabal. At the moment, and according to my historical analysis, Cabal
ONLY uses configProf to affect the effective library/executable
profiling, which means that anything we do with --enable-profiling, we
can do using the library/executable profiling individually. Since these
are always flags for the versions of Cabal library we support, we will
get order invariance. Historical versions have varied on whether or not
setting executable profiling implies library profiling, but if we set
both explicitly this change in behavior doesn't matter.

This patch is difficult to test because the bad profiling flags
can't be induced on an inplace build.  I tested by hand by building
a package that depended on 'distributive' by hand.

Fixes #3790.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
  • Loading branch information
ezyang committed Sep 19, 2016
1 parent 56cff2d commit bf3d3e6
Show file tree
Hide file tree
Showing 2 changed files with 31 additions and 11 deletions.
26 changes: 21 additions & 5 deletions Cabal/Distribution/Simple/Configure.hs
Expand Up @@ -46,6 +46,7 @@ module Distribution.Simple.Configure (configure,
getPackageDBContents,
configCompiler, configCompilerAux,
configCompilerEx, configCompilerAuxEx,
computeEffectiveProfiling,
ccLdOptionsBuildInfo,
checkForeignDeps,
interpretPackageDbFlags,
Expand Down Expand Up @@ -1074,11 +1075,18 @@ configureCoverage verbosity cfg comp = do
++ "program coverage. Program coverage has been disabled.")
return apply

-- | Select and apply profiling settings for the build based on the
-- 'ConfigFlags' and 'Compiler'.
configureProfiling :: Verbosity -> ConfigFlags -> Compiler
-> IO (LocalBuildInfo -> LocalBuildInfo)
configureProfiling verbosity cfg comp = do
-- | Compute the effective value of the profiling flags
-- @--enable-library-profiling@ and @--enable-executable-profiling@
-- from the specified 'ConfigFlags'. This may be useful for
-- external Cabal tools which need to interact with Setup in
-- a backwards-compatible way: the most predictable mechanism
-- for enabling profiling across many legacy versions is to
-- NOT use @--enable-profiling@ and use those two flags instead.
--
-- Note that @--enable-executable-profiling@ also affects profiling
-- of benchmarks and (non-detailed) test suites.
computeEffectiveProfiling :: ConfigFlags -> (Bool {- lib -}, Bool {- exe -})
computeEffectiveProfiling cfg =
-- The --profiling flag sets the default for both libs and exes,
-- but can be overidden by --library-profiling, or the old deprecated
-- --executable-profiling flag.
Expand All @@ -1089,6 +1097,14 @@ configureProfiling verbosity cfg comp = do
(mappend (configProf cfg) (configProfExe cfg))
tryLibProfiling = fromFlagOrDefault tryExeProfiling
(mappend (configProf cfg) (configProfLib cfg))
in (tryLibProfiling, tryExeProfiling)

-- | Select and apply profiling settings for the build based on the
-- 'ConfigFlags' and 'Compiler'.
configureProfiling :: Verbosity -> ConfigFlags -> Compiler
-> IO (LocalBuildInfo -> LocalBuildInfo)
configureProfiling verbosity cfg comp = do
let (tryLibProfiling, tryExeProfiling) = computeEffectiveProfiling cfg

tryExeProfileLevel = fromFlagOrDefault ProfDetailDefault
(configProfDetail cfg)
Expand Down
16 changes: 10 additions & 6 deletions cabal-install/Distribution/Client/Setup.hs
Expand Up @@ -76,7 +76,7 @@ import Distribution.Simple.Program (ProgramDb, defaultProgramDb)
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import qualified Distribution.Simple.Command as Command
import Distribution.Simple.Configure
( configCompilerAuxEx, interpretPackageDbFlags )
( configCompilerAuxEx, interpretPackageDbFlags, computeEffectiveProfiling )
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Setup
( ConfigFlags(..), BuildFlags(..), ReplFlags
Expand Down Expand Up @@ -393,21 +393,25 @@ filterConfigureFlags flags cabalLibVersion
}

-- Cabal < 1.23 doesn't know about '--profiling-detail'.
-- Cabal < 1.23 has a hacked up version of 'enable-profiling'
-- which we shouldn't use.
(tryLibProfiling, tryExeProfiling) = computeEffectiveProfiling flags
flags_1_23_0 = flags_latest { configProfDetail = NoFlag
, configProfLibDetail = NoFlag
, configIPID = NoFlag }
, configIPID = NoFlag
, configProf = mempty
, configProfExe = Flag tryExeProfiling
, configProfLib = Flag tryLibProfiling
}

-- Cabal < 1.22 doesn't know about '--disable-debug-info'.
flags_1_22_0 = flags_1_23_0 { configDebugInfo = NoFlag }

-- Cabal < 1.21.1 doesn't know about 'disable-relocatable'
-- Cabal < 1.21.1 doesn't know about 'enable-profiling'
-- (but we already dealt with it in flags_1_23_0)
flags_1_21_1 =
flags_1_22_0 { configRelocatable = NoFlag
, configProf = NoFlag
, configProfExe = configProf flags
, configProfLib =
mappend (configProf flags) (configProfLib flags)
, configCoverage = NoFlag
, configLibCoverage = configCoverage flags
}
Expand Down

0 comments on commit bf3d3e6

Please sign in to comment.