cabal-install/tests/IntegrationTests2.hs

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