Merge pull request #4244 from haskell/new-test

WIP: new-test

cabal-install/Distribution/Client/CmdTest.hs

+{-# 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)
+

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

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

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

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
       ]

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

cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.project

+packages: .

cabal-testsuite/PackageTests/TestSuiteTests/ExeV10/cabal.test.hs

+import Test.Cabal.Prelude
+
+main = cabalTest $ do
+    cabal "new-test" []