diff --git a/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs b/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs index b2b6853c604..3e0c222ff24 100644 --- a/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs +++ b/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs @@ -29,6 +29,7 @@ import Distribution.Simple.Setup (HaddockTarget (..), TestShow import Distribution.SPDX import Distribution.System import Distribution.Types.Dependency +import Distribution.Types.EnableComponentType import Distribution.Types.Flag (FlagAssignment, FlagName, mkFlagAssignment, mkFlagName, unFlagAssignment) import Distribution.Types.IncludeRenaming import Distribution.Types.LibraryName @@ -493,6 +494,13 @@ instance Arbitrary PackageDB where instance Arbitrary DumpBuildInfo where arbitrary = arbitraryBoundedEnum +------------------------------------------------------------------------------- +-- EnableComponentType +------------------------------------------------------------------------------- + +instance Arbitrary EnableComponentType where + arbitrary = arbitraryBoundedEnum + ------------------------------------------------------------------------------- -- Helpers ------------------------------------------------------------------------------- diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index c56a05f8380..e3d0148c0af 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -255,6 +255,7 @@ library Distribution.Types.VersionInterval.Legacy Distribution.Types.GivenComponent Distribution.Types.PackageVersionConstraint + Distribution.Types.EnableComponentType Distribution.Utils.Generic Distribution.Utils.Json Distribution.Utils.NubList diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index 136c3b2c0ca..75b2bc8c7d1 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -80,6 +80,7 @@ import Distribution.Types.PackageVersionConstraint import Distribution.Types.LocalBuildInfo import Distribution.Types.ComponentRequestedSpec import Distribution.Types.GivenComponent +import Distribution.Types.EnableComponentType import Distribution.Simple.Utils import Distribution.System import Distribution.Version @@ -401,12 +402,15 @@ configure (pkg_descr0, pbi) cfg = do -- nomenclature; it's just a request; a -- @buildable: False@ might make it -- not possible to enable. - { testsRequested = fromFlag (configTests cfg) + { testsRequested = + fromFlag (configTests cfg) == EnableAll , benchmarksRequested = - fromFlag (configBenchmarks cfg) } + fromFlag (configBenchmarks cfg) == EnableAll + } -- Some sanity checks related to enabling components. when (isJust mb_cname - && (fromFlag (configTests cfg) || fromFlag (configBenchmarks cfg))) $ + && ( fromFlag (configTests cfg) == EnableAll + || fromFlag (configBenchmarks cfg) == EnableAll)) $ die' verbosity $ "--enable-tests/--enable-benchmarks are incompatible with" ++ " explicitly specifying a component to configure." diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs index 6ed08e7ed33..26da0c05061 100644 --- a/Cabal/src/Distribution/Simple/Setup.hs +++ b/Cabal/src/Distribution/Simple/Setup.hs @@ -100,6 +100,7 @@ import Distribution.Verbosity import Distribution.Utils.NubList import Distribution.Types.ComponentId import Distribution.Types.DumpBuildInfo +import Distribution.Types.EnableComponentType import Distribution.Types.GivenComponent import Distribution.Types.Module import Distribution.Types.PackageVersionConstraint @@ -264,8 +265,8 @@ data ConfigFlags = ConfigFlags { -- package does not use Backpack, or we just want to typecheck -- the indefinite package. configConfigurationsFlags :: FlagAssignment, - configTests :: Flag Bool, -- ^Enable test suite compilation - configBenchmarks :: Flag Bool, -- ^Enable benchmark compilation + configTests :: Flag EnableComponentType, -- ^Enable test suite compilation + configBenchmarks :: Flag EnableComponentType, -- ^Enable benchmark compilation configCoverage :: Flag Bool, -- ^Enable program coverage configLibCoverage :: Flag Bool, -- ^Enable program coverage (deprecated) configExactConfiguration :: Flag Bool, @@ -392,8 +393,8 @@ defaultConfigFlags progDb = emptyConfigFlags { configSplitObjs = Flag False, -- takes longer, so turn off by default configStripExes = NoFlag, configStripLibs = NoFlag, - configTests = Flag False, - configBenchmarks = Flag False, + configTests = Flag EnableWhenPossible, + configBenchmarks = Flag EnableWhenPossible, configCoverage = Flag False, configLibCoverage = NoFlag, configExactConfiguration = Flag False, @@ -698,10 +699,18 @@ configureOptions showOrParseArgs = (parsecToReadE ("Cannot parse module substitution: " ++) (fmap (:[]) parsecModSubstEntry)) (map (Disp.renderStyle defaultStyle . dispModSubstEntry))) - ,option "" ["tests"] - "dependency checking and compilation for test suites listed in the package description file." + ,multiOption "tests" configTests (\v flags -> flags { configTests = v }) - (boolOpt [] []) + [noArg (Flag EnableWhenPossible) [] + ["enable-tests-when-possible", "enable-test-if-possible"] + "Build the tests if a build plan can be found, don't build them otherwise. The decision is made independently for each package, not for each test suite." + ,noArg (Flag EnableAll) [] + ["enable-tests", "enable-test"] + "Build all the test suites listed in the package description file." + ,noArg (Flag DisableAll) [] + ["disable-tests", "disable-test"] + "Do not build any test suites." + ] ,option "" ["coverage"] "build package with Haskell Program Coverage. (GHC only)" @@ -719,10 +728,18 @@ configureOptions showOrParseArgs = (\v flags -> flags { configExactConfiguration = v }) trueArg - ,option "" ["benchmarks"] - "dependency checking and compilation for benchmarks listed in the package description file." + ,multiOption "benchmarks" configBenchmarks (\v flags -> flags { configBenchmarks = v }) - (boolOpt [] []) + [noArg (Flag EnableWhenPossible) [] + ["enable-benchmarks-when-possible", "enable-benchmark-if-possible"] + "Build the benchmarks if a build plan can be found, don't build them otherwise. The decision is made independently for each package, not for each benchmark." + ,noArg (Flag EnableAll) [] + ["enable-benchmarks", "enable-benchmark"] + "Build all the benchmarks listed in the package description file." + ,noArg (Flag DisableAll) [] + ["disable-benchmarks", "disable-benchmark"] + "Do not build any benchmarks." + ] ,option "" ["relocatable"] "building a package that is relocatable. (GHC only)" diff --git a/Cabal/src/Distribution/Types/EnableComponentType.hs b/Cabal/src/Distribution/Types/EnableComponentType.hs new file mode 100644 index 00000000000..ac5c439f9b8 --- /dev/null +++ b/Cabal/src/Distribution/Types/EnableComponentType.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Types.EnableComponentType ( + EnableComponentType(..), + + defaultEnableComponentType, + enableComponentTypeToRequest, +) where + +import Prelude () +import Distribution.Compat.Prelude + +-- | Which subset of a given component type to enable. Specified by option +-- triples like @--enable-tests@, @--disable-tests@, and +-- @--enable-tests-when-possible@. +-- +-- @since 3.7.0.0 +data EnableComponentType + = EnableAll + | DisableAll + | EnableWhenPossible + deriving (Generic, Read, Show, Eq, Typeable, Bounded, Enum) + +instance Binary EnableComponentType +instance Structured EnableComponentType + +-- | 'EnableComponentType' is only used for tests and benchmarks, for which the +-- default behaviour of @cabal configure@ is to try to include them in the +-- build plan if possible, and to silently drop them otherwise. +-- +-- It's not a big deal to drop them because the default behaviour of @cabal +-- build@ is to build the libraries and executables, but not the tests nor the +-- benchmarks. But it's better to include them in the build plan if we can, so +-- that running @cabal test@ after @cabal build@ doesn't unnecessarily rebuild +-- because of a changed build plan. +-- +-- @since 3.7.0.0 +defaultEnableComponentType :: EnableComponentType +defaultEnableComponentType = EnableWhenPossible + +-- | With the 'EnableAll' and 'DisableAll' settings, the user makes an explicit +-- request, either to definitely enable or to definitely disable a certain type +-- of component. However, with 'EnableWhenPossible', the user is not making any +-- request. +-- +-- @since 3.7.0.0 +enableComponentTypeToRequest :: EnableComponentType -> Maybe Bool +enableComponentTypeToRequest EnableAll = Just True +enableComponentTypeToRequest DisableAll = Just False +enableComponentTypeToRequest EnableWhenPossible = Nothing diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index e72324c41bc..a2f3adb33b3 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -149,6 +149,8 @@ import Distribution.Simple.Utils , findPackageDesc, tryFindPackageDesc ) import Distribution.Text ( display ) +import Distribution.Types.EnableComponentType + ( EnableComponentType(..) ) import Distribution.Verbosity as Verbosity ( normal ) import Distribution.Version @@ -526,7 +528,7 @@ installAction -- '--run-tests' implies '--enable-tests'. maybeForceTests installFlags' configFlags' = if fromFlagOrDefault False (installRunTests installFlags') - then configFlags' { configTests = toFlag True } + then configFlags' { configTests = toFlag EnableAll } else configFlags' testAction :: (BuildFlags, TestFlags) -> [String] -> GlobalFlags @@ -538,11 +540,12 @@ testAction (buildFlags, testFlags) extraArgs globalFlags = do let buildFlags' = buildFlags { buildVerbosity = testVerbosity testFlags } checkFlags = Check $ \_ flags@(configFlags, configExFlags) -> - if fromFlagOrDefault False (configTests configFlags) + if fromFlagOrDefault EnableWhenPossible (configTests configFlags) + == EnableAll then pure (mempty, flags) else do info verbosity "reconfiguring to enable tests" - let flags' = ( configFlags { configTests = toFlag True } + let flags' = ( configFlags { configTests = toFlag EnableAll } , configExFlags ) pure (Any True, flags') @@ -612,11 +615,12 @@ benchmarkAction { buildVerbosity = benchmarkVerbosity benchmarkFlags } let checkFlags = Check $ \_ flags@(configFlags, configExFlags) -> - if fromFlagOrDefault False (configBenchmarks configFlags) + if fromFlagOrDefault EnableWhenPossible (configBenchmarks configFlags) + == EnableAll then pure (mempty, flags) else do info verbosity "reconfiguring to enable benchmarks" - let flags' = ( configFlags { configBenchmarks = toFlag True } + let flags' = ( configFlags { configBenchmarks = toFlag EnableAll } , configExFlags ) pure (Any True, flags') diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 0e9965a918e..b14d9e02f41 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -113,6 +113,8 @@ import Distribution.Simple.GHC , renderGhcEnvironmentFile, readGhcEnvironmentFile, ParseErrorExc ) import Distribution.System ( Platform , buildOS, OS (Windows) ) +import Distribution.Types.EnableComponentType + ( EnableComponentType(..) ) import Distribution.Types.UnitId ( UnitId ) import Distribution.Types.UnqualComponentName @@ -408,10 +410,10 @@ verifyPreconditionsOrDie verbosity configFlags = do -- We never try to build tests/benchmarks for remote packages. -- So we set them as disabled by default and error if they are explicitly -- enabled. - when (configTests configFlags == Flag True) $ + when (configTests configFlags == Flag EnableAll) $ die' verbosity $ "--enable-tests was specified, but tests can't " ++ "be enabled in a remote package" - when (configBenchmarks configFlags == Flag True) $ + when (configBenchmarks configFlags == Flag EnableAll) $ die' verbosity $ "--enable-benchmarks was specified, but benchmarks can't " ++ "be enabled in a remote package" @@ -741,8 +743,8 @@ environmentFileToSpecifiers ipi = foldMap $ \case -- | Disables tests and benchmarks if they weren't explicitly enabled. disableTestsBenchsByDefault :: ConfigFlags -> ConfigFlags disableTestsBenchsByDefault configFlags = - configFlags { configTests = Flag False <> configTests configFlags - , configBenchmarks = Flag False <> configBenchmarks configFlags } + configFlags { configTests = Flag DisableAll <> configTests configFlags + , configBenchmarks = Flag DisableAll <> configBenchmarks configFlags } -- | Symlink/copy every exe from a package from the store to a given location installUnitExes diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index 17eb0c0550f..9687670d2e9 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -121,6 +121,7 @@ import Distribution.Verbosity import qualified Distribution.Compat.CharParsing as P import Distribution.Client.ProjectFlags (ProjectFlags (..)) import Distribution.Solver.Types.ConstraintSource +import Distribution.Types.EnableComponentType import qualified Text.PrettyPrint as Disp ( render, text, empty ) @@ -143,7 +144,7 @@ import qualified Data.Map as M import qualified Data.ByteString as BS -- --- * Configuration saved in the config file +-- * Configuration saved in the @~/.cabal/config@ file -- data SavedConfig = SavedConfig @@ -883,8 +884,14 @@ commentSavedConfig = do removeRootKeys :: RemoteRepo -> RemoteRepo removeRootKeys r = r { remoteRepoRootKeys = [] } --- | All config file fields. +-- | The parser and pretty-printer for the 'SavedConfig' fields are mostly +-- derived from the command-line options for the various commands (@cabal +-- configure@, @cabal install@, etc.). When the format in the configuration +-- file differs from the format in the command-line option, we define a +-- separate 'FieldDescr' here. -- +-- Fields which are valid in both a 'ProjectConfig' and a 'SavedConfig' also +-- need a separate 'FieldDescr' in 'legacyProjectConfigFieldDescrs'. configFieldDescriptions :: ConstraintSource -> [FieldDescr SavedConfig] configFieldDescriptions src = @@ -957,6 +964,12 @@ configFieldDescriptions src = caseWarning = PWarning $ "The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'.") + ,liftField configTests (\v flags -> flags { configTests = v }) $ + let name = "tests" in + FieldDescr name prettyPrintEnableStanza (parseEnableStanza name) + ,liftField configBenchmarks (\v flags -> flags { configBenchmarks = v }) $ + let name = "benchmarks" in + FieldDescr name prettyPrintEnableStanza (parseEnableStanza name) ] ++ toSavedConfig liftConfigExFlag @@ -1028,6 +1041,19 @@ configFieldDescriptions src = toRelaxDeps True = RelaxDepsAll toRelaxDeps False = mempty + prettyPrintEnableStanza NoFlag = Disp.text "EnableWhenPossible" + prettyPrintEnableStanza (Flag EnableWhenPossible) = Disp.text "EnableWhenPossible" + prettyPrintEnableStanza (Flag DisableAll) = Disp.text "DisableAll" + prettyPrintEnableStanza (Flag EnableAll) = Disp.text "EnableAll" + + parseEnableStanza name line str _ = case () of + _ | str == "EnableWhenPossible" -> ParseOk [] (Flag EnableWhenPossible) + | str == "DisableAll" -> ParseOk [] (Flag DisableAll) + | str == "False" -> ParseOk [] (Flag DisableAll) + | str == "EnableAll" -> ParseOk [] (Flag EnableAll) + | str == "True" -> ParseOk [] (Flag EnableAll) + | otherwise -> ParseFailed (NoParse name line) + -- TODO: next step, make the deprecated fields elicit a warning. -- diff --git a/cabal-install/src/Distribution/Client/Configure.hs b/cabal-install/src/Distribution/Client/Configure.hs index 788e2b48151..4c6c213c07f 100644 --- a/cabal-install/src/Distribution/Client/Configure.hs +++ b/cabal-install/src/Distribution/Client/Configure.hs @@ -63,6 +63,7 @@ import Distribution.Simple.PackageIndex as PackageIndex ( InstalledPackageIndex, lookupPackageName ) import Distribution.Package ( Package(..), packageName, PackageId ) +import Distribution.Types.EnableComponentType import Distribution.Types.GivenComponent ( GivenComponent(..) ) import Distribution.Types.PackageVersionConstraint @@ -312,10 +313,13 @@ planLocalPackage verbosity comp platform configFlags configExFlags } testsEnabled :: Bool - testsEnabled = fromFlagOrDefault False $ configTests configFlags + testsEnabled = fromFlagOrDefault EnableWhenPossible + (configTests configFlags) + == EnableAll benchmarksEnabled :: Bool - benchmarksEnabled = - fromFlagOrDefault False $ configBenchmarks configFlags + benchmarksEnabled = fromFlagOrDefault EnableWhenPossible + (configBenchmarks configFlags) + == EnableAll resolverParams :: DepResolverParams resolverParams = @@ -419,9 +423,11 @@ configurePackage verbosity platform comp scriptOptions configFlags -- NB: if the user explicitly specified -- --enable-tests/--enable-benchmarks, always respect it. -- (But if they didn't, let solver decide.) - configBenchmarks = toFlag (BenchStanzas `optStanzaSetMember` stanzas) + configBenchmarks = toFlag (if BenchStanzas `optStanzaSetMember` stanzas + then EnableAll else DisableAll) `mappend` configBenchmarks configFlags, - configTests = toFlag (TestStanzas `optStanzaSetMember` stanzas) + configTests = toFlag (if TestStanzas `optStanzaSetMember` stanzas + then EnableAll else DisableAll) `mappend` configTests configFlags } diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs index d099ec4dfff..67e354ab294 100644 --- a/cabal-install/src/Distribution/Client/Install.hs +++ b/cabal-install/src/Distribution/Client/Install.hs @@ -128,6 +128,8 @@ import Distribution.Package ( PackageIdentifier(..), PackageId, packageName, packageVersion , Package(..), HasMungedPackageId(..), HasUnitId(..) , UnitId ) +import Distribution.Types.EnableComponentType + ( EnableComponentType(..) ) import Distribution.Types.GivenComponent ( GivenComponent(..) ) import Distribution.Types.PackageVersionConstraint @@ -422,8 +424,12 @@ planPackages verbosity comp platform solver stanzas = [ TestStanzas | testsEnabled ] ++ [ BenchStanzas | benchmarksEnabled ] - testsEnabled = fromFlagOrDefault False $ configTests configFlags - benchmarksEnabled = fromFlagOrDefault False $ configBenchmarks configFlags + testsEnabled = fromFlagOrDefault EnableWhenPossible + (configTests configFlags) + == EnableAll + benchmarksEnabled = fromFlagOrDefault EnableWhenPossible + (configBenchmarks configFlags) + == EnableAll reinstall = fromFlag (installOverrideReinstall installFlags) || fromFlag (installReinstall installFlags) @@ -1193,8 +1199,9 @@ installReadyPackage platform cinfo configFlags <- CD.nonSetupDeps deps ], -- Use '--exact-configuration' if supported. configExactConfiguration = toFlag True, - configBenchmarks = toFlag False, - configTests = toFlag (TestStanzas `optStanzaSetMember` stanzas) + configBenchmarks = toFlag DisableAll, + configTests = toFlag (if TestStanzas `optStanzaSetMember` stanzas + then EnableAll else DisableAll) } source pkg pkgoverride where pkg = case finalizePD flags (enableStanzas stanzas) @@ -1413,7 +1420,7 @@ installUnpackedPackage verbosity installLock numJobs haddockVerbosity = toFlag verbosity', haddockDistPref = configDistPref configFlags } - testsEnabled = fromFlag (configTests configFlags) + testsEnabled = fromFlag (configTests configFlags) == EnableAll && fromFlagOrDefault False (installRunTests installFlags) testFlags' = filterTestFlags testFlags { Cabal.testDistPref = configDistPref configFlags diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 410d9531cea..0440720a970 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -49,7 +49,7 @@ import Distribution.Simple.Compiler ( OptimisationLevel(..), DebugInfoLevel(..) ) import Distribution.Simple.InstallDirs ( CopyDest (NoCopyDest) ) import Distribution.Simple.Setup - ( Flag(Flag), toFlag, fromFlagOrDefault + ( Flag(NoFlag, Flag), toFlag, fromFlagOrDefault , ConfigFlags(..), configureOptions , HaddockFlags(..), haddockOptions, defaultHaddockFlags , TestFlags(..), testOptions', defaultTestFlags @@ -84,7 +84,7 @@ import Distribution.Deprecated.ParseUtils ( ParseResult(..), PError(..), syntaxError, PWarning(..) , commaNewLineListFieldParsec, newLineListField, parseTokenQ , parseHaskellString, showToken - , simpleFieldParsec + , simpleField, simpleFieldParsec ) import Distribution.Client.ParseUtils import Distribution.Simple.Command @@ -92,6 +92,7 @@ import Distribution.Simple.Command , OptionField, option, reqArg' ) import Distribution.Types.PackageVersionConstraint ( PackageVersionConstraint ) +import Distribution.Types.EnableComponentType import Distribution.Parsec (ParsecParser) import qualified Data.Map as Map @@ -103,14 +104,8 @@ import Network.URI (URI (..)) -- Representing the project config file in terms of legacy types -- --- | We already have parsers\/pretty-printers for almost all the fields in the --- project config file, but they're in terms of the types used for the command --- line flags for Setup.hs or cabal commands. We don't want to redefine them --- all, at least not yet so for the moment we use the parsers at the old types --- and use conversion functions. --- --- Ultimately if\/when this project-based approach becomes the default then we --- can redefine the parsers directly for the new types. +-- | Used when parsing and pretty-printing 'ProjectConfig', as it was easier to +-- write two way conversions than to implement a new parser and pretty-printer. -- data LegacyProjectConfig = LegacyProjectConfig { legacyPackages :: [String], @@ -171,8 +166,8 @@ instance Semigroup LegacySharedConfig where -- line into a 'ProjectConfig' value that can combined with configuration from -- other sources. -- --- At the moment this uses the legacy command line flag types. See --- 'LegacyProjectConfig' for an explanation. +-- TODO: why is this in the Legacy module? There's nothing "legacy" about these +-- "convertLegacy*" functions as far as I can tell. -- commandLineFlagsToProjectConfig :: GlobalFlags -> NixStyleFlags a @@ -272,8 +267,7 @@ convertLegacyGlobalConfig -- | Convert the project config from the legacy types to the 'ProjectConfig' --- and associated types. See 'LegacyProjectConfig' for an explanation of the --- approach. +-- and associated types. -- convertLegacyProjectConfig :: LegacyProjectConfig -> ProjectConfig convertLegacyProjectConfig @@ -875,6 +869,14 @@ showLegacyProjectConfig config = constraintSrc = ConstraintSourceProjectConfig "unused" +-- | The parser and pretty-printer for the 'LegacyProjectConfig' (and thus +-- 'ProjectConfig') fields are mostly derived from the command-line options for +-- the various commands (@cabal configure@, @cabal install@, etc.). When the +-- format in the configuration file differs from the format in the command-line +-- option, we define a separate 'FieldDescr' here. +-- +-- Fields which are valid in both a 'ProjectConfig' and a 'SavedConfig' also +-- need a separate 'FieldDescr' in 'configFieldDescriptions'. legacyProjectConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacyProjectConfig] legacyProjectConfigFieldDescrs constraintSrc = @@ -1078,6 +1080,14 @@ legacyPackageConfigFieldDescrs = showTokenQ parseTokenQ configConfigureArgs (\v conf -> conf { configConfigureArgs = v }) + , simpleField "tests" + prettyPrintEnableStanza parseEnableStanza + configTests + (\v conf -> conf { configTests = v }) + , simpleField "benchmarks" + prettyPrintEnableStanza parseEnableStanza + configBenchmarks + (\v conf -> conf { configBenchmarks = v }) , simpleFieldParsec "flags" dispFlagAssignment parsecFlagAssignment configConfigurationsFlags @@ -1093,7 +1103,6 @@ legacyPackageConfigFieldDescrs = , "profiling-detail", "library-profiling-detail" , "library-for-ghci", "split-objs", "split-sections" , "executable-stripping", "library-stripping" - , "tests", "benchmarks" , "coverage", "library-coverage" , "relocatable" -- not "extra-include-dirs", "extra-lib-dirs", "extra-framework-dirs" @@ -1254,6 +1263,17 @@ legacyPackageConfigFieldDescrs = prefixTest name | "test-" `isPrefixOf` name = name | otherwise = "test-" ++ name + prettyPrintEnableStanza v = case v of + NoFlag -> Disp.text "EnableWhenPossible" + Flag EnableWhenPossible -> Disp.text "EnableWhenPossible" + Flag EnableAll -> Disp.text "EnableAll" + Flag DisableAll -> Disp.text "DisableAll" + + parseEnableStanza + = (Flag EnableWhenPossible <$ Parse.string "EnableWhenPossible") + <|> (Flag EnableAll <$ (Parse.string "EnableAll" <|> Parse.string "True")) + <|> (Flag DisableAll <$ (Parse.string "DisableAll" <|> Parse.string "False")) + legacyPackageConfigFGSectionDescrs :: ( FieldGrammar c g, Applicative (g SourceRepoList) diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs index 84996b2a0cf..b2027dfcc38 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs @@ -47,6 +47,8 @@ import Distribution.Solver.Types.ConstraintSource import Distribution.Package ( PackageName, PackageId, UnitId ) +import Distribution.Types.EnableComponentType + ( EnableComponentType(..) ) import Distribution.Types.PackageVersionConstraint ( PackageVersionConstraint ) import Distribution.Version @@ -265,8 +267,8 @@ data PackageConfig packageConfigSplitObjs :: Flag Bool, packageConfigStripExes :: Flag Bool, packageConfigStripLibs :: Flag Bool, - packageConfigTests :: Flag Bool, - packageConfigBenchmarks :: Flag Bool, + packageConfigTests :: Flag EnableComponentType, + packageConfigBenchmarks :: Flag EnableComponentType, packageConfigCoverage :: Flag Bool, packageConfigRelocatable :: Flag Bool, packageConfigDebugInfo :: Flag DebugInfoLevel, diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 906f56d222b..9efc2ec5da3 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -120,6 +120,7 @@ import Distribution.Types.AnnotatedId import Distribution.Types.ComponentName import Distribution.Types.DumpBuildInfo ( DumpBuildInfo (..) ) +import Distribution.Types.EnableComponentType import Distribution.Types.LibraryName import Distribution.Types.GivenComponent (GivenComponent(..)) @@ -619,9 +620,9 @@ rebuildInstallPlan verbosity isLocal = isJust (shouldBeLocal pkg) stanzas | isLocal = Map.fromList $ - [ (TestStanzas, enabled) + [ (TestStanzas, enabled == EnableAll) | enabled <- flagToList testsEnabled ] ++ - [ (BenchStanzas , enabled) + [ (BenchStanzas , enabled == EnableAll) | enabled <- flagToList benchmarksEnabled ] | otherwise = Map.fromList [(TestStanzas, False), (BenchStanzas, False) ] ] @@ -1818,8 +1819,8 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB BenchStanzas -> listToMaybe [ v | v <- maybeToList benchmarks, _ <- PD.benchmarks elabPkgDescription ] where tests, benchmarks :: Maybe Bool - tests = perPkgOptionMaybe pkgid packageConfigTests - benchmarks = perPkgOptionMaybe pkgid packageConfigBenchmarks + tests = enableComponentTypeToRequest $ perPkgOptionFlag pkgid EnableWhenPossible packageConfigTests + benchmarks = enableComponentTypeToRequest $ perPkgOptionFlag pkgid EnableWhenPossible packageConfigBenchmarks -- This is a placeholder which will get updated by 'pruneInstallPlanPass1' -- and 'pruneInstallPlanPass2'. We can't populate it here @@ -2599,9 +2600,13 @@ availableSourceTargets elab = | otherwise -> TargetBuildable (elabUnitId elab, cname) TargetRequestedByDefault - -- it is not an optional stanza, so a testsuite or benchmark + -- it is an optional stanza, so a testsuite or benchmark. + -- + -- TODO: once 'elabStanzasRequested' has been upgraded to an + -- ADT with three cases (see TODO note for 'elabStanzasRequested'), + -- use those to pick a better failure cause here. Just stanza -> - case (optStanzaLookup stanza (elabStanzasRequested elab), -- TODO + case (optStanzaLookup stanza (elabStanzasRequested elab), optStanzaSetMember stanza (elabStanzasAvailable elab)) of _ | not withinPlan -> TargetNotLocal (Just False, _) -> TargetDisabledByUser @@ -3558,10 +3563,12 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..}) configPackageDBs = Nothing : map Just elabBuildPackageDBStack configTests = case elabPkgOrComp of - ElabPackage pkg -> toFlag (TestStanzas `optStanzaSetMember` pkgStanzasEnabled pkg) + ElabPackage pkg -> toFlag (if TestStanzas `optStanzaSetMember` pkgStanzasEnabled pkg + then EnableAll else DisableAll) ElabComponent _ -> mempty configBenchmarks = case elabPkgOrComp of - ElabPackage pkg -> toFlag (BenchStanzas `optStanzaSetMember` pkgStanzasEnabled pkg) + ElabPackage pkg -> toFlag (if BenchStanzas `optStanzaSetMember` pkgStanzasEnabled pkg + then EnableAll else DisableAll) ElabComponent _ -> mempty configExactConfiguration = toFlag True diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 4ca346930ed..74196bbe24d 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -36,6 +36,8 @@ import Distribution.Solver.Types.ConstraintSource ( ConstraintSource(ConstraintSourceUnknown) ) import Distribution.Solver.Types.PackageConstraint ( PackageProperty(PackagePropertySource) ) +import Distribution.Types.EnableComponentType + ( EnableComponentType(..) ) import qualified Distribution.Client.CmdBuild as CmdBuild import qualified Distribution.Client.CmdRepl as CmdRepl @@ -638,7 +640,7 @@ testTargetProblemsCommon config0 = do testdir = "targets/complex" config = config0 { projectConfigLocalPackages = (projectConfigLocalPackages config0) { - packageConfigBenchmarks = toFlag False + packageConfigBenchmarks = toFlag DisableAll } , projectConfigShared = (projectConfigShared config0) { projectConfigConstraints = @@ -664,7 +666,7 @@ testTargetProblemsBuild config reportSubCase = do "targets/all-disabled" config { projectConfigLocalPackages = (projectConfigLocalPackages config) { - packageConfigBenchmarks = toFlag False + packageConfigBenchmarks = toFlag DisableAll } } CmdBuild.selectPackageTargets @@ -687,8 +689,8 @@ testTargetProblemsBuild config reportSubCase = do -- whole package selects those component kinds too do (_,elaboratedPlan,_) <- planProject "targets/variety" config { projectConfigLocalPackages = (projectConfigLocalPackages config) { - packageConfigTests = toFlag True, - packageConfigBenchmarks = toFlag True + packageConfigTests = toFlag EnableAll, + packageConfigBenchmarks = toFlag EnableAll } } assertProjectDistinctTargets @@ -708,8 +710,8 @@ testTargetProblemsBuild config reportSubCase = do -- whole package only selects the library, foreign lib and exes do (_,elaboratedPlan,_) <- planProject "targets/variety" config { projectConfigLocalPackages = (projectConfigLocalPackages config) { - packageConfigTests = toFlag False, - packageConfigBenchmarks = toFlag False + packageConfigTests = toFlag DisableAll, + packageConfigBenchmarks = toFlag DisableAll } } assertProjectDistinctTargets @@ -928,7 +930,7 @@ testTargetProblemsTest config reportSubCase = do "targets/tests-disabled" config { projectConfigLocalPackages = (projectConfigLocalPackages config) { - packageConfigTests = toFlag False + packageConfigTests = toFlag DisableAll } } CmdTest.selectPackageTargets @@ -1030,7 +1032,7 @@ testTargetProblemsBench config reportSubCase = do "targets/benchmarks-disabled" config { projectConfigLocalPackages = (projectConfigLocalPackages config) { - packageConfigBenchmarks = toFlag False + packageConfigBenchmarks = toFlag DisableAll } } CmdBench.selectPackageTargets diff --git a/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs index f8247f2ee03..315b22db304 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs @@ -20,6 +20,8 @@ import Distribution.Client.Types import Distribution.Client.Types.OverwritePolicy (OverwritePolicy) import Distribution.Client.Types.SourceRepo (SourceRepositoryPackage) +import Distribution.Types.EnableComponentType + import Data.TreeDiff.Class import Data.TreeDiff.Instances.Cabal () import Network.URI @@ -39,6 +41,7 @@ instance ToExpr ClientInstallFlags instance ToExpr CombineStrategy instance ToExpr ConstraintSource instance ToExpr CountConflicts +instance ToExpr EnableComponentType instance ToExpr FineGrainedConflicts instance ToExpr IndependentGoals instance ToExpr InstallMethod diff --git a/cabal-install/tests/UnitTests/Distribution/Client/UserConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/UserConfig.hs index 3bb92121f62..103e5baf7a4 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/UserConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/UserConfig.hs @@ -22,6 +22,7 @@ import Distribution.Client.Setup (GlobalFlags (..), InstallFlags (..)) import Distribution.Client.Utils (removeExistingFile) import Distribution.Simple.Setup (Flag (..), ConfigFlags (..), fromFlag) import Distribution.Simple.Utils (withTempDirectory) +import Distribution.Types.EnableComponentType (EnableComponentType(..)) import Distribution.Verbosity (silent) tests :: [TestTree] @@ -59,7 +60,7 @@ canUpdateConfig = bracketTest $ \configFile -> do userConfigUpdate silent (globalFlags configFile) [] -- Load it again. updated <- loadConfig silent (Flag configFile) - assertBool ("Field 'tests' should be True") $ + assertEqual ("Field 'tests' should be EnableAll") EnableAll $ fromFlag (configTests $ savedConfigureFlags updated) diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/cabal.out new file mode 100644 index 00000000000..e9599e9f3b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/cabal.out @@ -0,0 +1,25 @@ +# cabal v2-test +Resolving dependencies... +Error: cabal: Could not resolve dependencies: +[__0] trying: package-with-unbuildable-test-1.0 (user goal) +[__1] trying: package-with-unbuildable-test:*test +[__2] next goal: base (dependency of package-with-unbuildable-test *test) +[__2] rejecting: base-/installed- (conflict: package-with-unbuildable-test *test => base<1 && >1) +[__2] fail (backjumping, conflict set: base, package-with-unbuildable-test, package-with-unbuildable-test:test) +After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: package-with-unbuildable-test (4), package-with-unbuildable-test:test (4), base (2) +# cabal v2-test +Resolving dependencies... +Error: cabal: Cannot test all the packages in the project because none of the components are available to build: the test suite 'buildable-test' and the test suite 'unbuildable-test' are not available because building test suites has been disabled in the configuration +# cabal v2-test +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - package-with-buildable-test-1.0 (test:buildable-test) (first run) +Configuring test suite 'buildable-test' for package-with-buildable-test-1.0.. +Preprocessing test suite 'buildable-test' for package-with-buildable-test-1.0.. +Building test suite 'buildable-test' for package-with-buildable-test-1.0.. +Running 1 test suites... +Test suite buildable-test: RUNNING... +Test suite buildable-test: PASS +Test suite logged to: /cabal.dist/work/./dist/build//ghc-/package-with-buildable-test-1.0/t/buildable-test/test/package-with-buildable-test-1.0-buildable-test.log +1 of 1 test suites (1 of 1 test cases) passed. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/cabal.project b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/cabal.project new file mode 100644 index 00000000000..f04217087e2 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/cabal.project @@ -0,0 +1 @@ +packages: package-with-buildable-test package-with-unbuildable-test diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/cabal.test.hs new file mode 100644 index 00000000000..4c23a2bb19a --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/cabal.test.hs @@ -0,0 +1,23 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + -- "--enable-tests" and "--disable-tests" are not the only two + -- possibilities, they are only the two extremes: build _all_ the tests, + -- and build _none_ of the tests. + -- + -- The default, "--enable-tests-when-possible", is to only build the tests + -- for which a build plan can be found, and to silently ignore the tests + -- for which a build plan cannot be found. + + -- This project has two package; one with a buildable test, and one with an + -- unbuildable test. If we request both tests to be built and run, then + -- "cabal test" command should fail because of the unbuildable test. + fails $ cabal "v2-test" ["--enable-tests", "all"] + + -- If we request zero tests to be built, then "cabal test" should fail + -- because there are no tests to run. + fails $ cabal "v2-test" ["--disable-tests", "all"] + + -- If we request the buildable tests to be built and run, then "cabal test" + -- should successfully build one test. + cabal "v2-test" ["--enable-tests-when-possible", "all"] diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/package-with-buildable-test/BuildableTest.hs b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/package-with-buildable-test/BuildableTest.hs new file mode 100644 index 00000000000..89ad4b3e08f --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/package-with-buildable-test/BuildableTest.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = pure () diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/package-with-buildable-test/package-with-buildable-test.cabal b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/package-with-buildable-test/package-with-buildable-test.cabal new file mode 100644 index 00000000000..65f9f2010fc --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/package-with-buildable-test/package-with-buildable-test.cabal @@ -0,0 +1,10 @@ +name: package-with-buildable-test +version: 1.0 +build-type: Simple +cabal-version: >= 1.10 + +test-suite buildable-test + type: exitcode-stdio-1.0 + main-is: BuildableTest.hs + build-depends: base + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/package-with-unbuildable-test/UnbuildableTest.hs b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/package-with-unbuildable-test/UnbuildableTest.hs new file mode 100644 index 00000000000..89ad4b3e08f --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/package-with-unbuildable-test/UnbuildableTest.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = pure () diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/package-with-unbuildable-test/package-with-unbuildable-test.cabal b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/package-with-unbuildable-test/package-with-unbuildable-test.cabal new file mode 100644 index 00000000000..a80bdf50f9f --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdTest/OnlyBuildableTests/package-with-unbuildable-test/package-with-unbuildable-test.cabal @@ -0,0 +1,10 @@ +name: package-with-unbuildable-test +version: 1.0 +build-type: Simple +cabal-version: >= 1.10 + +test-suite unbuildable-test + type: exitcode-stdio-1.0 + main-is: UnbuildableTest.hs + build-depends: base < 1 && > 1 + default-language: Haskell2010