Skip to content

Commit 4d08a8a

Browse files
authored
Merge pull request #4244 from haskell/new-test
WIP: new-test
2 parents eda30d3 + d383ba8 commit 4d08a8a

File tree

8 files changed

+165
-6
lines changed

8 files changed

+165
-6
lines changed
Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
{-# LANGUAGE NamedFieldPuns #-}
2+
3+
-- | cabal-install CLI command: new-test
4+
--
5+
module Distribution.Client.CmdTest (
6+
testCommand,
7+
testAction,
8+
) where
9+
10+
import Distribution.Client.ProjectOrchestration
11+
import Distribution.Client.ProjectPlanning
12+
( PackageTarget(..) )
13+
import Distribution.Client.BuildTarget
14+
( readUserBuildTargets )
15+
16+
import Distribution.Client.Setup
17+
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
18+
import Distribution.Simple.Setup
19+
( HaddockFlags, fromFlagOrDefault )
20+
import Distribution.Verbosity
21+
( normal )
22+
23+
import Distribution.Simple.Command
24+
( CommandUI(..), usageAlternatives )
25+
import Distribution.Simple.Utils
26+
( wrapText )
27+
import qualified Distribution.Client.Setup as Client
28+
29+
testCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
30+
testCommand = Client.installCommand {
31+
commandName = "new-test",
32+
commandSynopsis = "Perform new-build and run tests",
33+
commandUsage = usageAlternatives "new-test" [ "[FLAGS] TARGET" ],
34+
commandDescription = Just $ \_ -> wrapText $
35+
"Build and run test targets",
36+
commandNotes = Just $ \_pname ->
37+
"Examples:\n"
38+
}
39+
40+
-- | The @test@ command is very much like @build@. It brings the install plan
41+
-- up to date, selects that part of the plan needed by the given or implicit
42+
-- test arget(s) and then executes the plan.
43+
--
44+
-- Compared to @build@ the difference is that there's also test targets
45+
-- which are ephemeral.
46+
--
47+
-- For more details on how this works, see the module
48+
-- "Distribution.Client.ProjectOrchestration"
49+
--
50+
testAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
51+
-> [String] -> GlobalFlags -> IO ()
52+
testAction (configFlags, configExFlags, installFlags, haddockFlags)
53+
targetStrings globalFlags = do
54+
55+
userTargets <- readUserBuildTargets targetStrings
56+
57+
buildCtx <-
58+
runProjectPreBuildPhase
59+
verbosity
60+
( globalFlags, configFlags, configExFlags
61+
, installFlags, haddockFlags )
62+
PreBuildHooks {
63+
hookPrePlanning = \_ _ _ -> return (),
64+
65+
hookSelectPlanSubset = \_buildSettings elaboratedPlan ->
66+
-- Interpret the targets on the command line as test targets
67+
-- (as opposed to say build or haddock targets).
68+
selectTargets
69+
verbosity
70+
TestDefaultComponents
71+
TestSpecificComponent
72+
userTargets
73+
False -- onlyDependencies, always False for test
74+
elaboratedPlan
75+
}
76+
77+
printPlan verbosity buildCtx
78+
79+
buildOutcomes <- runProjectBuildPhase verbosity buildCtx
80+
runProjectPostBuildPhase verbosity buildCtx buildOutcomes
81+
where
82+
verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
83+

cabal-install/Distribution/Client/ProjectBuilding.hs

Lines changed: 15 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -352,7 +352,8 @@ packageFileMonitorKeyValues elab =
352352
--
353353
elab_config =
354354
elab {
355-
elabBuildTargets = [],
355+
elabBuildTargets = [],
356+
elabTestTargets = [],
356357
elabReplTarget = Nothing,
357358
elabBuildHaddocks = False
358359
}
@@ -1099,6 +1100,10 @@ buildInplaceUnpackedPackage verbosity
10991100

11001101
updatePackageRegFileMonitor packageFileMonitor srcdir mipkg
11011102

1103+
whenTest $ do
1104+
annotateFailureNoLog TestsFailed $
1105+
setup testCommand testFlags testArgs
1106+
11021107
-- Repl phase
11031108
--
11041109
whenRepl $
@@ -1130,6 +1135,10 @@ buildInplaceUnpackedPackage verbosity
11301135

11311136
whenRebuild action
11321137
| null (elabBuildTargets pkg) = return ()
1138+
| otherwise = action
1139+
1140+
whenTest action
1141+
| null (elabTestTargets pkg) = return ()
11331142
| otherwise = action
11341143

11351144
whenRepl action
@@ -1159,6 +1168,11 @@ buildInplaceUnpackedPackage verbosity
11591168
verbosity builddir
11601169
buildArgs = setupHsBuildArgs pkg
11611170

1171+
testCommand = Cabal.testCommand -- defaultProgramDb
1172+
testFlags _ = setupHsTestFlags pkg pkgshared
1173+
verbosity builddir
1174+
testArgs = setupHsTestArgs pkg
1175+
11621176
replCommand = Cabal.replCommand defaultProgramDb
11631177
replFlags _ = setupHsReplFlags pkg pkgshared
11641178
verbosity builddir

cabal-install/Distribution/Client/ProjectPlanning.hs

Lines changed: 45 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,8 @@ module Distribution.Client.ProjectPlanning (
4141
setupHsBuildArgs,
4242
setupHsReplFlags,
4343
setupHsReplArgs,
44+
setupHsTestFlags,
45+
setupHsTestArgs,
4446
setupHsCopyFlags,
4547
setupHsRegisterFlags,
4648
setupHsHaddockFlags,
@@ -1590,6 +1592,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
15901592
-- we haven't improved the plan yet), so we do it in another pass.
15911593
-- Check the comments of those functions for more details.
15921594
elabBuildTargets = []
1595+
elabTestTargets = []
15931596
elabReplTarget = Nothing
15941597
elabBuildHaddocks = False
15951598

@@ -1919,12 +1922,19 @@ instantiateInstallPlan plan =
19191922

19201923
--TODO: this needs to report some user target/config errors
19211924
elaboratePackageTargets :: ElaboratedConfiguredPackage -> [PackageTarget]
1922-
-> ([ComponentTarget], Maybe ComponentTarget, Bool)
1925+
-> ([ComponentTarget], [ComponentTarget], Maybe ComponentTarget, Bool)
19231926
elaboratePackageTargets ElaboratedConfiguredPackage{..} targets =
19241927
let buildTargets = nubComponentTargets
19251928
. map compatSubComponentTargets
19261929
. concatMap elaborateBuildTarget
19271930
$ targets
1931+
1932+
testTargets = nubComponentTargets
1933+
. filter isTestComponentTarget
1934+
. map compatSubComponentTargets
1935+
. concatMap elaborateTestTarget
1936+
$ targets
1937+
19281938
--TODO: instead of listToMaybe we should be reporting an error here
19291939
replTargets = listToMaybe
19301940
. nubComponentTargets
@@ -1933,13 +1943,21 @@ elaboratePackageTargets ElaboratedConfiguredPackage{..} targets =
19331943
$ targets
19341944
buildHaddocks = HaddockDefaultComponents `elem` targets
19351945

1936-
in (buildTargets, replTargets, buildHaddocks)
1946+
in (buildTargets, testTargets, replTargets, buildHaddocks)
19371947
where
19381948
--TODO: need to report an error here if defaultComponents is empty
19391949
elaborateBuildTarget BuildDefaultComponents = pkgDefaultComponents
19401950
elaborateBuildTarget (BuildSpecificComponent t) = [t]
1951+
-- TODO: We need to build test components as well
1952+
-- should this be configurable, i.e. to /just/ run, not try to build
1953+
elaborateBuildTarget TestDefaultComponents = pkgDefaultComponents
1954+
elaborateBuildTarget (TestSpecificComponent t) = [t]
19411955
elaborateBuildTarget _ = []
19421956

1957+
elaborateTestTarget TestDefaultComponents = pkgDefaultComponents
1958+
elaborateTestTarget (TestSpecificComponent t) = [t]
1959+
elaborateTestTarget _ = []
1960+
19431961
--TODO: need to report an error here if defaultComponents is empty
19441962
elaborateReplTarget ReplDefaultComponent = take 1 pkgDefaultComponents
19451963
elaborateReplTarget (ReplSpecificComponent t) = [t]
@@ -1991,6 +2009,7 @@ elaboratePackageTargets ElaboratedConfiguredPackage{..} targets =
19912009
pkgHasEphemeralBuildTargets :: ElaboratedConfiguredPackage -> Bool
19922010
pkgHasEphemeralBuildTargets elab =
19932011
isJust (elabReplTarget elab)
2012+
|| (not . null) (elabTestTargets elab)
19942013
|| (not . null) [ () | ComponentTarget _ subtarget <- elabBuildTargets elab
19952014
, subtarget /= WholeComponent ]
19962015

@@ -2075,6 +2094,7 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs =
20752094
roots = mapMaybe find_root pkgs'
20762095
find_root (InstallPlan.Configured (PrunedPackage elab _)) =
20772096
if not (null (elabBuildTargets elab)
2097+
&& null (elabTestTargets elab)
20782098
&& isNothing (elabReplTarget elab)
20792099
&& not (elabBuildHaddocks elab))
20802100
then Just (installedUnitId elab)
@@ -2088,11 +2108,12 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs =
20882108
setElabBuildTargets elab =
20892109
elab {
20902110
elabBuildTargets = mapMaybe targetForElab buildTargets,
2111+
elabTestTargets = mapMaybe targetForElab testTargets,
20912112
elabReplTarget = replTarget >>= targetForElab,
20922113
elabBuildHaddocks = buildHaddocks
20932114
}
20942115
where
2095-
(buildTargets, replTarget, buildHaddocks)
2116+
(buildTargets, testTargets, replTarget, buildHaddocks)
20962117
= elaboratePackageTargets elab targets
20972118
targets = fromMaybe []
20982119
$ Map.lookup (installedUnitId elab) perPkgTargetsMap
@@ -2155,6 +2176,7 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs =
21552176
Set.fromList
21562177
[ stanza
21572178
| ComponentTarget cname _ <- elabBuildTargets pkg
2179+
++ elabTestTargets pkg
21582180
++ maybeToList (elabReplTarget pkg)
21592181
, stanza <- maybeToList (componentOptionalStanza cname)
21602182
]
@@ -2782,6 +2804,26 @@ setupHsBuildArgs (ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent _
27822804
= []
27832805

27842806

2807+
setupHsTestFlags :: ElaboratedConfiguredPackage
2808+
-> ElaboratedSharedConfig
2809+
-> Verbosity
2810+
-> FilePath
2811+
-> Cabal.TestFlags
2812+
setupHsTestFlags _ _ verbosity builddir = Cabal.TestFlags
2813+
{ testDistPref = toFlag builddir
2814+
, testVerbosity = toFlag verbosity
2815+
, testMachineLog = mempty
2816+
, testHumanLog = mempty
2817+
, testShowDetails = toFlag Cabal.Always
2818+
, testKeepTix = mempty
2819+
, testOptions = mempty
2820+
}
2821+
2822+
setupHsTestArgs :: ElaboratedConfiguredPackage -> [String]
2823+
-- TODO: Does the issue #3335 affects test as well
2824+
setupHsTestArgs elab =
2825+
mapMaybe (showTestComponentTarget (packageId elab)) (elabTestTargets elab)
2826+
27852827
setupHsReplFlags :: ElaboratedConfiguredPackage
27862828
-> ElaboratedSharedConfig
27872829
-> Verbosity

cabal-install/Distribution/Client/ProjectPlanning/Types.hs

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -40,8 +40,11 @@ module Distribution.Client.ProjectPlanning.Types (
4040
PackageTarget(..),
4141
ComponentTarget(..),
4242
showComponentTarget,
43+
showTestComponentTarget,
4344
SubComponentTarget(..),
4445

46+
isTestComponentTarget,
47+
4548
-- * Setup script
4649
SetupScriptStyle(..),
4750
) where
@@ -272,6 +275,7 @@ data ElaboratedConfiguredPackage
272275

273276
-- Build time related:
274277
elabBuildTargets :: [ComponentTarget],
278+
elabTestTargets :: [ComponentTarget],
275279
elabReplTarget :: Maybe ComponentTarget,
276280
elabBuildHaddocks :: Bool,
277281

@@ -581,6 +585,8 @@ data PackageTarget =
581585
| BuildSpecificComponent ComponentTarget
582586
| ReplDefaultComponent
583587
| ReplSpecificComponent ComponentTarget
588+
| TestDefaultComponents
589+
| TestSpecificComponent ComponentTarget
584590
| HaddockDefaultComponents
585591
deriving (Eq, Show, Generic)
586592

@@ -609,7 +615,13 @@ showComponentTarget pkgid =
609615
ModuleTarget mname -> Cabal.BuildTargetModule cname mname
610616
FileTarget fname -> Cabal.BuildTargetFile cname fname
611617

618+
showTestComponentTarget :: PackageId -> ComponentTarget -> Maybe String
619+
showTestComponentTarget _ (ComponentTarget (CTestName n) _) = Just $ display n
620+
showTestComponentTarget _ _ = Nothing
612621

622+
isTestComponentTarget :: ComponentTarget -> Bool
623+
isTestComponentTarget (ComponentTarget (CTestName _) _) = True
624+
isTestComponentTarget _ = False
613625

614626
---------------------------
615627
-- Setup.hs script policy

cabal-install/Main.hs

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -74,11 +74,12 @@ import Distribution.Client.Targets
7474
import qualified Distribution.Client.List as List
7575
( list, info )
7676

77-
import qualified Distribution.Client.CmdConfigure as CmdConfigure
7877
import qualified Distribution.Client.CmdBuild as CmdBuild
79-
import qualified Distribution.Client.CmdRepl as CmdRepl
78+
import qualified Distribution.Client.CmdConfigure as CmdConfigure
8079
import qualified Distribution.Client.CmdFreeze as CmdFreeze
8180
import qualified Distribution.Client.CmdHaddock as CmdHaddock
81+
import qualified Distribution.Client.CmdRepl as CmdRepl
82+
import qualified Distribution.Client.CmdTest as CmdTest
8283

8384
import Distribution.Client.Install (install)
8485
import Distribution.Client.Configure (configure, writeConfigFlags)
@@ -284,6 +285,7 @@ mainWorker args = topHandler $
284285
, regularCmd CmdConfigure.configureCommand CmdConfigure.configureAction
285286
, regularCmd CmdBuild.buildCommand CmdBuild.buildAction
286287
, regularCmd CmdRepl.replCommand CmdRepl.replAction
288+
, hiddenCmd CmdTest.testCommand CmdTest.testAction
287289
, regularCmd CmdFreeze.freezeCommand CmdFreeze.freezeAction
288290
, regularCmd CmdHaddock.haddockCommand CmdHaddock.haddockAction
289291
]

cabal-install/cabal-install.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -213,6 +213,7 @@ executable cabal
213213
Distribution.Client.CmdConfigure
214214
Distribution.Client.CmdFreeze
215215
Distribution.Client.CmdHaddock
216+
Distribution.Client.CmdTest
216217
Distribution.Client.CmdRepl
217218
Distribution.Client.Config
218219
Distribution.Client.Configure
Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
packages: .
Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
import Test.Cabal.Prelude
2+
3+
main = cabalTest $ do
4+
cabal "new-test" []

0 commit comments

Comments
 (0)