diff --git a/cabal-install/Distribution/Client/CmdTest.hs b/cabal-install/Distribution/Client/CmdTest.hs new file mode 100644 index 00000000000..15810911f3c --- /dev/null +++ b/cabal-install/Distribution/Client/CmdTest.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE NamedFieldPuns #-} + +-- | cabal-install CLI command: new-test +-- +module Distribution.Client.CmdTest ( + testCommand, + testAction, + ) where + +import Distribution.Client.ProjectOrchestration +import Distribution.Client.ProjectPlanning + ( PackageTarget(..) ) +import Distribution.Client.BuildTarget + ( readUserBuildTargets ) + +import Distribution.Client.Setup + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) +import Distribution.Simple.Setup + ( HaddockFlags, fromFlagOrDefault ) +import Distribution.Verbosity + ( normal ) + +import Distribution.Simple.Command + ( CommandUI(..), usageAlternatives ) +import Distribution.Simple.Utils + ( wrapText ) +import qualified Distribution.Client.Setup as Client + +testCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +testCommand = Client.installCommand { + commandName = "new-test", + commandSynopsis = "Perform new-build and run tests", + commandUsage = usageAlternatives "new-test" [ "[FLAGS] TARGET" ], + commandDescription = Just $ \_ -> wrapText $ + "Build and run test targets", + commandNotes = Just $ \_pname -> + "Examples:\n" + } + +-- | The @test@ command is very much like @build@. It brings the install plan +-- up to date, selects that part of the plan needed by the given or implicit +-- test arget(s) and then executes the plan. +-- +-- Compared to @build@ the difference is that there's also test targets +-- which are ephemeral. +-- +-- For more details on how this works, see the module +-- "Distribution.Client.ProjectOrchestration" +-- +testAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) + -> [String] -> GlobalFlags -> IO () +testAction (configFlags, configExFlags, installFlags, haddockFlags) + targetStrings globalFlags = do + + userTargets <- readUserBuildTargets targetStrings + + buildCtx <- + runProjectPreBuildPhase + verbosity + ( globalFlags, configFlags, configExFlags + , installFlags, haddockFlags ) + PreBuildHooks { + hookPrePlanning = \_ _ _ -> return (), + + hookSelectPlanSubset = \_buildSettings elaboratedPlan -> + -- Interpret the targets on the command line as test targets + -- (as opposed to say build or haddock targets). + selectTargets + verbosity + TestDefaultComponents + TestSpecificComponent + userTargets + False -- onlyDependencies, always False for test + elaboratedPlan + } + + printPlan verbosity buildCtx + + buildOutcomes <- runProjectBuildPhase verbosity buildCtx + runProjectPostBuildPhase verbosity buildCtx buildOutcomes + where + verbosity = fromFlagOrDefault normal (configVerbosity configFlags) + diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index 0f69935958f..8733dbe8ee1 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -352,7 +352,8 @@ packageFileMonitorKeyValues elab = -- elab_config = elab { - elabBuildTargets = [], + elabBuildTargets = [], + elabTestTargets = [], elabReplTarget = Nothing, elabBuildHaddocks = False } @@ -1099,6 +1100,10 @@ buildInplaceUnpackedPackage verbosity updatePackageRegFileMonitor packageFileMonitor srcdir mipkg + whenTest $ do + annotateFailureNoLog TestsFailed $ + setup testCommand testFlags testArgs + -- Repl phase -- whenRepl $ @@ -1130,6 +1135,10 @@ buildInplaceUnpackedPackage verbosity whenRebuild action | null (elabBuildTargets pkg) = return () + | otherwise = action + + whenTest action + | null (elabTestTargets pkg) = return () | otherwise = action whenRepl action @@ -1159,6 +1168,11 @@ buildInplaceUnpackedPackage verbosity verbosity builddir buildArgs = setupHsBuildArgs pkg + testCommand = Cabal.testCommand -- defaultProgramDb + testFlags _ = setupHsTestFlags pkg pkgshared + verbosity builddir + testArgs = setupHsTestArgs pkg + replCommand = Cabal.replCommand defaultProgramDb replFlags _ = setupHsReplFlags pkg pkgshared verbosity builddir diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 62b4b828aed..63c3113b83a 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -41,6 +41,8 @@ module Distribution.Client.ProjectPlanning ( setupHsBuildArgs, setupHsReplFlags, setupHsReplArgs, + setupHsTestFlags, + setupHsTestArgs, setupHsCopyFlags, setupHsRegisterFlags, setupHsHaddockFlags, @@ -1590,6 +1592,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB -- we haven't improved the plan yet), so we do it in another pass. -- Check the comments of those functions for more details. elabBuildTargets = [] + elabTestTargets = [] elabReplTarget = Nothing elabBuildHaddocks = False @@ -1919,12 +1922,19 @@ instantiateInstallPlan plan = --TODO: this needs to report some user target/config errors elaboratePackageTargets :: ElaboratedConfiguredPackage -> [PackageTarget] - -> ([ComponentTarget], Maybe ComponentTarget, Bool) + -> ([ComponentTarget], [ComponentTarget], Maybe ComponentTarget, Bool) elaboratePackageTargets ElaboratedConfiguredPackage{..} targets = let buildTargets = nubComponentTargets . map compatSubComponentTargets . concatMap elaborateBuildTarget $ targets + + testTargets = nubComponentTargets + . filter isTestComponentTarget + . map compatSubComponentTargets + . concatMap elaborateTestTarget + $ targets + --TODO: instead of listToMaybe we should be reporting an error here replTargets = listToMaybe . nubComponentTargets @@ -1933,13 +1943,21 @@ elaboratePackageTargets ElaboratedConfiguredPackage{..} targets = $ targets buildHaddocks = HaddockDefaultComponents `elem` targets - in (buildTargets, replTargets, buildHaddocks) + in (buildTargets, testTargets, replTargets, buildHaddocks) where --TODO: need to report an error here if defaultComponents is empty elaborateBuildTarget BuildDefaultComponents = pkgDefaultComponents elaborateBuildTarget (BuildSpecificComponent t) = [t] + -- TODO: We need to build test components as well + -- should this be configurable, i.e. to /just/ run, not try to build + elaborateBuildTarget TestDefaultComponents = pkgDefaultComponents + elaborateBuildTarget (TestSpecificComponent t) = [t] elaborateBuildTarget _ = [] + elaborateTestTarget TestDefaultComponents = pkgDefaultComponents + elaborateTestTarget (TestSpecificComponent t) = [t] + elaborateTestTarget _ = [] + --TODO: need to report an error here if defaultComponents is empty elaborateReplTarget ReplDefaultComponent = take 1 pkgDefaultComponents elaborateReplTarget (ReplSpecificComponent t) = [t] @@ -1991,6 +2009,7 @@ elaboratePackageTargets ElaboratedConfiguredPackage{..} targets = pkgHasEphemeralBuildTargets :: ElaboratedConfiguredPackage -> Bool pkgHasEphemeralBuildTargets elab = isJust (elabReplTarget elab) + || (not . null) (elabTestTargets elab) || (not . null) [ () | ComponentTarget _ subtarget <- elabBuildTargets elab , subtarget /= WholeComponent ] @@ -2075,6 +2094,7 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = roots = mapMaybe find_root pkgs' find_root (InstallPlan.Configured (PrunedPackage elab _)) = if not (null (elabBuildTargets elab) + && null (elabTestTargets elab) && isNothing (elabReplTarget elab) && not (elabBuildHaddocks elab)) then Just (installedUnitId elab) @@ -2088,11 +2108,12 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = setElabBuildTargets elab = elab { elabBuildTargets = mapMaybe targetForElab buildTargets, + elabTestTargets = mapMaybe targetForElab testTargets, elabReplTarget = replTarget >>= targetForElab, elabBuildHaddocks = buildHaddocks } where - (buildTargets, replTarget, buildHaddocks) + (buildTargets, testTargets, replTarget, buildHaddocks) = elaboratePackageTargets elab targets targets = fromMaybe [] $ Map.lookup (installedUnitId elab) perPkgTargetsMap @@ -2155,6 +2176,7 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = Set.fromList [ stanza | ComponentTarget cname _ <- elabBuildTargets pkg + ++ elabTestTargets pkg ++ maybeToList (elabReplTarget pkg) , stanza <- maybeToList (componentOptionalStanza cname) ] @@ -2782,6 +2804,26 @@ setupHsBuildArgs (ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent _ = [] +setupHsTestFlags :: ElaboratedConfiguredPackage + -> ElaboratedSharedConfig + -> Verbosity + -> FilePath + -> Cabal.TestFlags +setupHsTestFlags _ _ verbosity builddir = Cabal.TestFlags + { testDistPref = toFlag builddir + , testVerbosity = toFlag verbosity + , testMachineLog = mempty + , testHumanLog = mempty + , testShowDetails = toFlag Cabal.Always + , testKeepTix = mempty + , testOptions = mempty + } + +setupHsTestArgs :: ElaboratedConfiguredPackage -> [String] +-- TODO: Does the issue #3335 affects test as well +setupHsTestArgs elab = + mapMaybe (showTestComponentTarget (packageId elab)) (elabTestTargets elab) + setupHsReplFlags :: ElaboratedConfiguredPackage -> ElaboratedSharedConfig -> Verbosity diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index 5da01597e8f..1c572e41ffe 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -40,8 +40,11 @@ module Distribution.Client.ProjectPlanning.Types ( PackageTarget(..), ComponentTarget(..), showComponentTarget, + showTestComponentTarget, SubComponentTarget(..), + isTestComponentTarget, + -- * Setup script SetupScriptStyle(..), ) where @@ -272,6 +275,7 @@ data ElaboratedConfiguredPackage -- Build time related: elabBuildTargets :: [ComponentTarget], + elabTestTargets :: [ComponentTarget], elabReplTarget :: Maybe ComponentTarget, elabBuildHaddocks :: Bool, @@ -581,6 +585,8 @@ data PackageTarget = | BuildSpecificComponent ComponentTarget | ReplDefaultComponent | ReplSpecificComponent ComponentTarget + | TestDefaultComponents + | TestSpecificComponent ComponentTarget | HaddockDefaultComponents deriving (Eq, Show, Generic) @@ -609,7 +615,13 @@ showComponentTarget pkgid = ModuleTarget mname -> Cabal.BuildTargetModule cname mname FileTarget fname -> Cabal.BuildTargetFile cname fname +showTestComponentTarget :: PackageId -> ComponentTarget -> Maybe String +showTestComponentTarget _ (ComponentTarget (CTestName n) _) = Just $ display n +showTestComponentTarget _ _ = Nothing +isTestComponentTarget :: ComponentTarget -> Bool +isTestComponentTarget (ComponentTarget (CTestName _) _) = True +isTestComponentTarget _ = False --------------------------- -- Setup.hs script policy diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index 67080d003fa..dce0716e8e5 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -74,11 +74,12 @@ import Distribution.Client.Targets import qualified Distribution.Client.List as List ( list, info ) -import qualified Distribution.Client.CmdConfigure as CmdConfigure import qualified Distribution.Client.CmdBuild as CmdBuild -import qualified Distribution.Client.CmdRepl as CmdRepl +import qualified Distribution.Client.CmdConfigure as CmdConfigure import qualified Distribution.Client.CmdFreeze as CmdFreeze import qualified Distribution.Client.CmdHaddock as CmdHaddock +import qualified Distribution.Client.CmdRepl as CmdRepl +import qualified Distribution.Client.CmdTest as CmdTest import Distribution.Client.Install (install) import Distribution.Client.Configure (configure, writeConfigFlags) @@ -284,6 +285,7 @@ mainWorker args = topHandler $ , regularCmd CmdConfigure.configureCommand CmdConfigure.configureAction , regularCmd CmdBuild.buildCommand CmdBuild.buildAction , regularCmd CmdRepl.replCommand CmdRepl.replAction + , hiddenCmd CmdTest.testCommand CmdTest.testAction , regularCmd CmdFreeze.freezeCommand CmdFreeze.freezeAction , regularCmd CmdHaddock.haddockCommand CmdHaddock.haddockAction ] diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index e3ddc05ceec..e34aee666c7 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -213,6 +213,7 @@ executable cabal Distribution.Client.CmdConfigure Distribution.Client.CmdFreeze Distribution.Client.CmdHaddock + Distribution.Client.CmdTest Distribution.Client.CmdRepl Distribution.Client.Config Distribution.Client.Configure diff --git a/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.project b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.test.hs b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.test.hs new file mode 100644 index 00000000000..d121d82d034 --- /dev/null +++ b/cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.test.hs @@ -0,0 +1,4 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + cabal "new-test" []