cabal-install/tests/IntegrationTests2.hs

   1 {-# LANGUAGE BangPatterns #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE RankNTypes #-}
   5 {-# LANGUAGE ScopedTypeVariables #-}
   6 -- For the handy instance IsString PackageIdentifier
   7 {-# OPTIONS_GHC -fno-warn-orphans #-}
   8
   9 module Main where
  10
  11 import Distribution.Client.Compat.Prelude
  12 import Prelude ()
  13
  14 import Distribution.Client.DistDirLayout
  15 import Distribution.Client.HttpUtils
  16 import qualified Distribution.Client.InstallPlan as InstallPlan
  17 import Distribution.Client.ProjectBuilding
  18 import Distribution.Client.ProjectConfig
  19 import Distribution.Client.ProjectOrchestration
  20   ( distinctTargetComponents
  21   , resolveTargets
  22   )
  23 import Distribution.Client.ProjectPlanning
  24 import Distribution.Client.ProjectPlanning.Types
  25 import Distribution.Client.TargetProblem
  26   ( TargetProblem (..)
  27   , TargetProblem'
  28   )
  29 import Distribution.Client.TargetSelector hiding (DirActions (..))
  30 import qualified Distribution.Client.TargetSelector as TS (DirActions (..))
  31 import Distribution.Client.Targets
  32   ( UserConstraint (..)
  33   , UserConstraintScope (UserAnyQualifier)
  34   )
  35 import Distribution.Client.Types
  36   ( PackageLocation (..)
  37   , PackageSpecifier (..)
  38   , UnresolvedSourcePackage
  39   )
  40 import Distribution.Solver.Types.ConstraintSource
  41   ( ConstraintSource (ConstraintSourceUnknown)
  42   )
  43 import Distribution.Solver.Types.PackageConstraint
  44   ( PackageProperty (PackagePropertySource)
  45   )
  46 import Distribution.Solver.Types.SourcePackage as SP
  47
  48 import qualified Distribution.Client.CmdBench as CmdBench
  49 import qualified Distribution.Client.CmdBuild as CmdBuild
  50 import qualified Distribution.Client.CmdHaddock as CmdHaddock
  51 import qualified Distribution.Client.CmdListBin as CmdListBin
  52 import qualified Distribution.Client.CmdRepl as CmdRepl
  53 import qualified Distribution.Client.CmdRun as CmdRun
  54 import qualified Distribution.Client.CmdTest as CmdTest
  55
  56 import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject
  57 import Distribution.Client.Config (SavedConfig (savedGlobalFlags), createDefaultConfigFile, loadConfig)
  58 import Distribution.Client.GlobalFlags (defaultGlobalFlags)
  59 import Distribution.Client.Setup (globalCommand, globalStoreDir)
  60 import Distribution.InstalledPackageInfo (InstalledPackageInfo)
  61 import Distribution.ModuleName (ModuleName)
  62 import Distribution.Package
  63 import Distribution.PackageDescription
  64 import Distribution.Simple.Command
  65 import Distribution.Simple.Compiler
  66 import qualified Distribution.Simple.Flag as Flag
  67 import Distribution.Simple.Setup (CommonSetupFlags (..), HaddockFlags (..), HaddockProjectFlags (..), defaultCommonSetupFlags, defaultHaddockFlags, defaultHaddockProjectFlags, toFlag)
  68 import Distribution.System
  69 import Distribution.Text
  70 import Distribution.Utils.Path (unsafeMakeSymbolicPath)
  71 import Distribution.Version
  72 import IntegrationTests2.CPP
  73
  74 import Data.List (isInfixOf)
  75 import qualified Data.Map as Map
  76 import qualified Data.Set as Set
  77
  78 import Control.Concurrent (threadDelay)
  79 import Control.Exception hiding (assert)
  80 import Control.Monad
  81 import System.Directory
  82 import System.Environment (setEnv)
  83 import System.FilePath
  84 import System.IO (hPutStrLn, stderr)
  85 import System.Process (callProcess)
  86
  87 import Data.Tagged (Tagged (..))
  88 import Test.Tasty
  89 import Test.Tasty.HUnit
  90 import Test.Tasty.Options
  91
  92 import qualified Data.ByteString as BS
  93 import Data.Maybe (fromJust)
  94 import Distribution.Client.GlobalFlags (GlobalFlags, globalNix)
  95 import Distribution.Simple.Flag (Flag (Flag, NoFlag))
  96 import Distribution.Types.ParStrat
  97
  98 main :: IO ()
  99 main = do
 100   -- this is needed to ensure tests aren't affected by the user's cabal config
 101   cwd <- getCurrentDirectory
 102   let configDir = cwd </> basedir </> "config" </> "cabal-config"
 103   setEnv "CABAL_DIR" configDir
 104   removeDirectoryRecursive configDir <|> return ()
 105   createDirectoryIfMissing True configDir
 106   -- sigh
 107   -- NOTE: This is running the `cabal` from the user environment, which is
 108   -- generally not the `cabal` being tested!
 109   callProcess "cabal" ["-v0", "user-config", "init", "-f"]
 110   callProcess "cabal" ["update"]
 111   defaultMainWithIngredients
 112     (defaultIngredients ++ [includingOptions projectConfigOptionDescriptions])
 113     ( withProjectConfig $ \config ->
 114         testGroup
 115           "Integration tests (internal)"
 116           (tests config)
 117     )
 118
 119 tests :: ProjectConfig -> [TestTree]
 120 tests config =
 121   -- TODO: tests for:
 122   -- \* normal success
 123   -- \* dry-run tests with changes
 124   [ testGroup "Discovery and planning" $
 125       [ testCase "no package" (testExceptionInFindingPackage config)
 126       , testCase "no package2" (testExceptionInFindingPackage2 config)
 127       , testCase "proj conf1" (testExceptionInProjectConfig config)
 128       ]
 129   , testGroup "Target selectors" $
 130       [ testCaseSteps "valid" testTargetSelectors
 131       , testCase "bad syntax" testTargetSelectorBadSyntax
 132       , testCaseSteps "ambiguous syntax" testTargetSelectorAmbiguous
 133       , testCase "no current pkg" testTargetSelectorNoCurrentPackage
 134       , testCase "no targets" testTargetSelectorNoTargets
 135       , testCase "project empty" testTargetSelectorProjectEmpty
 136       , testCase "canonicalized path" testTargetSelectorCanonicalizedPath
 137       , testCase "problems (common)" (testTargetProblemsCommon config)
 138       , testCaseSteps "problems (build)" (testTargetProblemsBuild config)
 139       , testCaseSteps "problems (repl)" (testTargetProblemsRepl config)
 140       , testCaseSteps "problems (run)" (testTargetProblemsRun config)
 141       , testCaseSteps "problems (list-bin)" (testTargetProblemsListBin config)
 142       , testCaseSteps "problems (test)" (testTargetProblemsTest config)
 143       , testCaseSteps "problems (bench)" (testTargetProblemsBench config)
 144       , testCaseSteps "problems (haddock)" (testTargetProblemsHaddock config)
 145       ]
 146   , testGroup "Exceptions during building (local inplace)" $
 147       [ testCase "configure" (testExceptionInConfigureStep config)
 148       , testCase "build" (testExceptionInBuildStep config)
 149       --    , testCase "register"   testExceptionInRegisterStep
 150       ]
 151   , -- TODO: need to repeat for packages for the store
 152     -- TODO: need to check we can build sub-libs, foreign libs and exes
 153     -- components for non-local packages / packages in the store.
 154
 155     testGroup "Successful builds" $
 156       [ testCaseSteps "Setup script styles" (testSetupScriptStyles config)
 157       , testCase "keep-going" (testBuildKeepGoing config)
 158       ]
 159         ++ if isMingw32
 160           then -- disabled because https://github.com/haskell/cabal/issues/6272
 161             []
 162           else
 163             [ testCase "local tarball" (testBuildLocalTarball config)
 164             ]
 165   , testGroup "Regression tests" $
 166       [ testCase "issue #3324" (testRegressionIssue3324 config)
 167       , testCase "program options scope all" (testProgramOptionsAll config)
 168       , testCase "program options scope local" (testProgramOptionsLocal config)
 169       , testCase "program options scope specific" (testProgramOptionsSpecific config)
 170       ]
 171   , testGroup "Flag tests" $
 172       [ testCase "Test Nix Flag" testNixFlags
 173       , testCase "Test Config options for commented options" testConfigOptionComments
 174       , testCase "Test Ignore Project Flag" testIgnoreProjectFlag
 175       ]
 176   , testGroup
 177       "haddock-project"
 178       [ testCase "dependencies" (testHaddockProjectDependencies config)
 179       ]
 180   ]
 181
 182 testTargetSelectors :: (String -> IO ()) -> Assertion
 183 testTargetSelectors reportSubCase = do
 184   (_, _, _, localPackages, _) <- configureProject testdir config
 185   let readTargetSelectors' =
 186         readTargetSelectorsWith
 187           (dirActions testdir)
 188           localPackages
 189           Nothing
 190
 191   reportSubCase "cwd"
 192   do
 193     Right ts <- readTargetSelectors' []
 194     ts @?= [TargetPackage TargetImplicitCwd ["p-0.1"] Nothing]
 195
 196   reportSubCase "all"
 197   do
 198     Right ts <-
 199       readTargetSelectors'
 200         ["all", ":all"]
 201     ts @?= replicate 2 (TargetAllPackages Nothing)
 202
 203   reportSubCase "filter"
 204   do
 205     Right ts <-
 206       readTargetSelectors'
 207         [ "libs"
 208         , ":cwd:libs"
 209         , "flibs"
 210         , ":cwd:flibs"
 211         , "exes"
 212         , ":cwd:exes"
 213         , "tests"
 214         , ":cwd:tests"
 215         , "benchmarks"
 216         , ":cwd:benchmarks"
 217         ]
 218     zipWithM_
 219       (@?=)
 220       ts
 221       [ TargetPackage TargetImplicitCwd ["p-0.1"] (Just kind)
 222       | kind <- concatMap (replicate 2) [LibKind ..]
 223       ]
 224
 225   reportSubCase "all:filter"
 226   do
 227     Right ts <-
 228       readTargetSelectors'
 229         [ "all:libs"
 230         , ":all:libs"
 231         , "all:flibs"
 232         , ":all:flibs"
 233         , "all:exes"
 234         , ":all:exes"
 235         , "all:tests"
 236         , ":all:tests"
 237         , "all:benchmarks"
 238         , ":all:benchmarks"
 239         ]
 240     zipWithM_
 241       (@?=)
 242       ts
 243       [ TargetAllPackages (Just kind)
 244       | kind <- concatMap (replicate 2) [LibKind ..]
 245       ]
 246
 247   reportSubCase "pkg"
 248   do
 249     Right ts <-
 250       readTargetSelectors'
 251         [ ":pkg:p"
 252         , "."
 253         , "./"
 254         , "p.cabal"
 255         , "q"
 256         , ":pkg:q"
 257         , "q/"
 258         , "./q/"
 259         , "q/q.cabal"
 260         ]
 261     ts
 262       @?= replicate 4 (mkTargetPackage "p-0.1")
 263         ++ replicate 5 (mkTargetPackage "q-0.1")
 264
 265   reportSubCase "pkg:filter"
 266   do
 267     Right ts <-
 268       readTargetSelectors'
 269         [ "p:libs"
 270         , ".:libs"
 271         , ":pkg:p:libs"
 272         , "p:flibs"
 273         , ".:flibs"
 274         , ":pkg:p:flibs"
 275         , "p:exes"
 276         , ".:exes"
 277         , ":pkg:p:exes"
 278         , "p:tests"
 279         , ".:tests"
 280         , ":pkg:p:tests"
 281         , "p:benchmarks"
 282         , ".:benchmarks"
 283         , ":pkg:p:benchmarks"
 284         , "q:libs"
 285         , "q/:libs"
 286         , ":pkg:q:libs"
 287         , "q:flibs"
 288         , "q/:flibs"
 289         , ":pkg:q:flibs"
 290         , "q:exes"
 291         , "q/:exes"
 292         , ":pkg:q:exes"
 293         , "q:tests"
 294         , "q/:tests"
 295         , ":pkg:q:tests"
 296         , "q:benchmarks"
 297         , "q/:benchmarks"
 298         , ":pkg:q:benchmarks"
 299         ]
 300     zipWithM_ (@?=) ts $
 301       [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just kind)
 302       | kind <- concatMap (replicate 3) [LibKind ..]
 303       ]
 304         ++ [ TargetPackage TargetExplicitNamed ["q-0.1"] (Just kind)
 305            | kind <- concatMap (replicate 3) [LibKind ..]
 306            ]
 307
 308   reportSubCase "component"
 309   do
 310     Right ts <-
 311       readTargetSelectors'
 312         [ "p"
 313         , "lib:p"
 314         , "p:lib:p"
 315         , ":pkg:p:lib:p"
 316         , "lib:q"
 317         , "q:lib:q"
 318         , ":pkg:q:lib:q"
 319         ]
 320     ts
 321       @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) WholeComponent)
 322         ++ replicate 3 (TargetComponent "q-0.1" (CLibName LMainLibName) WholeComponent)
 323
 324   reportSubCase "module"
 325   do
 326     Right ts <-
 327       readTargetSelectors'
 328         [ "P"
 329         , "lib:p:P"
 330         , "p:p:P"
 331         , ":pkg:p:lib:p:module:P"
 332         , "QQ"
 333         , "lib:q:QQ"
 334         , "q:q:QQ"
 335         , ":pkg:q:lib:q:module:QQ"
 336         , "pexe:PMain" -- p:P or q:QQ would be ambiguous here
 337         , "qexe:QMain" -- package p vs component p
 338         ]
 339     ts
 340       @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) (ModuleTarget "P"))
 341         ++ replicate 4 (TargetComponent "q-0.1" (CLibName LMainLibName) (ModuleTarget "QQ"))
 342         ++ [ TargetComponent "p-0.1" (CExeName "pexe") (ModuleTarget "PMain")
 343            , TargetComponent "q-0.1" (CExeName "qexe") (ModuleTarget "QMain")
 344            ]
 345
 346   reportSubCase "file"
 347   do
 348     Right ts <-
 349       readTargetSelectors'
 350         [ "./P.hs"
 351         , "p:P.lhs"
 352         , "lib:p:P.hsc"
 353         , "p:p:P.hsc"
 354         , ":pkg:p:lib:p:file:P.y"
 355         , "q/QQ.hs"
 356         , "q:QQ.lhs"
 357         , "lib:q:QQ.hsc"
 358         , "q:q:QQ.hsc"
 359         , ":pkg:q:lib:q:file:QQ.y"
 360         , "q/Q.hs"
 361         , "q:Q.lhs"
 362         , "lib:q:Q.hsc"
 363         , "q:q:Q.hsc"
 364         , ":pkg:q:lib:q:file:Q.y"
 365         , "app/Main.hs"
 366         , "p:app/Main.hs"
 367         , "exe:ppexe:app/Main.hs"
 368         , "p:ppexe:app/Main.hs"
 369         , ":pkg:p:exe:ppexe:file:app/Main.hs"
 370         , "a p p/Main.hs"
 371         , "p:a p p/Main.hs"
 372         , "exe:pppexe:a p p/Main.hs"
 373         , "p:pppexe:a p p/Main.hs"
 374         , ":pkg:p:exe:pppexe:file:a p p/Main.hs"
 375         ]
 376     ts
 377       @?= replicate 5 (TargetComponent "p-0.1" (CLibName LMainLibName) (FileTarget "P"))
 378         ++ replicate 5 (TargetComponent "q-0.1" (CLibName LMainLibName) (FileTarget "QQ"))
 379         ++ replicate 5 (TargetComponent "q-0.1" (CLibName LMainLibName) (FileTarget "Q"))
 380         ++ replicate 5 (TargetComponent "p-0.1" (CExeName "ppexe") (FileTarget ("app" </> "Main.hs")))
 381         ++ replicate 5 (TargetComponent "p-0.1" (CExeName "pppexe") (FileTarget ("a p p" </> "Main.hs")))
 382   -- Note there's a bit of an inconsistency here: for the single-part
 383   -- syntax the target has to point to a file that exists, whereas for
 384   -- all the other forms we don't require that.
 385
 386   cleanProject testdir
 387   where
 388     testdir = "targets/simple"
 389     config = mempty
 390
 391 testTargetSelectorBadSyntax :: Assertion
 392 testTargetSelectorBadSyntax = do
 393   (_, _, _, localPackages, _) <- configureProject testdir config
 394   let targets =
 395         [ "foo:"
 396         , "foo::bar"
 397         , " :foo"
 398         , "foo: :bar"
 399         , "a:b:c:d:e:f"
 400         , "a:b:c:d:e:f:g:h"
 401         ]
 402   Left errs <- readTargetSelectors localPackages Nothing targets
 403   zipWithM_ (@?=) errs (map TargetSelectorUnrecognised targets)
 404   cleanProject testdir
 405   where
 406     testdir = "targets/empty"
 407     config = mempty
 408
 409 testTargetSelectorAmbiguous :: (String -> IO ()) -> Assertion
 410 testTargetSelectorAmbiguous reportSubCase = do
 411   -- 'all' is ambiguous with packages and cwd components
 412   reportSubCase "ambiguous: all vs pkg"
 413   assertAmbiguous
 414     "all"
 415     [mkTargetPackage "all", mkTargetAllPackages]
 416     [mkpkg "all" []]
 417
 418   reportSubCase "ambiguous: all vs cwd component"
 419   assertAmbiguous
 420     "all"
 421     [mkTargetComponent "other" (CExeName "all"), mkTargetAllPackages]
 422     [mkpkg "other" [mkexe "all"]]
 423
 424   -- but 'all' is not ambiguous with non-cwd components, modules or files
 425   reportSubCase "unambiguous: all vs non-cwd comp, mod, file"
 426   assertUnambiguous
 427     "All"
 428     mkTargetAllPackages
 429     [ mkpkgAt "foo" [mkexe "All"] "foo"
 430     , mkpkg
 431         "bar"
 432         [ mkexe "bar" `withModules` ["All"]
 433         , mkexe "baz" `withCFiles` ["All"]
 434         ]
 435     ]
 436
 437   -- filters 'libs', 'exes' etc are ambiguous with packages and
 438   -- local components
 439   reportSubCase "ambiguous: cwd-pkg filter vs pkg"
 440   assertAmbiguous
 441     "libs"
 442     [ mkTargetPackage "libs"
 443     , TargetPackage TargetImplicitCwd ["libs"] (Just LibKind)
 444     ]
 445     [mkpkg "libs" []]
 446
 447   reportSubCase "ambiguous: filter vs cwd component"
 448   assertAmbiguous
 449     "exes"
 450     [ mkTargetComponent "other" (CExeName "exes")
 451     , TargetPackage TargetImplicitCwd ["other"] (Just ExeKind)
 452     ]
 453     [mkpkg "other" [mkexe "exes"]]
 454
 455   -- but filters are not ambiguous with non-cwd components, modules or files
 456   reportSubCase "unambiguous: filter vs non-cwd comp, mod, file"
 457   assertUnambiguous
 458     "Libs"
 459     (TargetPackage TargetImplicitCwd ["bar"] (Just LibKind))
 460     [ mkpkgAt "foo" [mkexe "Libs"] "foo"
 461     , mkpkg
 462         "bar"
 463         [ mkexe "bar" `withModules` ["Libs"]
 464         , mkexe "baz" `withCFiles` ["Libs"]
 465         ]
 466     ]
 467
 468   -- local components shadow packages and other components
 469   reportSubCase "unambiguous: cwd comp vs pkg, non-cwd comp"
 470   assertUnambiguous
 471     "foo"
 472     (mkTargetComponent "other" (CExeName "foo"))
 473     [ mkpkg "other" [mkexe "foo"]
 474     , mkpkgAt "other2" [mkexe "foo"] "other2" -- shadows non-local foo
 475     , mkpkg "foo" [] -- shadows package foo
 476     ]
 477
 478   -- local components shadow modules and files
 479   reportSubCase "unambiguous: cwd comp vs module, file"
 480   assertUnambiguous
 481     "Foo"
 482     (mkTargetComponent "bar" (CExeName "Foo"))
 483     [ mkpkg "bar" [mkexe "Foo"]
 484     , mkpkg
 485         "other"
 486         [ mkexe "other" `withModules` ["Foo"]
 487         , mkexe "other2" `withCFiles` ["Foo"]
 488         ]
 489     ]
 490
 491   -- packages shadow non-local components
 492   reportSubCase "unambiguous: pkg vs non-cwd comp"
 493   assertUnambiguous
 494     "foo"
 495     (mkTargetPackage "foo")
 496     [ mkpkg "foo" []
 497     , mkpkgAt "other" [mkexe "foo"] "other" -- shadows non-local foo
 498     ]
 499
 500   -- packages shadow modules and files
 501   reportSubCase "unambiguous: pkg vs module, file"
 502   assertUnambiguous
 503     "Foo"
 504     (mkTargetPackage "Foo")
 505     [ mkpkgAt "Foo" [] "foo"
 506     , mkpkg
 507         "other"
 508         [ mkexe "other" `withModules` ["Foo"]
 509         , mkexe "other2" `withCFiles` ["Foo"]
 510         ]
 511     ]
 512
 513   -- File target is ambiguous, part of multiple components
 514   reportSubCase "ambiguous: file in multiple comps"
 515   assertAmbiguous
 516     "Bar.hs"
 517     [ mkTargetFile "foo" (CExeName "bar") "Bar"
 518     , mkTargetFile "foo" (CExeName "bar2") "Bar"
 519     ]
 520     [ mkpkg
 521         "foo"
 522         [ mkexe "bar" `withModules` ["Bar"]
 523         , mkexe "bar2" `withModules` ["Bar"]
 524         ]
 525     ]
 526   reportSubCase "ambiguous: file in multiple comps with path"
 527   assertAmbiguous
 528     ("src" </> "Bar.hs")
 529     [ mkTargetFile "foo" (CExeName "bar") ("src" </> "Bar")
 530     , mkTargetFile "foo" (CExeName "bar2") ("src" </> "Bar")
 531     ]
 532     [ mkpkg
 533         "foo"
 534         [ mkexe "bar" `withModules` ["Bar"] `withHsSrcDirs` ["src"]
 535         , mkexe "bar2" `withModules` ["Bar"] `withHsSrcDirs` ["src"]
 536         ]
 537     ]
 538
 539   -- non-exact case packages and components are ambiguous
 540   reportSubCase "ambiguous: non-exact-case pkg names"
 541   assertAmbiguous
 542     "Foo"
 543     [mkTargetPackage "foo", mkTargetPackage "FOO"]
 544     [mkpkg "foo" [], mkpkg "FOO" []]
 545   reportSubCase "ambiguous: non-exact-case comp names"
 546   assertAmbiguous
 547     "Foo"
 548     [ mkTargetComponent "bar" (CExeName "foo")
 549     , mkTargetComponent "bar" (CExeName "FOO")
 550     ]
 551     [mkpkg "bar" [mkexe "foo", mkexe "FOO"]]
 552
 553   -- exact-case Module or File over non-exact case package or component
 554   reportSubCase "unambiguous: module vs non-exact-case pkg, comp"
 555   assertUnambiguous
 556     "Baz"
 557     (mkTargetModule "other" (CExeName "other") "Baz")
 558     [ mkpkg "baz" [mkexe "BAZ"]
 559     , mkpkg "other" [mkexe "other" `withModules` ["Baz"]]
 560     ]
 561   reportSubCase "unambiguous: file vs non-exact-case pkg, comp"
 562   assertUnambiguous
 563     "Baz"
 564     (mkTargetFile "other" (CExeName "other") "Baz")
 565     [ mkpkg "baz" [mkexe "BAZ"]
 566     , mkpkg "other" [mkexe "other" `withCFiles` ["Baz"]]
 567     ]
 568   where
 569     assertAmbiguous
 570       :: String
 571       -> [TargetSelector]
 572       -> [SourcePackage (PackageLocation a)]
 573       -> Assertion
 574     assertAmbiguous str tss pkgs = do
 575       res <-
 576         readTargetSelectorsWith
 577           fakeDirActions
 578           (map SpecificSourcePackage pkgs)
 579           Nothing
 580           [str]
 581       case res of
 582         Left [TargetSelectorAmbiguous _ tss'] ->
 583           sort (map snd tss') @?= sort tss
 584         _ ->
 585           assertFailure $
 586             "expected Left [TargetSelectorAmbiguous _ _], "
 587               ++ "got "
 588               ++ show res
 589
 590     assertUnambiguous
 591       :: String
 592       -> TargetSelector
 593       -> [SourcePackage (PackageLocation a)]
 594       -> Assertion
 595     assertUnambiguous str ts pkgs = do
 596       res <-
 597         readTargetSelectorsWith
 598           fakeDirActions
 599           (map SpecificSourcePackage pkgs)
 600           Nothing
 601           [str]
 602       case res of
 603         Right [ts'] -> ts' @?= ts
 604         _ ->
 605           assertFailure $
 606             "expected Right [Target...], "
 607               ++ "got "
 608               ++ show res
 609
 610     fakeDirActions =
 611       TS.DirActions
 612         { TS.doesFileExist = \_p -> return True
 613         , TS.doesDirectoryExist = \_p -> return True
 614         , TS.canonicalizePath = \p -> return ("/" </> p) -- FilePath.Unix.</> ?
 615         , TS.getCurrentDirectory = return "/"
 616         }
 617
 618     mkpkg :: String -> [Executable] -> SourcePackage (PackageLocation a)
 619     mkpkg pkgidstr exes = mkpkgAt pkgidstr exes ""
 620
 621     mkpkgAt
 622       :: String
 623       -> [Executable]
 624       -> FilePath
 625       -> SourcePackage (PackageLocation a)
 626     mkpkgAt pkgidstr exes loc =
 627       SourcePackage
 628         { srcpkgPackageId = pkgid
 629         , srcpkgSource = LocalUnpackedPackage loc
 630         , srcpkgDescrOverride = Nothing
 631         , srcpkgDescription =
 632             GenericPackageDescription
 633               { packageDescription = emptyPackageDescription{package = pkgid}
 634               , gpdScannedVersion = Nothing
 635               , genPackageFlags = []
 636               , condLibrary = Nothing
 637               , condSubLibraries = []
 638               , condForeignLibs = []
 639               , condExecutables =
 640                   [ (exeName exe, CondNode exe [] [])
 641                   | exe <- exes
 642                   ]
 643               , condTestSuites = []
 644               , condBenchmarks = []
 645               }
 646         }
 647       where
 648         pkgid = fromMaybe (error $ "failed to parse " ++ pkgidstr) $ simpleParse pkgidstr
 649
 650     mkexe :: String -> Executable
 651     mkexe name = mempty{exeName = fromString name}
 652
 653     withModules :: Executable -> [String] -> Executable
 654     withModules exe mods =
 655       exe{buildInfo = (buildInfo exe){otherModules = map fromString mods}}
 656
 657     withCFiles :: Executable -> [FilePath] -> Executable
 658     withCFiles exe files =
 659       exe{buildInfo = (buildInfo exe){cSources = map unsafeMakeSymbolicPath files}}
 660
 661     withHsSrcDirs :: Executable -> [FilePath] -> Executable
 662     withHsSrcDirs exe srcDirs =
 663       exe{buildInfo = (buildInfo exe){hsSourceDirs = map unsafeMakeSymbolicPath srcDirs}}
 664
 665 mkTargetPackage :: PackageId -> TargetSelector
 666 mkTargetPackage pkgid =
 667   TargetPackage TargetExplicitNamed [pkgid] Nothing
 668
 669 mkTargetComponent :: PackageId -> ComponentName -> TargetSelector
 670 mkTargetComponent pkgid cname =
 671   TargetComponent pkgid cname WholeComponent
 672
 673 mkTargetModule :: PackageId -> ComponentName -> ModuleName -> TargetSelector
 674 mkTargetModule pkgid cname mname =
 675   TargetComponent pkgid cname (ModuleTarget mname)
 676
 677 mkTargetFile :: PackageId -> ComponentName -> String -> TargetSelector
 678 mkTargetFile pkgid cname fname =
 679   TargetComponent pkgid cname (FileTarget fname)
 680
 681 mkTargetAllPackages :: TargetSelector
 682 mkTargetAllPackages = TargetAllPackages Nothing
 683
 684 instance IsString PackageIdentifier where
 685   fromString pkgidstr = pkgid
 686     where
 687       pkgid = fromMaybe (error $ "fromString @PackageIdentifier " ++ show pkgidstr) $ simpleParse pkgidstr
 688
 689 testTargetSelectorNoCurrentPackage :: Assertion
 690 testTargetSelectorNoCurrentPackage = do
 691   (_, _, _, localPackages, _) <- configureProject testdir config
 692   let readTargetSelectors' =
 693         readTargetSelectorsWith
 694           (dirActions testdir)
 695           localPackages
 696           Nothing
 697       targets =
 698         [ "libs"
 699         , ":cwd:libs"
 700         , "flibs"
 701         , ":cwd:flibs"
 702         , "exes"
 703         , ":cwd:exes"
 704         , "tests"
 705         , ":cwd:tests"
 706         , "benchmarks"
 707         , ":cwd:benchmarks"
 708         ]
 709   Left errs <- readTargetSelectors' targets
 710   zipWithM_
 711     (@?=)
 712     errs
 713     [ TargetSelectorNoCurrentPackage ts
 714     | target <- targets
 715     , let ts = fromMaybe (error $ "failed to parse target string " ++ target) $ parseTargetString target
 716     ]
 717   cleanProject testdir
 718   where
 719     testdir = "targets/complex"
 720     config = mempty
 721
 722 testTargetSelectorNoTargets :: Assertion
 723 testTargetSelectorNoTargets = do
 724   (_, _, _, localPackages, _) <- configureProject testdir config
 725   Left errs <- readTargetSelectors localPackages Nothing []
 726   errs @?= [TargetSelectorNoTargetsInCwd True]
 727   cleanProject testdir
 728   where
 729     testdir = "targets/complex"
 730     config = mempty
 731
 732 testTargetSelectorProjectEmpty :: Assertion
 733 testTargetSelectorProjectEmpty = do
 734   (_, _, _, localPackages, _) <- configureProject testdir config
 735   Left errs <- readTargetSelectors localPackages Nothing []
 736   errs @?= [TargetSelectorNoTargetsInProject]
 737   cleanProject testdir
 738   where
 739     testdir = "targets/empty"
 740     config = mempty
 741
 742 -- | Ensure we don't miss primary package and produce
 743 -- TargetSelectorNoTargetsInCwd error due to symlink or
 744 -- drive capitalisation mismatch when no targets are given
 745 testTargetSelectorCanonicalizedPath :: Assertion
 746 testTargetSelectorCanonicalizedPath = do
 747   (_, _, _, localPackages, _) <- configureProject testdir config
 748   cwd <- getCurrentDirectory
 749   let virtcwd = cwd </> basedir </> symlink
 750   -- Check that the symlink is there before running test as on Windows
 751   -- some versions/configurations of git won't pull down/create the symlink
 752   canRunTest <- doesDirectoryExist virtcwd
 753   when
 754     canRunTest
 755     ( do
 756         let dirActions' = (dirActions symlink){TS.getCurrentDirectory = return virtcwd}
 757         Right ts <- readTargetSelectorsWith dirActions' localPackages Nothing []
 758         ts @?= [TargetPackage TargetImplicitCwd ["p-0.1"] Nothing]
 759     )
 760   cleanProject testdir
 761   where
 762     testdir = "targets/simple"
 763     symlink = "targets/symbolic-link-to-simple"
 764     config = mempty
 765
 766 testTargetProblemsCommon :: ProjectConfig -> Assertion
 767 testTargetProblemsCommon config0 = do
 768   (_, elaboratedPlan, _) <- planProject testdir config
 769
 770   let pkgIdMap :: Map.Map PackageName PackageId
 771       pkgIdMap =
 772         Map.fromList
 773           [ (packageName p, packageId p)
 774           | p <- InstallPlan.toList elaboratedPlan
 775           ]
 776
 777       cases
 778         :: [ ( TargetSelector -> TargetProblem'
 779              , TargetSelector
 780              )
 781            ]
 782       cases =
 783         [ -- Cannot resolve packages outside of the project
 784
 785           ( \_ -> TargetProblemNoSuchPackage "foobar"
 786           , mkTargetPackage "foobar"
 787           )
 788         , -- We cannot currently build components like testsuites or
 789           -- benchmarks from packages that are not local to the project
 790
 791           ( \_ ->
 792               TargetComponentNotProjectLocal
 793                 (pkgIdMap Map.! "filepath")
 794                 (CTestName "filepath-tests")
 795                 WholeComponent
 796           , mkTargetComponent
 797               (pkgIdMap Map.! "filepath")
 798               (CTestName "filepath-tests")
 799           )
 800         , -- Components can be explicitly @buildable: False@
 801
 802           ( \_ -> TargetComponentNotBuildable "q-0.1" (CExeName "buildable-false") WholeComponent
 803           , mkTargetComponent "q-0.1" (CExeName "buildable-false")
 804           )
 805         , -- Testsuites and benchmarks can be disabled by the solver if it
 806           -- cannot satisfy deps
 807
 808           ( \_ -> TargetOptionalStanzaDisabledBySolver "q-0.1" (CTestName "solver-disabled") WholeComponent
 809           , mkTargetComponent "q-0.1" (CTestName "solver-disabled")
 810           )
 811         , -- Testsuites and benchmarks can be disabled explicitly by the
 812           -- user via config
 813
 814           ( \_ ->
 815               TargetOptionalStanzaDisabledByUser
 816                 "q-0.1"
 817                 (CBenchName "user-disabled")
 818                 WholeComponent
 819           , mkTargetComponent "q-0.1" (CBenchName "user-disabled")
 820           )
 821         , -- An unknown package. The target selector resolution should only
 822           -- produce known packages, so this should not happen with the
 823           -- output from 'readTargetSelectors'.
 824
 825           ( \_ -> TargetProblemNoSuchPackage "foobar"
 826           , mkTargetPackage "foobar"
 827           )
 828         , -- An unknown component of a known package. The target selector
 829           -- resolution should only produce known packages, so this should
 830           -- not happen with the output from 'readTargetSelectors'.
 831
 832           ( \_ -> TargetProblemNoSuchComponent "q-0.1" (CExeName "no-such")
 833           , mkTargetComponent "q-0.1" (CExeName "no-such")
 834           )
 835         ]
 836   assertTargetProblems
 837     elaboratedPlan
 838     CmdBuild.selectPackageTargets
 839     CmdBuild.selectComponentTarget
 840     cases
 841   where
 842     testdir = "targets/complex"
 843     config =
 844       config0
 845         { projectConfigLocalPackages =
 846             (projectConfigLocalPackages config0)
 847               { packageConfigBenchmarks = toFlag False
 848               }
 849         , projectConfigShared =
 850             (projectConfigShared config0)
 851               { projectConfigConstraints =
 852                   [
 853                     ( UserConstraint (UserAnyQualifier "filepath") PackagePropertySource
 854                     , ConstraintSourceUnknown
 855                     )
 856                   ]
 857               }
 858         }
 859
 860 testTargetProblemsBuild :: ProjectConfig -> (String -> IO ()) -> Assertion
 861 testTargetProblemsBuild config reportSubCase = do
 862   reportSubCase "empty-pkg"
 863   assertProjectTargetProblems
 864     "targets/empty-pkg"
 865     config
 866     CmdBuild.selectPackageTargets
 867     CmdBuild.selectComponentTarget
 868     [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")
 869     ]
 870
 871   reportSubCase "all-disabled"
 872   assertProjectTargetProblems
 873     "targets/all-disabled"
 874     config
 875       { projectConfigLocalPackages =
 876           (projectConfigLocalPackages config)
 877             { packageConfigBenchmarks = toFlag False
 878             }
 879       }
 880     CmdBuild.selectPackageTargets
 881     CmdBuild.selectComponentTarget
 882     [
 883       ( flip
 884           TargetProblemNoneEnabled
 885           [ AvailableTarget
 886               "p-0.1"
 887               (CBenchName "user-disabled")
 888               TargetDisabledByUser
 889               True
 890           , AvailableTarget
 891               "p-0.1"
 892               (CTestName "solver-disabled")
 893               TargetDisabledBySolver
 894               True
 895           , AvailableTarget
 896               "p-0.1"
 897               (CExeName "buildable-false")
 898               TargetNotBuildable
 899               True
 900           , AvailableTarget
 901               "p-0.1"
 902               (CLibName LMainLibName)
 903               TargetNotBuildable
 904               True
 905           ]
 906       , mkTargetPackage "p-0.1"
 907       )
 908     ]
 909
 910   reportSubCase "enabled component kinds"
 911   -- When we explicitly enable all the component kinds then selecting the
 912   -- whole package selects those component kinds too
 913   do
 914     (_, elaboratedPlan, _) <-
 915       planProject
 916         "targets/variety"
 917         config
 918           { projectConfigLocalPackages =
 919               (projectConfigLocalPackages config)
 920                 { packageConfigTests = toFlag True
 921                 , packageConfigBenchmarks = toFlag True
 922                 }
 923           }
 924     assertProjectDistinctTargets
 925       elaboratedPlan
 926       CmdBuild.selectPackageTargets
 927       CmdBuild.selectComponentTarget
 928       [mkTargetPackage "p-0.1"]
 929       [ ("p-0.1-inplace", (CLibName LMainLibName))
 930       , ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")
 931       , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite")
 932       , ("p-0.1-inplace-an-exe", CExeName "an-exe")
 933       , ("p-0.1-inplace-libp", CFLibName "libp")
 934       ]
 935
 936   reportSubCase "disabled component kinds"
 937   -- When we explicitly disable all the component kinds then selecting the
 938   -- whole package only selects the library, foreign lib and exes
 939   do
 940     (_, elaboratedPlan, _) <-
 941       planProject
 942         "targets/variety"
 943         config
 944           { projectConfigLocalPackages =
 945               (projectConfigLocalPackages config)
 946                 { packageConfigTests = toFlag False
 947                 , packageConfigBenchmarks = toFlag False
 948                 }
 949           }
 950     assertProjectDistinctTargets
 951       elaboratedPlan
 952       CmdBuild.selectPackageTargets
 953       CmdBuild.selectComponentTarget
 954       [mkTargetPackage "p-0.1"]
 955       [ ("p-0.1-inplace", (CLibName LMainLibName))
 956       , ("p-0.1-inplace-an-exe", CExeName "an-exe")
 957       , ("p-0.1-inplace-libp", CFLibName "libp")
 958       ]
 959
 960   reportSubCase "requested component kinds"
 961   -- When we selecting the package with an explicit filter then we get those
 962   -- components even though we did not explicitly enable tests/benchmarks
 963   do
 964     (_, elaboratedPlan, _) <- planProject "targets/variety" config
 965     assertProjectDistinctTargets
 966       elaboratedPlan
 967       CmdBuild.selectPackageTargets
 968       CmdBuild.selectComponentTarget
 969       [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)
 970       , TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind)
 971       ]
 972       [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")
 973       , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite")
 974       ]
 975
 976 testTargetProblemsRepl :: ProjectConfig -> (String -> IO ()) -> Assertion
 977 testTargetProblemsRepl config reportSubCase = do
 978   reportSubCase "multiple-libs"
 979   assertProjectTargetProblems
 980     "targets/multiple-libs"
 981     config
 982     (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))
 983     CmdRepl.selectComponentTarget
 984     [
 985       ( flip
 986           (CmdRepl.matchesMultipleProblem (CmdRepl.MultiReplDecision Nothing False))
 987           [ AvailableTarget
 988               "p-0.1"
 989               (CLibName LMainLibName)
 990               (TargetBuildable () TargetRequestedByDefault)
 991               True
 992           , AvailableTarget
 993               "q-0.1"
 994               (CLibName LMainLibName)
 995               (TargetBuildable () TargetRequestedByDefault)
 996               True
 997           ]
 998       , mkTargetAllPackages
 999       )
1000     ]
1001
1002   reportSubCase "multiple-exes"
1003   assertProjectTargetProblems
1004     "targets/multiple-exes"
1005     config
1006     (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))
1007     CmdRepl.selectComponentTarget
1008     [
1009       ( flip
1010           (CmdRepl.matchesMultipleProblem (CmdRepl.MultiReplDecision Nothing False))
1011           [ AvailableTarget
1012               "p-0.1"
1013               (CExeName "p2")
1014               (TargetBuildable () TargetRequestedByDefault)
1015               True
1016           , AvailableTarget
1017               "p-0.1"
1018               (CExeName "p1")
1019               (TargetBuildable () TargetRequestedByDefault)
1020               True
1021           ]
1022       , mkTargetPackage "p-0.1"
1023       )
1024     ]
1025
1026   reportSubCase "multiple-tests"
1027   assertProjectTargetProblems
1028     "targets/multiple-tests"
1029     config
1030     (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))
1031     CmdRepl.selectComponentTarget
1032     [
1033       ( flip
1034           (CmdRepl.matchesMultipleProblem (CmdRepl.MultiReplDecision Nothing False))
1035           [ AvailableTarget
1036               "p-0.1"
1037               (CTestName "p2")
1038               (TargetBuildable () TargetNotRequestedByDefault)
1039               True
1040           , AvailableTarget
1041               "p-0.1"
1042               (CTestName "p1")
1043               (TargetBuildable () TargetNotRequestedByDefault)
1044               True
1045           ]
1046       , TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)
1047       )
1048     ]
1049
1050   reportSubCase "multiple targets"
1051   do
1052     (_, elaboratedPlan, _) <- planProject "targets/multiple-exes" config
1053     assertProjectDistinctTargets
1054       elaboratedPlan
1055       (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))
1056       CmdRepl.selectComponentTarget
1057       [ mkTargetComponent "p-0.1" (CExeName "p1")
1058       , mkTargetComponent "p-0.1" (CExeName "p2")
1059       ]
1060       [ ("p-0.1-inplace-p1", CExeName "p1")
1061       , ("p-0.1-inplace-p2", CExeName "p2")
1062       ]
1063
1064   reportSubCase "libs-disabled"
1065   assertProjectTargetProblems
1066     "targets/libs-disabled"
1067     config
1068     (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))
1069     CmdRepl.selectComponentTarget
1070     [
1071       ( flip
1072           TargetProblemNoneEnabled
1073           [AvailableTarget "p-0.1" (CLibName LMainLibName) TargetNotBuildable True]
1074       , mkTargetPackage "p-0.1"
1075       )
1076     ]
1077
1078   reportSubCase "exes-disabled"
1079   assertProjectTargetProblems
1080     "targets/exes-disabled"
1081     config
1082     (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))
1083     CmdRepl.selectComponentTarget
1084     [
1085       ( flip
1086           TargetProblemNoneEnabled
1087           [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True
1088           ]
1089       , mkTargetPackage "p-0.1"
1090       )
1091     ]
1092
1093   reportSubCase "test-only"
1094   assertProjectTargetProblems
1095     "targets/test-only"
1096     config
1097     (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))
1098     CmdRepl.selectComponentTarget
1099     [
1100       ( flip
1101           TargetProblemNoneEnabled
1102           [ AvailableTarget
1103               "p-0.1"
1104               (CTestName "pexe")
1105               (TargetBuildable () TargetNotRequestedByDefault)
1106               True
1107           ]
1108       , mkTargetPackage "p-0.1"
1109       )
1110     ]
1111
1112   reportSubCase "empty-pkg"
1113   assertProjectTargetProblems
1114     "targets/empty-pkg"
1115     config
1116     (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))
1117     CmdRepl.selectComponentTarget
1118     [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")
1119     ]
1120
1121   reportSubCase "requested component kinds"
1122   do
1123     (_, elaboratedPlan, _) <- planProject "targets/variety" config
1124     -- by default we only get the lib
1125     assertProjectDistinctTargets
1126       elaboratedPlan
1127       (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))
1128       CmdRepl.selectComponentTarget
1129       [TargetPackage TargetExplicitNamed ["p-0.1"] Nothing]
1130       [("p-0.1-inplace", (CLibName LMainLibName))]
1131     -- When we select the package with an explicit filter then we get those
1132     -- components even though we did not explicitly enable tests/benchmarks
1133     assertProjectDistinctTargets
1134       elaboratedPlan
1135       (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))
1136       CmdRepl.selectComponentTarget
1137       [TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)]
1138       [("p-0.1-inplace-a-testsuite", CTestName "a-testsuite")]
1139     assertProjectDistinctTargets
1140       elaboratedPlan
1141       (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))
1142       CmdRepl.selectComponentTarget
1143       [TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind)]
1144       [("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")]
1145
1146 testTargetProblemsListBin :: ProjectConfig -> (String -> IO ()) -> Assertion
1147 testTargetProblemsListBin config reportSubCase = do
1148   reportSubCase "one-of-each"
1149   do
1150     (_, elaboratedPlan, _) <- planProject "targets/one-of-each" config
1151     assertProjectDistinctTargets
1152       elaboratedPlan
1153       CmdListBin.selectPackageTargets
1154       CmdListBin.selectComponentTarget
1155       [ TargetPackage TargetExplicitNamed ["p-0.1"] Nothing
1156       ]
1157       [ ("p-0.1-inplace-p1", CExeName "p1")
1158       ]
1159
1160   reportSubCase "multiple-exes"
1161   assertProjectTargetProblems
1162     "targets/multiple-exes"
1163     config
1164     CmdListBin.selectPackageTargets
1165     CmdListBin.selectComponentTarget
1166     [
1167       ( flip
1168           CmdListBin.matchesMultipleProblem
1169           [ AvailableTarget
1170               "p-0.1"
1171               (CExeName "p2")
1172               (TargetBuildable () TargetRequestedByDefault)
1173               True
1174           , AvailableTarget
1175               "p-0.1"
1176               (CExeName "p1")
1177               (TargetBuildable () TargetRequestedByDefault)
1178               True
1179           ]
1180       , mkTargetPackage "p-0.1"
1181       )
1182     ]
1183
1184   reportSubCase "multiple targets"
1185   do
1186     (_, elaboratedPlan, _) <- planProject "targets/multiple-exes" config
1187     assertProjectDistinctTargets
1188       elaboratedPlan
1189       CmdListBin.selectPackageTargets
1190       CmdListBin.selectComponentTarget
1191       [ mkTargetComponent "p-0.1" (CExeName "p1")
1192       , mkTargetComponent "p-0.1" (CExeName "p2")
1193       ]
1194       [ ("p-0.1-inplace-p1", CExeName "p1")
1195       , ("p-0.1-inplace-p2", CExeName "p2")
1196       ]
1197
1198   reportSubCase "exes-disabled"
1199   assertProjectTargetProblems
1200     "targets/exes-disabled"
1201     config
1202     CmdListBin.selectPackageTargets
1203     CmdListBin.selectComponentTarget
1204     [
1205       ( flip
1206           TargetProblemNoneEnabled
1207           [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True
1208           ]
1209       , mkTargetPackage "p-0.1"
1210       )
1211     ]
1212
1213   reportSubCase "empty-pkg"
1214   assertProjectTargetProblems
1215     "targets/empty-pkg"
1216     config
1217     CmdListBin.selectPackageTargets
1218     CmdListBin.selectComponentTarget
1219     [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")
1220     ]
1221
1222   reportSubCase "lib-only"
1223   assertProjectTargetProblems
1224     "targets/lib-only"
1225     config
1226     CmdListBin.selectPackageTargets
1227     CmdListBin.selectComponentTarget
1228     [ (CmdListBin.noComponentsProblem, mkTargetPackage "p-0.1")
1229     ]
1230
1231 testTargetProblemsRun :: ProjectConfig -> (String -> IO ()) -> Assertion
1232 testTargetProblemsRun config reportSubCase = do
1233   reportSubCase "one-of-each"
1234   do
1235     (_, elaboratedPlan, _) <- planProject "targets/one-of-each" config
1236     assertProjectDistinctTargets
1237       elaboratedPlan
1238       CmdRun.selectPackageTargets
1239       CmdRun.selectComponentTarget
1240       [ TargetPackage TargetExplicitNamed ["p-0.1"] Nothing
1241       ]
1242       [ ("p-0.1-inplace-p1", CExeName "p1")
1243       ]
1244
1245   reportSubCase "multiple-exes"
1246   assertProjectTargetProblems
1247     "targets/multiple-exes"
1248     config
1249     CmdRun.selectPackageTargets
1250     CmdRun.selectComponentTarget
1251     [
1252       ( flip
1253           CmdRun.matchesMultipleProblem
1254           [ AvailableTarget
1255               "p-0.1"
1256               (CExeName "p2")
1257               (TargetBuildable () TargetRequestedByDefault)
1258               True
1259           , AvailableTarget
1260               "p-0.1"
1261               (CExeName "p1")
1262               (TargetBuildable () TargetRequestedByDefault)
1263               True
1264           ]
1265       , mkTargetPackage "p-0.1"
1266       )
1267     ]
1268
1269   reportSubCase "multiple targets"
1270   do
1271     (_, elaboratedPlan, _) <- planProject "targets/multiple-exes" config
1272     assertProjectDistinctTargets
1273       elaboratedPlan
1274       CmdRun.selectPackageTargets
1275       CmdRun.selectComponentTarget
1276       [ mkTargetComponent "p-0.1" (CExeName "p1")
1277       , mkTargetComponent "p-0.1" (CExeName "p2")
1278       ]
1279       [ ("p-0.1-inplace-p1", CExeName "p1")
1280       , ("p-0.1-inplace-p2", CExeName "p2")
1281       ]
1282
1283   reportSubCase "exes-disabled"
1284   assertProjectTargetProblems
1285     "targets/exes-disabled"
1286     config
1287     CmdRun.selectPackageTargets
1288     CmdRun.selectComponentTarget
1289     [
1290       ( flip
1291           TargetProblemNoneEnabled
1292           [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True
1293           ]
1294       , mkTargetPackage "p-0.1"
1295       )
1296     ]
1297
1298   reportSubCase "empty-pkg"
1299   assertProjectTargetProblems
1300     "targets/empty-pkg"
1301     config
1302     CmdRun.selectPackageTargets
1303     CmdRun.selectComponentTarget
1304     [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")
1305     ]
1306
1307   reportSubCase "lib-only"
1308   assertProjectTargetProblems
1309     "targets/lib-only"
1310     config
1311     CmdRun.selectPackageTargets
1312     CmdRun.selectComponentTarget
1313     [ (CmdRun.noExesProblem, mkTargetPackage "p-0.1")
1314     ]
1315
1316 testTargetProblemsTest :: ProjectConfig -> (String -> IO ()) -> Assertion
1317 testTargetProblemsTest config reportSubCase = do
1318   reportSubCase "disabled by config"
1319   assertProjectTargetProblems
1320     "targets/tests-disabled"
1321     config
1322       { projectConfigLocalPackages =
1323           (projectConfigLocalPackages config)
1324             { packageConfigTests = toFlag False
1325             }
1326       }
1327     CmdTest.selectPackageTargets
1328     CmdTest.selectComponentTarget
1329     [
1330       ( flip
1331           TargetProblemNoneEnabled
1332           [ AvailableTarget
1333               "p-0.1"
1334               (CTestName "user-disabled")
1335               TargetDisabledByUser
1336               True
1337           , AvailableTarget
1338               "p-0.1"
1339               (CTestName "solver-disabled")
1340               TargetDisabledByUser
1341               True
1342           ]
1343       , mkTargetPackage "p-0.1"
1344       )
1345     ]
1346
1347   reportSubCase "disabled by solver & buildable false"
1348   assertProjectTargetProblems
1349     "targets/tests-disabled"
1350     config
1351     CmdTest.selectPackageTargets
1352     CmdTest.selectComponentTarget
1353     [
1354       ( flip
1355           TargetProblemNoneEnabled
1356           [ AvailableTarget
1357               "p-0.1"
1358               (CTestName "user-disabled")
1359               TargetDisabledBySolver
1360               True
1361           , AvailableTarget
1362               "p-0.1"
1363               (CTestName "solver-disabled")
1364               TargetDisabledBySolver
1365               True
1366           ]
1367       , mkTargetPackage "p-0.1"
1368       )
1369     ,
1370       ( flip
1371           TargetProblemNoneEnabled
1372           [ AvailableTarget
1373               "q-0.1"
1374               (CTestName "buildable-false")
1375               TargetNotBuildable
1376               True
1377           ]
1378       , mkTargetPackage "q-0.1"
1379       )
1380     ]
1381
1382   reportSubCase "empty-pkg"
1383   assertProjectTargetProblems
1384     "targets/empty-pkg"
1385     config
1386     CmdTest.selectPackageTargets
1387     CmdTest.selectComponentTarget
1388     [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")
1389     ]
1390
1391   reportSubCase "no tests"
1392   assertProjectTargetProblems
1393     "targets/simple"
1394     config
1395     CmdTest.selectPackageTargets
1396     CmdTest.selectComponentTarget
1397     [ (CmdTest.noTestsProblem, mkTargetPackage "p-0.1")
1398     , (CmdTest.noTestsProblem, mkTargetPackage "q-0.1")
1399     ]
1400
1401   reportSubCase "not a test"
1402   assertProjectTargetProblems
1403     "targets/variety"
1404     config
1405     CmdTest.selectPackageTargets
1406     CmdTest.selectComponentTarget
1407     $ [
1408         ( const
1409             ( CmdTest.notTestProblem
1410                 "p-0.1"
1411                 (CLibName LMainLibName)
1412             )
1413         , mkTargetComponent "p-0.1" (CLibName LMainLibName)
1414         )
1415       ,
1416         ( const
1417             ( CmdTest.notTestProblem
1418                 "p-0.1"
1419                 (CExeName "an-exe")
1420             )
1421         , mkTargetComponent "p-0.1" (CExeName "an-exe")
1422         )
1423       ,
1424         ( const
1425             ( CmdTest.notTestProblem
1426                 "p-0.1"
1427                 (CFLibName "libp")
1428             )
1429         , mkTargetComponent "p-0.1" (CFLibName "libp")
1430         )
1431       ,
1432         ( const
1433             ( CmdTest.notTestProblem
1434                 "p-0.1"
1435                 (CBenchName "a-benchmark")
1436             )
1437         , mkTargetComponent "p-0.1" (CBenchName "a-benchmark")
1438         )
1439       ]
1440       ++ [ ( const
1441               ( CmdTest.isSubComponentProblem
1442                   "p-0.1"
1443                   cname
1444                   (ModuleTarget modname)
1445               )
1446            , mkTargetModule "p-0.1" cname modname
1447            )
1448          | (cname, modname) <-
1449             [ (CTestName "a-testsuite", "TestModule")
1450             , (CBenchName "a-benchmark", "BenchModule")
1451             , (CExeName "an-exe", "ExeModule")
1452             , ((CLibName LMainLibName), "P")
1453             ]
1454          ]
1455       ++ [ ( const
1456               ( CmdTest.isSubComponentProblem
1457                   "p-0.1"
1458                   cname
1459                   (FileTarget fname)
1460               )
1461            , mkTargetFile "p-0.1" cname fname
1462            )
1463          | (cname, fname) <-
1464             [ (CTestName "a-testsuite", "Test.hs")
1465             , (CBenchName "a-benchmark", "Bench.hs")
1466             , (CExeName "an-exe", "Main.hs")
1467             ]
1468          ]
1469
1470 testTargetProblemsBench :: ProjectConfig -> (String -> IO ()) -> Assertion
1471 testTargetProblemsBench config reportSubCase = do
1472   reportSubCase "disabled by config"
1473   assertProjectTargetProblems
1474     "targets/benchmarks-disabled"
1475     config
1476       { projectConfigLocalPackages =
1477           (projectConfigLocalPackages config)
1478             { packageConfigBenchmarks = toFlag False
1479             }
1480       }
1481     CmdBench.selectPackageTargets
1482     CmdBench.selectComponentTarget
1483     [
1484       ( flip
1485           TargetProblemNoneEnabled
1486           [ AvailableTarget
1487               "p-0.1"
1488               (CBenchName "user-disabled")
1489               TargetDisabledByUser
1490               True
1491           , AvailableTarget
1492               "p-0.1"
1493               (CBenchName "solver-disabled")
1494               TargetDisabledByUser
1495               True
1496           ]
1497       , mkTargetPackage "p-0.1"
1498       )
1499     ]
1500
1501   reportSubCase "disabled by solver & buildable false"
1502   assertProjectTargetProblems
1503     "targets/benchmarks-disabled"
1504     config
1505     CmdBench.selectPackageTargets
1506     CmdBench.selectComponentTarget
1507     [
1508       ( flip
1509           TargetProblemNoneEnabled
1510           [ AvailableTarget
1511               "p-0.1"
1512               (CBenchName "user-disabled")
1513               TargetDisabledBySolver
1514               True
1515           , AvailableTarget
1516               "p-0.1"
1517               (CBenchName "solver-disabled")
1518               TargetDisabledBySolver
1519               True
1520           ]
1521       , mkTargetPackage "p-0.1"
1522       )
1523     ,
1524       ( flip
1525           TargetProblemNoneEnabled
1526           [ AvailableTarget
1527               "q-0.1"
1528               (CBenchName "buildable-false")
1529               TargetNotBuildable
1530               True
1531           ]
1532       , mkTargetPackage "q-0.1"
1533       )
1534     ]
1535
1536   reportSubCase "empty-pkg"
1537   assertProjectTargetProblems
1538     "targets/empty-pkg"
1539     config
1540     CmdBench.selectPackageTargets
1541     CmdBench.selectComponentTarget
1542     [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")
1543     ]
1544
1545   reportSubCase "no benchmarks"
1546   assertProjectTargetProblems
1547     "targets/simple"
1548     config
1549     CmdBench.selectPackageTargets
1550     CmdBench.selectComponentTarget
1551     [ (CmdBench.noBenchmarksProblem, mkTargetPackage "p-0.1")
1552     , (CmdBench.noBenchmarksProblem, mkTargetPackage "q-0.1")
1553     ]
1554
1555   reportSubCase "not a benchmark"
1556   assertProjectTargetProblems
1557     "targets/variety"
1558     config
1559     CmdBench.selectPackageTargets
1560     CmdBench.selectComponentTarget
1561     $ [
1562         ( const
1563             ( CmdBench.componentNotBenchmarkProblem
1564                 "p-0.1"
1565                 (CLibName LMainLibName)
1566             )
1567         , mkTargetComponent "p-0.1" (CLibName LMainLibName)
1568         )
1569       ,
1570         ( const
1571             ( CmdBench.componentNotBenchmarkProblem
1572                 "p-0.1"
1573                 (CExeName "an-exe")
1574             )
1575         , mkTargetComponent "p-0.1" (CExeName "an-exe")
1576         )
1577       ,
1578         ( const
1579             ( CmdBench.componentNotBenchmarkProblem
1580                 "p-0.1"
1581                 (CFLibName "libp")
1582             )
1583         , mkTargetComponent "p-0.1" (CFLibName "libp")
1584         )
1585       ,
1586         ( const
1587             ( CmdBench.componentNotBenchmarkProblem
1588                 "p-0.1"
1589                 (CTestName "a-testsuite")
1590             )
1591         , mkTargetComponent "p-0.1" (CTestName "a-testsuite")
1592         )
1593       ]
1594       ++ [ ( const
1595               ( CmdBench.isSubComponentProblem
1596                   "p-0.1"
1597                   cname
1598                   (ModuleTarget modname)
1599               )
1600            , mkTargetModule "p-0.1" cname modname
1601            )
1602          | (cname, modname) <-
1603             [ (CTestName "a-testsuite", "TestModule")
1604             , (CBenchName "a-benchmark", "BenchModule")
1605             , (CExeName "an-exe", "ExeModule")
1606             , ((CLibName LMainLibName), "P")
1607             ]
1608          ]
1609       ++ [ ( const
1610               ( CmdBench.isSubComponentProblem
1611                   "p-0.1"
1612                   cname
1613                   (FileTarget fname)
1614               )
1615            , mkTargetFile "p-0.1" cname fname
1616            )
1617          | (cname, fname) <-
1618             [ (CTestName "a-testsuite", "Test.hs")
1619             , (CBenchName "a-benchmark", "Bench.hs")
1620             , (CExeName "an-exe", "Main.hs")
1621             ]
1622          ]
1623
1624 testTargetProblemsHaddock :: ProjectConfig -> (String -> IO ()) -> Assertion
1625 testTargetProblemsHaddock config reportSubCase = do
1626   reportSubCase "all-disabled"
1627   assertProjectTargetProblems
1628     "targets/all-disabled"
1629     config
1630     ( let haddockFlags = mkHaddockFlags False True True False
1631        in CmdHaddock.selectPackageTargets haddockFlags
1632     )
1633     CmdHaddock.selectComponentTarget
1634     [
1635       ( flip
1636           TargetProblemNoneEnabled
1637           [ AvailableTarget
1638               "p-0.1"
1639               (CBenchName "user-disabled")
1640               TargetDisabledByUser
1641               True
1642           , AvailableTarget
1643               "p-0.1"
1644               (CTestName "solver-disabled")
1645               TargetDisabledBySolver
1646               True
1647           , AvailableTarget
1648               "p-0.1"
1649               (CExeName "buildable-false")
1650               TargetNotBuildable
1651               True
1652           , AvailableTarget
1653               "p-0.1"
1654               (CLibName LMainLibName)
1655               TargetNotBuildable
1656               True
1657           ]
1658       , mkTargetPackage "p-0.1"
1659       )
1660     ]
1661
1662   reportSubCase "empty-pkg"
1663   assertProjectTargetProblems
1664     "targets/empty-pkg"
1665     config
1666     ( let haddockFlags = mkHaddockFlags False False False False
1667        in CmdHaddock.selectPackageTargets haddockFlags
1668     )
1669     CmdHaddock.selectComponentTarget
1670     [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")
1671     ]
1672
1673   reportSubCase "enabled component kinds"
1674   -- When we explicitly enable all the component kinds then selecting the
1675   -- whole package selects those component kinds too
1676   (_, elaboratedPlan, _) <- planProject "targets/variety" config
1677   let haddockFlags = mkHaddockFlags True True True True
1678    in assertProjectDistinctTargets
1679         elaboratedPlan
1680         (CmdHaddock.selectPackageTargets haddockFlags)
1681         CmdHaddock.selectComponentTarget
1682         [mkTargetPackage "p-0.1"]
1683         [ ("p-0.1-inplace", (CLibName LMainLibName))
1684         , ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")
1685         , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite")
1686         , ("p-0.1-inplace-an-exe", CExeName "an-exe")
1687         , ("p-0.1-inplace-libp", CFLibName "libp")
1688         ]
1689
1690   reportSubCase "disabled component kinds"
1691   -- When we explicitly disable all the component kinds then selecting the
1692   -- whole package only selects the library
1693   let haddockFlags = mkHaddockFlags False False False False
1694    in assertProjectDistinctTargets
1695         elaboratedPlan
1696         (CmdHaddock.selectPackageTargets haddockFlags)
1697         CmdHaddock.selectComponentTarget
1698         [mkTargetPackage "p-0.1"]
1699         [("p-0.1-inplace", (CLibName LMainLibName))]
1700
1701   reportSubCase "requested component kinds"
1702   -- When we selecting the package with an explicit filter then it does not
1703   -- matter if the config was to disable all the component kinds
1704   let haddockFlags = mkHaddockFlags False False False False
1705    in assertProjectDistinctTargets
1706         elaboratedPlan
1707         (CmdHaddock.selectPackageTargets haddockFlags)
1708         CmdHaddock.selectComponentTarget
1709         [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just FLibKind)
1710         , TargetPackage TargetExplicitNamed ["p-0.1"] (Just ExeKind)
1711         , TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)
1712         , TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind)
1713         ]
1714         [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")
1715         , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite")
1716         , ("p-0.1-inplace-an-exe", CExeName "an-exe")
1717         , ("p-0.1-inplace-libp", CFLibName "libp")
1718         ]
1719   where
1720     mkHaddockFlags flib exe test bench =
1721       defaultHaddockFlags
1722         { haddockForeignLibs = toFlag flib
1723         , haddockExecutables = toFlag exe
1724         , haddockTestSuites = toFlag test
1725         , haddockBenchmarks = toFlag bench
1726         }
1727
1728 assertProjectDistinctTargets
1729   :: forall err
1730    . (Eq err, Show err)
1731   => ElaboratedInstallPlan
1732   -> (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k])
1733   -> (forall k. SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k)
1734   -> [TargetSelector]
1735   -> [(UnitId, ComponentName)]
1736   -> Assertion
1737 assertProjectDistinctTargets
1738   elaboratedPlan
1739   selectPackageTargets
1740   selectComponentTarget
1741   targetSelectors
1742   expectedTargets
1743     | Right targets <- results =
1744         distinctTargetComponents targets @?= Set.fromList expectedTargets
1745     | otherwise =
1746         assertFailure $
1747           "assertProjectDistinctTargets: expected "
1748             ++ "(Right targets) but got "
1749             ++ show results
1750     where
1751       results =
1752         resolveTargets
1753           selectPackageTargets
1754           selectComponentTarget
1755           elaboratedPlan
1756           Nothing
1757           targetSelectors
1758
1759 assertProjectTargetProblems
1760   :: forall err
1761    . (Eq err, Show err)
1762   => FilePath
1763   -> ProjectConfig
1764   -> ( forall k
1765         . TargetSelector
1766        -> [AvailableTarget k]
1767        -> Either (TargetProblem err) [k]
1768      )
1769   -> ( forall k
1770         . SubComponentTarget
1771        -> AvailableTarget k
1772        -> Either (TargetProblem err) k
1773      )
1774   -> [(TargetSelector -> TargetProblem err, TargetSelector)]
1775   -> Assertion
1776 assertProjectTargetProblems
1777   testdir
1778   config
1779   selectPackageTargets
1780   selectComponentTarget
1781   cases = do
1782     (_, elaboratedPlan, _) <- planProject testdir config
1783     assertTargetProblems
1784       elaboratedPlan
1785       selectPackageTargets
1786       selectComponentTarget
1787       cases
1788
1789 assertTargetProblems
1790   :: forall err
1791    . (Eq err, Show err)
1792   => ElaboratedInstallPlan
1793   -> (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k])
1794   -> (forall k. SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k)
1795   -> [(TargetSelector -> TargetProblem err, TargetSelector)]
1796   -> Assertion
1797 assertTargetProblems elaboratedPlan selectPackageTargets selectComponentTarget =
1798   mapM_ (uncurry assertTargetProblem)
1799   where
1800     assertTargetProblem expected targetSelector =
1801       let res =
1802             resolveTargets
1803               selectPackageTargets
1804               selectComponentTarget
1805               elaboratedPlan
1806               Nothing
1807               [targetSelector]
1808        in case res of
1809             Left [problem] ->
1810               problem @?= expected targetSelector
1811             unexpected ->
1812               assertFailure $
1813                 "expected resolveTargets result: (Left [problem]) "
1814                   ++ "but got: "
1815                   ++ show unexpected
1816
1817 testExceptionInFindingPackage :: ProjectConfig -> Assertion
1818 testExceptionInFindingPackage config = do
1819   BadPackageLocations _ locs <-
1820     expectException "BadPackageLocations" $
1821       void $
1822         planProject testdir config
1823   case locs of
1824     [BadLocGlobEmptyMatch "./*.cabal"] -> return ()
1825     _ -> assertFailure "expected BadLocGlobEmptyMatch"
1826   cleanProject testdir
1827   where
1828     testdir = "exception/no-pkg"
1829
1830 testExceptionInFindingPackage2 :: ProjectConfig -> Assertion
1831 testExceptionInFindingPackage2 config = do
1832   BadPackageLocations _ locs <-
1833     expectException "BadPackageLocations" $
1834       void $
1835         planProject testdir config
1836   case locs of
1837     [BadPackageLocationFile (BadLocDirNoCabalFile ".")] -> return ()
1838     _ -> assertFailure $ "expected BadLocDirNoCabalFile, got " ++ show locs
1839   cleanProject testdir
1840   where
1841     testdir = "exception/no-pkg2"
1842
1843 testExceptionInProjectConfig :: ProjectConfig -> Assertion
1844 testExceptionInProjectConfig config = do
1845   BadPerPackageCompilerPaths ps <-
1846     expectException "BadPerPackageCompilerPaths" $
1847       void $
1848         planProject testdir config
1849   case ps of
1850     [(pn, "ghc")] | "foo" == pn -> return ()
1851     _ ->
1852       assertFailure $
1853         "expected (PackageName \"foo\",\"ghc\"), got "
1854           ++ show ps
1855   cleanProject testdir
1856   where
1857     testdir = "exception/bad-config"
1858
1859 testExceptionInConfigureStep :: ProjectConfig -> Assertion
1860 testExceptionInConfigureStep config = do
1861   (plan, res) <- executePlan =<< planProject testdir config
1862   (_pkga1, failure) <- expectPackageFailed plan res pkgidA1
1863   case buildFailureReason failure of
1864     ConfigureFailed _ -> return ()
1865     _ -> assertFailure $ "expected ConfigureFailed, got " ++ show failure
1866   cleanProject testdir
1867   where
1868     testdir = "exception/configure"
1869     pkgidA1 = PackageIdentifier "a" (mkVersion [1])
1870
1871 testExceptionInBuildStep :: ProjectConfig -> Assertion
1872 testExceptionInBuildStep config = do
1873   (plan, res) <- executePlan =<< planProject testdir config
1874   (_pkga1, failure) <- expectPackageFailed plan res pkgidA1
1875   expectBuildFailed failure
1876   where
1877     testdir = "exception/build"
1878     pkgidA1 = PackageIdentifier "a" (mkVersion [1])
1879
1880 testSetupScriptStyles :: ProjectConfig -> (String -> IO ()) -> Assertion
1881 testSetupScriptStyles config reportSubCase = do
1882   reportSubCase (show SetupCustomExplicitDeps)
1883
1884   plan0@(_, _, sharedConfig) <- planProject testdir1 config
1885
1886   let isOSX (Platform _ OSX) = True
1887       isOSX _ = False
1888       compilerVer = compilerVersion (pkgConfigCompiler sharedConfig)
1889   -- Skip the Custom tests when the shipped Cabal library is buggy
1890   unless
1891     ( (isOSX (pkgConfigPlatform sharedConfig) && (compilerVer < mkVersion [7, 10]))
1892         -- 9.10 ships Cabal 3.12.0.0 affected by #9940
1893         || (mkVersion [9, 10] <= compilerVer && compilerVer < mkVersion [9, 11])
1894     )
1895     $ do
1896       (plan1, res1) <- executePlan plan0
1897       pkg1 <- expectPackageInstalled plan1 res1 pkgidA
1898       elabSetupScriptStyle pkg1 @?= SetupCustomExplicitDeps
1899       hasDefaultSetupDeps pkg1 @?= Just False
1900       marker1 <- readFile (basedir </> testdir1 </> "marker")
1901       marker1 @?= "ok"
1902       removeFile (basedir </> testdir1 </> "marker")
1903
1904       -- implicit deps implies 'Cabal < 2' which conflicts w/ GHC 8.2 or later
1905       when (compilerVersion (pkgConfigCompiler sharedConfig) < mkVersion [8, 2]) $ do
1906         reportSubCase (show SetupCustomImplicitDeps)
1907         (plan2, res2) <- executePlan =<< planProject testdir2 config
1908         pkg2 <- expectPackageInstalled plan2 res2 pkgidA
1909         elabSetupScriptStyle pkg2 @?= SetupCustomImplicitDeps
1910         hasDefaultSetupDeps pkg2 @?= Just True
1911         marker2 <- readFile (basedir </> testdir2 </> "marker")
1912         marker2 @?= "ok"
1913         removeFile (basedir </> testdir2 </> "marker")
1914
1915       reportSubCase (show SetupNonCustomInternalLib)
1916       (plan3, res3) <- executePlan =<< planProject testdir3 config
1917       pkg3 <- expectPackageInstalled plan3 res3 pkgidA
1918       elabSetupScriptStyle pkg3 @?= SetupNonCustomInternalLib
1919   where
1920     {-
1921         --TODO: the SetupNonCustomExternalLib case is hard to test since it
1922         -- requires a version of Cabal that's later than the one we're testing
1923         -- e.g. needs a .cabal file that specifies cabal-version: >= 2.0
1924         -- and a corresponding Cabal package that we can use to try and build a
1925         -- default Setup.hs.
1926         reportSubCase (show SetupNonCustomExternalLib)
1927         (plan4, res4) <- executePlan =<< planProject testdir4 config
1928         pkg4          <- expectPackageInstalled plan4 res4 pkgidA
1929         pkgSetupScriptStyle pkg4 @?= SetupNonCustomExternalLib
1930     -}
1931
1932     testdir1 = "build/setup-custom1"
1933     testdir2 = "build/setup-custom2"
1934     testdir3 = "build/setup-simple"
1935     pkgidA = PackageIdentifier "a" (mkVersion [0, 1])
1936     -- The solver fills in default setup deps explicitly, but marks them as such
1937     hasDefaultSetupDeps =
1938       fmap defaultSetupDepends
1939         . setupBuildInfo
1940         . elabPkgDescription
1941
1942 -- | Test the behaviour with and without @--keep-going@
1943 testBuildKeepGoing :: ProjectConfig -> Assertion
1944 testBuildKeepGoing config = do
1945   -- P is expected to fail, Q does not depend on P but without
1946   -- parallel build and without keep-going then we don't build Q yet.
1947   (plan1, res1) <- executePlan =<< planProject testdir (config `mappend` keepGoing False)
1948   (_, failure1) <- expectPackageFailed plan1 res1 "p-0.1"
1949   expectBuildFailed failure1
1950   _ <- expectPackageConfigured plan1 res1 "q-0.1"
1951
1952   -- With keep-going then we should go on to successfully build Q
1953   (plan2, res2) <-
1954     executePlan
1955       =<< planProject testdir (config `mappend` keepGoing True)
1956   (_, failure2) <- expectPackageFailed plan2 res2 "p-0.1"
1957   expectBuildFailed failure2
1958   _ <- expectPackageInstalled plan2 res2 "q-0.1"
1959   return ()
1960   where
1961     testdir = "build/keep-going"
1962     keepGoing kg =
1963       mempty
1964         { projectConfigBuildOnly =
1965             mempty
1966               { projectConfigKeepGoing = toFlag kg
1967               }
1968         }
1969
1970 -- | Test we can successfully build packages from local tarball files.
1971 testBuildLocalTarball :: ProjectConfig -> Assertion
1972 testBuildLocalTarball config = do
1973   -- P is a tarball package, Q is a local dir package that depends on it.
1974   (plan, res) <- executePlan =<< planProject testdir config
1975   _ <- expectPackageInstalled plan res "p-0.1"
1976   _ <- expectPackageInstalled plan res "q-0.1"
1977   return ()
1978   where
1979     testdir = "build/local-tarball"
1980
1981 -- | See <https://github.com/haskell/cabal/issues/3324>
1982 --
1983 -- This test just doesn't seem to work on Windows,
1984 -- due filesystem woes.
1985 testRegressionIssue3324 :: ProjectConfig -> Assertion
1986 testRegressionIssue3324 config = when (buildOS /= Windows) $ do
1987   -- expected failure first time due to missing dep
1988   (plan1, res1) <- executePlan =<< planProject testdir config
1989   (_pkgq, failure) <- expectPackageFailed plan1 res1 "q-0.1"
1990   expectBuildFailed failure
1991
1992   -- add the missing dep, now it should work
1993   let qcabal = basedir </> testdir </> "q" </> "q.cabal"
1994   withFileFinallyRestore qcabal $ do
1995     tryFewTimes $ BS.appendFile qcabal ("  build-depends: p\n")
1996     (plan2, res2) <- executePlan =<< planProject testdir config
1997     _ <- expectPackageInstalled plan2 res2 "p-0.1"
1998     _ <- expectPackageInstalled plan2 res2 "q-0.1"
1999     return ()
2000   where
2001     testdir = "regression/3324"
2002
2003 -- | Test global program options are propagated correctly
2004 -- from ProjectConfig to ElaboratedInstallPlan
2005 testProgramOptionsAll :: ProjectConfig -> Assertion
2006 testProgramOptionsAll config0 = do
2007   -- P is a tarball package, Q is a local dir package that depends on it.
2008   (_, elaboratedPlan, _) <- planProject testdir config
2009   let packages = filterConfiguredPackages $ InstallPlan.toList elaboratedPlan
2010
2011   assertEqual
2012     "q"
2013     (Just [ghcFlag])
2014     (getProgArgs packages "q")
2015   assertEqual
2016     "p"
2017     (Just [ghcFlag])
2018     (getProgArgs packages "p")
2019   where
2020     testdir = "regression/program-options"
2021     programArgs = MapMappend (Map.fromList [("ghc", [ghcFlag])])
2022     ghcFlag = "-fno-full-laziness"
2023
2024     -- Insert flag into global config
2025     config =
2026       config0
2027         { projectConfigAllPackages =
2028             (projectConfigAllPackages config0)
2029               { packageConfigProgramArgs = programArgs
2030               }
2031         }
2032
2033 -- | Test local program options are propagated correctly
2034 -- from ProjectConfig to ElaboratedInstallPlan
2035 testProgramOptionsLocal :: ProjectConfig -> Assertion
2036 testProgramOptionsLocal config0 = do
2037   (_, elaboratedPlan, _) <- planProject testdir config
2038   let localPackages = filterConfiguredPackages $ InstallPlan.toList elaboratedPlan
2039
2040   assertEqual
2041     "q"
2042     (Just [ghcFlag])
2043     (getProgArgs localPackages "q")
2044   assertEqual
2045     "p"
2046     Nothing
2047     (getProgArgs localPackages "p")
2048   where
2049     testdir = "regression/program-options"
2050     programArgs = MapMappend (Map.fromList [("ghc", [ghcFlag])])
2051     ghcFlag = "-fno-full-laziness"
2052
2053     -- Insert flag into local config
2054     config =
2055       config0
2056         { projectConfigLocalPackages =
2057             (projectConfigLocalPackages config0)
2058               { packageConfigProgramArgs = programArgs
2059               }
2060         }
2061
2062 -- | Test package specific program options are propagated correctly
2063 -- from ProjectConfig to ElaboratedInstallPlan
2064 testProgramOptionsSpecific :: ProjectConfig -> Assertion
2065 testProgramOptionsSpecific config0 = do
2066   (_, elaboratedPlan, _) <- planProject testdir config
2067   let packages = filterConfiguredPackages $ InstallPlan.toList elaboratedPlan
2068
2069   assertEqual
2070     "q"
2071     (Nothing)
2072     (getProgArgs packages "q")
2073   assertEqual
2074     "p"
2075     (Just [ghcFlag])
2076     (getProgArgs packages "p")
2077   where
2078     testdir = "regression/program-options"
2079     programArgs = MapMappend (Map.fromList [("ghc", [ghcFlag])])
2080     ghcFlag = "-fno-full-laziness"
2081
2082     -- Insert flag into package "p" config
2083     config =
2084       config0
2085         { projectConfigSpecificPackage = MapMappend (Map.fromList [(mkPackageName "p", configArgs)])
2086         }
2087     configArgs =
2088       mempty
2089         { packageConfigProgramArgs = programArgs
2090         }
2091
2092 filterConfiguredPackages :: [ElaboratedPlanPackage] -> [ElaboratedConfiguredPackage]
2093 filterConfiguredPackages [] = []
2094 filterConfiguredPackages (InstallPlan.PreExisting _ : pkgs) = filterConfiguredPackages pkgs
2095 filterConfiguredPackages (InstallPlan.Installed elab : pkgs) = elab : filterConfiguredPackages pkgs
2096 filterConfiguredPackages (InstallPlan.Configured elab : pkgs) = elab : filterConfiguredPackages pkgs
2097
2098 getProgArgs :: [ElaboratedConfiguredPackage] -> String -> Maybe [String]
2099 getProgArgs [] _ = Nothing
2100 getProgArgs (elab : pkgs) name
2101   | pkgName (elabPkgSourceId elab) == mkPackageName name =
2102       Map.lookup "ghc" (elabProgramArgs elab)
2103   | otherwise =
2104       getProgArgs pkgs name
2105
2106 ---------------------------------
2107 -- Test utils to plan and build
2108 --
2109
2110 basedir :: FilePath
2111 basedir = "tests" </> "IntegrationTests2"
2112
2113 dirActions :: FilePath -> TS.DirActions IO
2114 dirActions testdir =
2115   defaultDirActions
2116     { TS.doesFileExist = \p ->
2117         TS.doesFileExist defaultDirActions (virtcwd </> p)
2118     , TS.doesDirectoryExist = \p ->
2119         TS.doesDirectoryExist defaultDirActions (virtcwd </> p)
2120     , TS.canonicalizePath = \p ->
2121         TS.canonicalizePath defaultDirActions (virtcwd </> p)
2122     , TS.getCurrentDirectory =
2123         TS.canonicalizePath defaultDirActions virtcwd
2124     }
2125   where
2126     virtcwd = basedir </> testdir
2127
2128 type ProjDetails =
2129   ( DistDirLayout
2130   , CabalDirLayout
2131   , ProjectConfig
2132   , [PackageSpecifier UnresolvedSourcePackage]
2133   , BuildTimeSettings
2134   )
2135
2136 configureProject :: FilePath -> ProjectConfig -> IO ProjDetails
2137 configureProject testdir cliConfig = do
2138   cabalDirLayout <- defaultCabalDirLayout
2139
2140   projectRootDir <- canonicalizePath (basedir </> testdir)
2141   isexplict <- doesFileExist (projectRootDir </> defaultProjectFile)
2142
2143   let projectRoot
2144         | isexplict = ProjectRootExplicit projectRootDir defaultProjectFile
2145         | otherwise = ProjectRootImplicit projectRootDir
2146       distDirLayout = defaultDistDirLayout projectRoot Nothing Nothing
2147
2148   -- Clear state between test runs. The state remains if the previous run
2149   -- ended in an exception (as we leave the files to help with debugging).
2150   cleanProject testdir
2151
2152   httpTransport <- configureTransport verbosity [] Nothing
2153
2154   (projectConfig, localPackages) <-
2155     rebuildProjectConfig
2156       verbosity
2157       httpTransport
2158       distDirLayout
2159       cliConfig
2160
2161   let buildSettings =
2162         resolveBuildTimeSettings
2163           verbosity
2164           cabalDirLayout
2165           projectConfig
2166
2167   return
2168     ( distDirLayout
2169     , cabalDirLayout
2170     , projectConfig
2171     , localPackages
2172     , buildSettings
2173     )
2174
2175 type PlanDetails =
2176   ( ProjDetails
2177   , ElaboratedInstallPlan
2178   , ElaboratedSharedConfig
2179   )
2180
2181 planProject :: FilePath -> ProjectConfig -> IO PlanDetails
2182 planProject testdir cliConfig = do
2183   projDetails@( distDirLayout
2184                 , cabalDirLayout
2185                 , projectConfig
2186                 , localPackages
2187                 , _buildSettings
2188                 ) <-
2189     configureProject testdir cliConfig
2190
2191   (elaboratedPlan, _, elaboratedShared, _, _) <-
2192     rebuildInstallPlan
2193       verbosity
2194       distDirLayout
2195       cabalDirLayout
2196       projectConfig
2197       localPackages
2198       Nothing
2199
2200   return
2201     ( projDetails
2202     , elaboratedPlan
2203     , elaboratedShared
2204     )
2205
2206 executePlan :: PlanDetails -> IO (ElaboratedInstallPlan, BuildOutcomes)
2207 executePlan
2208   ( (distDirLayout, cabalDirLayout, config, _, buildSettings)
2209     , elaboratedPlan
2210     , elaboratedShared
2211     ) = do
2212     let targets :: Map.Map UnitId [ComponentTarget]
2213         targets =
2214           Map.fromList
2215             [ (unitid, [ComponentTarget cname WholeComponent])
2216             | ts <- Map.elems (availableTargets elaboratedPlan)
2217             , AvailableTarget
2218                 { availableTargetStatus = TargetBuildable (unitid, cname) _
2219                 } <-
2220                 ts
2221             ]
2222         elaboratedPlan' =
2223           pruneInstallPlanToTargets
2224             TargetActionBuild
2225             targets
2226             elaboratedPlan
2227
2228     pkgsBuildStatus <-
2229       rebuildTargetsDryRun
2230         distDirLayout
2231         elaboratedShared
2232         elaboratedPlan'
2233
2234     let elaboratedPlan'' =
2235           improveInstallPlanWithUpToDatePackages
2236             pkgsBuildStatus
2237             elaboratedPlan'
2238
2239     buildOutcomes <-
2240       rebuildTargets
2241         verbosity
2242         config
2243         distDirLayout
2244         (cabalStoreDirLayout cabalDirLayout)
2245         elaboratedPlan''
2246         elaboratedShared
2247         pkgsBuildStatus
2248         -- Avoid trying to use act-as-setup mode:
2249         buildSettings{buildSettingNumJobs = Serial}
2250
2251     return (elaboratedPlan'', buildOutcomes)
2252
2253 cleanProject :: FilePath -> IO ()
2254 cleanProject testdir = do
2255   alreadyExists <- doesDirectoryExist distDir
2256   when alreadyExists $ removePathForcibly distDir
2257   where
2258     projectRoot = ProjectRootImplicit (basedir </> testdir)
2259     distDirLayout = defaultDistDirLayout projectRoot Nothing Nothing
2260     distDir = distDirectory distDirLayout
2261
2262 verbosity :: Verbosity
2263 verbosity = minBound -- normal --verbose --maxBound --minBound
2264
2265 -------------------------------------------
2266 -- Tasty integration to adjust the config
2267 --
2268
2269 withProjectConfig :: (ProjectConfig -> TestTree) -> TestTree
2270 withProjectConfig testtree =
2271   askOption $ \ghcPath ->
2272     testtree (mkProjectConfig ghcPath)
2273
2274 mkProjectConfig :: GhcPath -> ProjectConfig
2275 mkProjectConfig (GhcPath ghcPath) =
2276   mempty
2277     { projectConfigShared =
2278         mempty
2279           { projectConfigHcPath = maybeToFlag ghcPath
2280           }
2281     , projectConfigBuildOnly =
2282         mempty
2283           { projectConfigNumJobs = toFlag (Just 1)
2284           }
2285     }
2286   where
2287     maybeToFlag = maybe mempty toFlag
2288
2289 data GhcPath = GhcPath (Maybe FilePath)
2290   deriving (Typeable)
2291
2292 instance IsOption GhcPath where
2293   defaultValue = GhcPath Nothing
2294   optionName = Tagged "with-ghc"
2295   optionHelp = Tagged "The ghc compiler to use"
2296   parseValue = Just . GhcPath . Just
2297
2298 projectConfigOptionDescriptions :: [OptionDescription]
2299 projectConfigOptionDescriptions = [Option (Proxy :: Proxy GhcPath)]
2300
2301 ---------------------------------------
2302 -- HUint style utils for this context
2303 --
2304
2305 expectException :: Exception e => String -> IO a -> IO e
2306 expectException expected action = do
2307   res <- try action
2308   case res of
2309     Left e -> return e
2310     Right _ -> throwIO $ HUnitFailure Nothing $ "expected an exception " ++ expected
2311
2312 expectPackagePreExisting
2313   :: ElaboratedInstallPlan
2314   -> BuildOutcomes
2315   -> PackageId
2316   -> IO InstalledPackageInfo
2317 expectPackagePreExisting plan buildOutcomes pkgid = do
2318   planpkg <- expectPlanPackage plan pkgid
2319   case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of
2320     (InstallPlan.PreExisting pkg, Nothing) ->
2321       return pkg
2322     (_, buildResult) -> unexpectedBuildResult "PreExisting" planpkg buildResult
2323
2324 expectPackageConfigured
2325   :: ElaboratedInstallPlan
2326   -> BuildOutcomes
2327   -> PackageId
2328   -> IO ElaboratedConfiguredPackage
2329 expectPackageConfigured plan buildOutcomes pkgid = do
2330   planpkg <- expectPlanPackage plan pkgid
2331   case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of
2332     (InstallPlan.Configured pkg, Nothing) ->
2333       return pkg
2334     (_, buildResult) -> unexpectedBuildResult "Configured" planpkg buildResult
2335
2336 expectPackageInstalled
2337   :: ElaboratedInstallPlan
2338   -> BuildOutcomes
2339   -> PackageId
2340   -> IO ElaboratedConfiguredPackage
2341 expectPackageInstalled plan buildOutcomes pkgid = do
2342   planpkg <- expectPlanPackage plan pkgid
2343   case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of
2344     (InstallPlan.Configured pkg, Just (Right _result)) ->
2345       -- result isn't used by any test
2346       return pkg
2347     -- package can be installed in the global .store!
2348     -- (when installing from tarball!)
2349     (InstallPlan.Installed pkg, Nothing) ->
2350       return pkg
2351     (_, buildResult) -> unexpectedBuildResult "Installed" planpkg buildResult
2352
2353 expectPackageFailed
2354   :: ElaboratedInstallPlan
2355   -> BuildOutcomes
2356   -> PackageId
2357   -> IO (ElaboratedConfiguredPackage, BuildFailure)
2358 expectPackageFailed plan buildOutcomes pkgid = do
2359   planpkg <- expectPlanPackage plan pkgid
2360   case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of
2361     (InstallPlan.Configured pkg, Just (Left failure)) ->
2362       return (pkg, failure)
2363     (_, buildResult) -> unexpectedBuildResult "Failed" planpkg buildResult
2364
2365 unexpectedBuildResult
2366   :: String
2367   -> ElaboratedPlanPackage
2368   -> Maybe (Either BuildFailure BuildResult)
2369   -> IO a
2370 unexpectedBuildResult expected planpkg buildResult =
2371   throwIO $
2372     HUnitFailure Nothing $
2373       "expected to find "
2374         ++ display (packageId planpkg)
2375         ++ " in the "
2376         ++ expected
2377         ++ " state, but it is actually in the "
2378         ++ actual
2379         ++ " state."
2380   where
2381     actual = case (buildResult, planpkg) of
2382       (Nothing, InstallPlan.PreExisting{}) -> "PreExisting"
2383       (Nothing, InstallPlan.Configured{}) -> "Configured"
2384       (Just (Right _), InstallPlan.Configured{}) -> "Installed"
2385       (Just (Left _), InstallPlan.Configured{}) -> "Failed"
2386       (Nothing, InstallPlan.Installed{}) -> "Installed globally"
2387       _ -> "Impossible! " ++ show buildResult ++ show planpkg
2388
2389 expectPlanPackage
2390   :: ElaboratedInstallPlan
2391   -> PackageId
2392   -> IO ElaboratedPlanPackage
2393 expectPlanPackage plan pkgid =
2394   case [ pkg
2395        | pkg <- InstallPlan.toList plan
2396        , packageId pkg == pkgid
2397        ] of
2398     [pkg] -> return pkg
2399     [] ->
2400       throwIO $
2401         HUnitFailure Nothing $
2402           "expected to find "
2403             ++ display pkgid
2404             ++ " in the install plan but it's not there"
2405     _ ->
2406       throwIO $
2407         HUnitFailure Nothing $
2408           "expected to find only one instance of "
2409             ++ display pkgid
2410             ++ " in the install plan but there's several"
2411
2412 expectBuildFailed :: BuildFailure -> IO ()
2413 expectBuildFailed (BuildFailure _ (BuildFailed _)) = return ()
2414 expectBuildFailed (BuildFailure _ reason) =
2415   assertFailure $ "expected BuildFailed, got " ++ show reason
2416
2417 ---------------------------------------
2418 -- Other utils
2419 --
2420
2421 -- | Allow altering a file during a test, but then restore it afterwards
2422 --
2423 -- We read into the memory, as filesystems are tricky. (especially Windows)
2424 withFileFinallyRestore :: FilePath -> IO a -> IO a
2425 withFileFinallyRestore file action = do
2426   originalContents <- BS.readFile file
2427   action `finally` handle onIOError (tryFewTimes $ BS.writeFile file originalContents)
2428   where
2429     onIOError :: IOException -> IO ()
2430     onIOError e = putStrLn $ "WARNING: Cannot restore " ++ file ++ "; " ++ show e
2431
2432 -- Hopefully works around some Windows file-locking things.
2433 -- Use with care:
2434 --
2435 -- Try action 4 times, with small sleep in between,
2436 -- retrying if it fails for 'IOException' reason.
2437 --
2438 tryFewTimes :: forall a. IO a -> IO a
2439 tryFewTimes action = go (3 :: Int)
2440   where
2441     go :: Int -> IO a
2442     go !n
2443       | n <= 0 = action
2444       | otherwise = action `catch` onIOError n
2445
2446     onIOError :: Int -> IOException -> IO a
2447     onIOError n e = do
2448       hPutStrLn stderr $ "Trying " ++ show n ++ " after " ++ show e
2449       threadDelay 10000
2450       go (n - 1)
2451
2452 testNixFlags :: Assertion
2453 testNixFlags = do
2454   let gc = globalCommand []
2455   -- changing from the v1 to v2 build command does not change whether the "--enable-nix" flag
2456   -- sets the globalNix param of the GlobalFlags type to True even though the v2 command doesn't use it
2457   let nixEnabledFlags = getFlags gc . commandParseArgs gc True $ ["--enable-nix", "build"]
2458   let nixDisabledFlags = getFlags gc . commandParseArgs gc True $ ["--disable-nix", "build"]
2459   let nixDefaultFlags = getFlags gc . commandParseArgs gc True $ ["build"]
2460   True @=? isJust nixDefaultFlags
2461   True @=? isJust nixEnabledFlags
2462   True @=? isJust nixDisabledFlags
2463   Just True @=? (fromFlag . globalNix . fromJust $ nixEnabledFlags)
2464   Just False @=? (fromFlag . globalNix . fromJust $ nixDisabledFlags)
2465   Nothing @=? (fromFlag . globalNix . fromJust $ nixDefaultFlags)
2466
2467   -- Config file options
2468   trueConfig <- loadConfig verbosity (Flag (basedir </> "nix-config/nix-true"))
2469   falseConfig <- loadConfig verbosity (Flag (basedir </> "nix-config/nix-false"))
2470
2471   Just True @=? (fromFlag . globalNix . savedGlobalFlags $ trueConfig)
2472   Just False @=? (fromFlag . globalNix . savedGlobalFlags $ falseConfig)
2473   where
2474     fromFlag :: Flag Bool -> Maybe Bool
2475     fromFlag (Flag x) = Just x
2476     fromFlag NoFlag = Nothing
2477     getFlags :: CommandUI GlobalFlags -> CommandParse (GlobalFlags -> GlobalFlags, [String]) -> Maybe GlobalFlags
2478     getFlags cui (CommandReadyToGo (mkflags, _)) = Just . mkflags . commandDefaultFlags $ cui
2479     getFlags _ _ = Nothing
2480
2481 -- Tests whether config options are commented or not
2482 testConfigOptionComments :: Assertion
2483 testConfigOptionComments = do
2484   let
2485     -- \| Find the first line containing a target setting name.
2486     --
2487     -- If `isComment` is set, only comment lines will be found.
2488     findLineWith :: Bool -> String -> String -> String
2489     findLineWith isComment target text =
2490       case findLinesWith isComment target text of
2491         [] -> text
2492         (l : _) -> removeColonAndAfter l
2493
2494     -- \| Find lines containing a target setting name.
2495     findLinesWith :: Bool -> String -> String -> [String]
2496     findLinesWith isComment target
2497       | isComment = filter (isInfixOf ("-- " ++ target ++ ":")) . lines
2498       | otherwise = filter (isInfixOf (target ++ ":")) . lines
2499
2500     -- \| Transform @-- puppy: doggy@ into @-- puppy@.
2501     removeColonAndAfter :: String -> String
2502     removeColonAndAfter = takeWhile (/= ':')
2503
2504   cwd <- getCurrentDirectory
2505   let configFile = cwd </> basedir </> "config" </> "default-config"
2506   _ <- createDefaultConfigFile verbosity [] configFile
2507   defaultConfigFile <- readFile configFile
2508
2509   let
2510     -- TODO: These assertions are fairly weak. Potential improvements:
2511     --
2512     -- - Include the section name in the assertion, so that (e.g.) a
2513     --   `keep-temp-files` setting in the `haddock` section won't be confused
2514     --   with a `keep-temp-files` setting in the `init` section.
2515     --
2516     -- - Check all matching lines to confirm that settings are not listed
2517     --   multiple times. For example, `cabal-file` is listed twice right now,
2518     --   once under the `haddock` settings!
2519     --
2520     -- - Consume the file as we go, ensuring that the settings are in a given
2521     --   order.
2522     --
2523     -- - Check the generated config file into Git (replacing e.g. `$HOME` with
2524     --   a sentinel value) so changes show up in PR diffs.
2525     assertHasLine' :: Bool -> String -> String -> Assertion
2526     assertHasLine' isComment expected settingName =
2527       let actual = findLineWith isComment settingName defaultConfigFile
2528           messagePrefix =
2529             "Did not find expected line for setting "
2530               <> show settingName
2531               <> " in configuration file "
2532               <> configFile
2533        in assertEqual messagePrefix expected actual
2534
2535     assertHasLine :: String -> String -> Assertion
2536     assertHasLine = assertHasLine' False
2537
2538     assertHasCommentLine :: String -> String -> Assertion
2539     assertHasCommentLine = assertHasLine' True
2540
2541   "  url" `assertHasLine` "url"
2542   "  -- secure" `assertHasCommentLine` "secure"
2543   "  -- root-keys" `assertHasCommentLine` "root-keys"
2544   "  -- key-threshold" `assertHasCommentLine` "key-threshold"
2545
2546   "-- ignore-expiry" `assertHasCommentLine` "ignore-expiry"
2547   "-- http-transport" `assertHasCommentLine` "http-transport"
2548   "-- nix" `assertHasCommentLine` "nix"
2549   "-- store-dir" `assertHasCommentLine` "store-dir"
2550   "-- active-repositories" `assertHasCommentLine` "active-repositories"
2551   "-- local-no-index-repo" `assertHasCommentLine` "local-no-index-repo"
2552   "remote-repo-cache" `assertHasLine` "remote-repo-cache"
2553   "-- logs-dir" `assertHasCommentLine` "logs-dir"
2554   "-- default-user-config" `assertHasCommentLine` "default-user-config"
2555   "-- verbose" `assertHasCommentLine` "verbose"
2556   "-- compiler" `assertHasCommentLine` "compiler"
2557   "-- cabal-file" `assertHasCommentLine` "cabal-file"
2558   "-- keep-temp-files" `assertHasCommentLine` "keep-temp-files"
2559   "-- with-compiler" `assertHasCommentLine` "with-compiler"
2560   "-- with-hc-pkg" `assertHasCommentLine` "with-hc-pkg"
2561   "-- program-prefix" `assertHasCommentLine` "program-prefix"
2562   "-- program-suffix" `assertHasCommentLine` "program-suffix"
2563   "-- library-vanilla" `assertHasCommentLine` "library-vanilla"
2564   "-- library-profiling" `assertHasCommentLine` "library-profiling"
2565   "-- shared" `assertHasCommentLine` "shared"
2566   "-- static" `assertHasCommentLine` "static"
2567   "-- executable-dynamic" `assertHasCommentLine` "executable-dynamic"
2568   "-- executable-static" `assertHasCommentLine` "executable-static"
2569   "-- profiling" `assertHasCommentLine` "profiling"
2570   "-- executable-profiling" `assertHasCommentLine` "executable-profiling"
2571   "-- profiling-detail" `assertHasCommentLine` "profiling-detail"
2572   "-- library-profiling-detail" `assertHasCommentLine` "library-profiling-detail"
2573   "-- optimization" `assertHasCommentLine` "optimization"
2574   "-- debug-info" `assertHasCommentLine` "debug-info"
2575   "-- build-info" `assertHasCommentLine` "build-info"
2576   "-- library-for-ghci" `assertHasCommentLine` "library-for-ghci"
2577   "-- split-sections" `assertHasCommentLine` "split-sections"
2578   "-- split-objs" `assertHasCommentLine` "split-objs"
2579   "-- executable-stripping" `assertHasCommentLine` "executable-stripping"
2580   "-- library-stripping" `assertHasCommentLine` "library-stripping"
2581   "-- configure-option" `assertHasCommentLine` "configure-option"
2582   "-- user-install" `assertHasCommentLine` "user-install"
2583   "-- package-db" `assertHasCommentLine` "package-db"
2584   "-- flags" `assertHasCommentLine` "flags"
2585   "-- extra-include-dirs" `assertHasCommentLine` "extra-include-dirs"
2586   "-- deterministic" `assertHasCommentLine` "deterministic"
2587   "-- cid" `assertHasCommentLine` "cid"
2588   "-- extra-lib-dirs" `assertHasCommentLine` "extra-lib-dirs"
2589   "-- extra-lib-dirs-static" `assertHasCommentLine` "extra-lib-dirs-static"
2590   "-- extra-framework-dirs" `assertHasCommentLine` "extra-framework-dirs"
2591   "-- extra-prog-path" `assertHasLine` "extra-prog-path"
2592   "-- instantiate-with" `assertHasCommentLine` "instantiate-with"
2593   "-- tests" `assertHasCommentLine` "tests"
2594   "-- coverage" `assertHasCommentLine` "coverage"
2595   "-- library-coverage" `assertHasCommentLine` "library-coverage"
2596   "-- exact-configuration" `assertHasCommentLine` "exact-configuration"
2597   "-- benchmarks" `assertHasCommentLine` "benchmarks"
2598   "-- relocatable" `assertHasCommentLine` "relocatable"
2599   "-- response-files" `assertHasCommentLine` "response-files"
2600   "-- allow-depending-on-private-libs" `assertHasCommentLine` "allow-depending-on-private-libs"
2601   "-- cabal-lib-version" `assertHasCommentLine` "cabal-lib-version"
2602   "-- append" `assertHasCommentLine` "append"
2603   "-- backup" `assertHasCommentLine` "backup"
2604   "-- constraint" `assertHasCommentLine` "constraint"
2605   "-- preference" `assertHasCommentLine` "preference"
2606   "-- solver" `assertHasCommentLine` "solver"
2607   "-- allow-older" `assertHasCommentLine` "allow-older"
2608   "-- allow-newer" `assertHasCommentLine` "allow-newer"
2609   "-- write-ghc-environment-files" `assertHasCommentLine` "write-ghc-environment-files"
2610   "-- documentation" `assertHasCommentLine` "documentation"
2611   "-- doc-index-file" `assertHasCommentLine` "doc-index-file"
2612   "-- only-download" `assertHasCommentLine` "only-download"
2613   "-- target-package-db" `assertHasCommentLine` "target-package-db"
2614   "-- max-backjumps" `assertHasCommentLine` "max-backjumps"
2615   "-- reorder-goals" `assertHasCommentLine` "reorder-goals"
2616   "-- count-conflicts" `assertHasCommentLine` "count-conflicts"
2617   "-- fine-grained-conflicts" `assertHasCommentLine` "fine-grained-conflicts"
2618   "-- minimize-conflict-set" `assertHasCommentLine` "minimize-conflict-set"
2619   "-- independent-goals" `assertHasCommentLine` "independent-goals"
2620   "-- prefer-oldest" `assertHasCommentLine` "prefer-oldest"
2621   "-- shadow-installed-packages" `assertHasCommentLine` "shadow-installed-packages"
2622   "-- strong-flags" `assertHasCommentLine` "strong-flags"
2623   "-- allow-boot-library-installs" `assertHasCommentLine` "allow-boot-library-installs"
2624   "-- reject-unconstrained-dependencies" `assertHasCommentLine` "reject-unconstrained-dependencies"
2625   "-- reinstall" `assertHasCommentLine` "reinstall"
2626   "-- avoid-reinstalls" `assertHasCommentLine` "avoid-reinstalls"
2627   "-- force-reinstalls" `assertHasCommentLine` "force-reinstalls"
2628   "-- upgrade-dependencies" `assertHasCommentLine` "upgrade-dependencies"
2629   "-- index-state" `assertHasCommentLine` "index-state"
2630   "-- root-cmd" `assertHasCommentLine` "root-cmd"
2631   "-- symlink-bindir" `assertHasCommentLine` "symlink-bindir"
2632   "build-summary" `assertHasLine` "build-summary"
2633   "-- build-log" `assertHasCommentLine` "build-log"
2634   "remote-build-reporting" `assertHasLine` "remote-build-reporting"
2635   "-- report-planning-failure" `assertHasCommentLine` "report-planning-failure"
2636   "-- per-component" `assertHasCommentLine` "per-component"
2637   "-- run-tests" `assertHasCommentLine` "run-tests"
2638   "jobs" `assertHasLine` "jobs"
2639   "-- keep-going" `assertHasCommentLine` "keep-going"
2640   "-- offline" `assertHasCommentLine` "offline"
2641   "-- lib" `assertHasCommentLine` "lib"
2642   "-- package-env" `assertHasCommentLine` "package-env"
2643   "-- overwrite-policy" `assertHasCommentLine` "overwrite-policy"
2644   "-- install-method" `assertHasCommentLine` "install-method"
2645   "installdir" `assertHasLine` "installdir"
2646   "-- token" `assertHasCommentLine` "token"
2647   "-- username" `assertHasCommentLine` "username"
2648   "-- password" `assertHasCommentLine` "password"
2649   "-- password-command" `assertHasCommentLine` "password-command"
2650   "-- builddir" `assertHasCommentLine` "builddir"
2651
2652   "  -- hoogle" `assertHasCommentLine` "hoogle"
2653   "  -- html" `assertHasCommentLine` "html"
2654   "  -- html-location" `assertHasCommentLine` "html-location"
2655   "  -- executables" `assertHasCommentLine` "executables"
2656   "  -- foreign-libraries" `assertHasCommentLine` "foreign-libraries"
2657   "  -- all" `assertHasCommentLine` "all"
2658   "  -- internal" `assertHasCommentLine` "internal"
2659   "  -- css" `assertHasCommentLine` "css"
2660   "  -- hyperlink-source" `assertHasCommentLine` "hyperlink-source"
2661   "  -- quickjump" `assertHasCommentLine` "quickjump"
2662   "  -- hscolour-css" `assertHasCommentLine` "hscolour-css"
2663   "  -- contents-location" `assertHasCommentLine` "contents-location"
2664   "  -- index-location" `assertHasCommentLine` "index-location"
2665   "  -- base-url" `assertHasCommentLine` "base-url"
2666   "  -- resources-dir" `assertHasCommentLine` "resources-dir"
2667   "  -- output-dir" `assertHasCommentLine` "output-dir"
2668   "  -- use-unicode" `assertHasCommentLine` "use-unicode"
2669
2670   "  -- interactive" `assertHasCommentLine` "interactive"
2671   "  -- quiet" `assertHasCommentLine` "quiet"
2672   "  -- no-comments" `assertHasCommentLine` "no-comments"
2673   "  -- minimal" `assertHasCommentLine` "minimal"
2674   "  -- cabal-version" `assertHasCommentLine` "cabal-version"
2675   "  -- license" `assertHasCommentLine` "license"
2676   "  -- extra-doc-file" `assertHasCommentLine` "extra-doc-file"
2677   "  -- test-dir" `assertHasCommentLine` "test-dir"
2678   "  -- simple" `assertHasCommentLine` "simple"
2679   "  -- language" `assertHasCommentLine` "language"
2680   "  -- application-dir" `assertHasCommentLine` "application-dir"
2681   "  -- source-dir" `assertHasCommentLine` "source-dir"
2682
2683   "  -- prefix" `assertHasCommentLine` "prefix"
2684   "  -- bindir" `assertHasCommentLine` "bindir"
2685   "  -- libdir" `assertHasCommentLine` "libdir"
2686   "  -- libsubdir" `assertHasCommentLine` "libsubdir"
2687   "  -- dynlibdir" `assertHasCommentLine` "dynlibdir"
2688   "  -- libexecdir" `assertHasCommentLine` "libexecdir"
2689   "  -- libexecsubdir" `assertHasCommentLine` "libexecsubdir"
2690   "  -- datadir" `assertHasCommentLine` "datadir"
2691   "  -- datasubdir" `assertHasCommentLine` "datasubdir"
2692   "  -- docdir" `assertHasCommentLine` "docdir"
2693   "  -- htmldir" `assertHasCommentLine` "htmldir"
2694   "  -- haddockdir" `assertHasCommentLine` "haddockdir"
2695   "  -- sysconfdir" `assertHasCommentLine` "sysconfdir"
2696
2697   "  -- alex-location" `assertHasCommentLine` "alex-location"
2698   "  -- ar-location" `assertHasCommentLine` "ar-location"
2699   "  -- c2hs-location" `assertHasCommentLine` "c2hs-location"
2700   "  -- cpphs-location" `assertHasCommentLine` "cpphs-location"
2701   "  -- doctest-location" `assertHasCommentLine` "doctest-location"
2702   "  -- gcc-location" `assertHasCommentLine` "gcc-location"
2703   "  -- ghc-location" `assertHasCommentLine` "ghc-location"
2704   "  -- ghc-pkg-location" `assertHasCommentLine` "ghc-pkg-location"
2705   "  -- ghcjs-location" `assertHasCommentLine` "ghcjs-location"
2706   "  -- ghcjs-pkg-location" `assertHasCommentLine` "ghcjs-pkg-location"
2707   "  -- greencard-location" `assertHasCommentLine` "greencard-location"
2708   "  -- haddock-location" `assertHasCommentLine` "haddock-location"
2709   "  -- happy-location" `assertHasCommentLine` "happy-location"
2710   "  -- haskell-suite-location" `assertHasCommentLine` "haskell-suite-location"
2711   "  -- haskell-suite-pkg-location" `assertHasCommentLine` "haskell-suite-pkg-location"
2712   "  -- hmake-location" `assertHasCommentLine` "hmake-location"
2713   "  -- hpc-location" `assertHasCommentLine` "hpc-location"
2714   "  -- hscolour-location" `assertHasCommentLine` "hscolour-location"
2715   "  -- jhc-location" `assertHasCommentLine` "jhc-location"
2716   "  -- ld-location" `assertHasCommentLine` "ld-location"
2717   "  -- pkg-config-location" `assertHasCommentLine` "pkg-config-location"
2718   "  -- runghc-location" `assertHasCommentLine` "runghc-location"
2719   "  -- strip-location" `assertHasCommentLine` "strip-location"
2720   "  -- tar-location" `assertHasCommentLine` "tar-location"
2721   "  -- uhc-location" `assertHasCommentLine` "uhc-location"
2722
2723   "  -- alex-options" `assertHasCommentLine` "alex-options"
2724   "  -- ar-options" `assertHasCommentLine` "ar-options"
2725   "  -- c2hs-options" `assertHasCommentLine` "c2hs-options"
2726   "  -- cpphs-options" `assertHasCommentLine` "cpphs-options"
2727   "  -- doctest-options" `assertHasCommentLine` "doctest-options"
2728   "  -- gcc-options" `assertHasCommentLine` "gcc-options"
2729   "  -- ghc-options" `assertHasCommentLine` "ghc-options"
2730   "  -- ghc-pkg-options" `assertHasCommentLine` "ghc-pkg-options"
2731   "  -- ghcjs-options" `assertHasCommentLine` "ghcjs-options"
2732   "  -- ghcjs-pkg-options" `assertHasCommentLine` "ghcjs-pkg-options"
2733   "  -- greencard-options" `assertHasCommentLine` "greencard-options"
2734   "  -- haddock-options" `assertHasCommentLine` "haddock-options"
2735   "  -- happy-options" `assertHasCommentLine` "happy-options"
2736   "  -- haskell-suite-options" `assertHasCommentLine` "haskell-suite-options"
2737   "  -- haskell-suite-pkg-options" `assertHasCommentLine` "haskell-suite-pkg-options"
2738   "  -- hmake-options" `assertHasCommentLine` "hmake-options"
2739   "  -- hpc-options" `assertHasCommentLine` "hpc-options"
2740   "  -- hsc2hs-options" `assertHasCommentLine` "hsc2hs-options"
2741   "  -- hscolour-options" `assertHasCommentLine` "hscolour-options"
2742   "  -- jhc-options" `assertHasCommentLine` "jhc-options"
2743   "  -- ld-options" `assertHasCommentLine` "ld-options"
2744   "  -- pkg-config-options" `assertHasCommentLine` "pkg-config-options"
2745   "  -- runghc-options" `assertHasCommentLine` "runghc-options"
2746   "  -- strip-options" `assertHasCommentLine` "strip-options"
2747   "  -- tar-options" `assertHasCommentLine` "tar-options"
2748   "  -- uhc-options" `assertHasCommentLine` "uhc-options"
2749
2750 testIgnoreProjectFlag :: Assertion
2751 testIgnoreProjectFlag = do
2752   -- Coverage flag should be false globally by default (~/.cabal folder)
2753   (_, _, prjConfigGlobal, _, _) <- configureProject testdir ignoreSetConfig
2754   let globalCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigGlobal
2755   False @=? Flag.fromFlagOrDefault False globalCoverageFlag
2756   -- It is set to true in the cabal.project file
2757   (_, _, prjConfigLocal, _, _) <- configureProject testdir emptyConfig
2758   let localCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigLocal
2759   True @=? Flag.fromFlagOrDefault False localCoverageFlag
2760   where
2761     testdir = "build/ignore-project"
2762     emptyConfig = mempty
2763     ignoreSetConfig :: ProjectConfig
2764     ignoreSetConfig = mempty{projectConfigShared = mempty{projectConfigIgnoreProject = Flag True}}
2765
2766 cleanHaddockProject :: FilePath -> IO ()
2767 cleanHaddockProject testdir = do
2768   cleanProject testdir
2769   let haddocksdir = basedir </> testdir </> "haddocks"
2770   alreadyExists <- doesDirectoryExist haddocksdir
2771   when alreadyExists $ removePathForcibly haddocksdir
2772   let storedir = basedir </> testdir </> "store"
2773   alreadyExists' <- doesDirectoryExist storedir
2774   when alreadyExists' $ removePathForcibly storedir
2775
2776 testHaddockProjectDependencies :: ProjectConfig -> Assertion
2777 testHaddockProjectDependencies config = do
2778   (_, _, sharedConfig) <- planProject testdir config
2779   -- `haddock-project` is only supported by `haddock-2.26.1` and above which is
2780   -- shipped with `ghc-9.4`
2781   when (compilerVersion (pkgConfigCompiler sharedConfig) > mkVersion [9, 4]) $ do
2782     let dir = basedir </> testdir
2783     cleanHaddockProject testdir
2784     withCurrentDirectory dir $ do
2785       CmdHaddockProject.haddockProjectAction
2786         defaultHaddockProjectFlags
2787           { haddockProjectCommonFlags =
2788               defaultCommonSetupFlags
2789                 { setupVerbosity = Flag verbosity
2790                 }
2791           }
2792         ["all"]
2793         defaultGlobalFlags{globalStoreDir = Flag "store"}
2794
2795       let haddock = "haddocks" </> "async" </> "async.haddock"
2796       hasHaddock <- doesFileExist haddock
2797       unless hasHaddock $ assertFailure ("File `" ++ haddock ++ "` does not exist.")
2798     cleanHaddockProject testdir
2799   where
2800     testdir = "haddock-project/dependencies"