IntegrationTests2.hs 65.2 KB
Newer Older
1
{-# LANGUAGE CPP #-}
2
{-# LANGUAGE DeriveDataTypeable #-}
3
4
5
6
7
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}

-- For the handy instance IsString PackageIdentifier
{-# OPTIONS_GHC -fno-warn-orphans #-}
8

9
module IntegrationTests2 where
10
11
12

import Distribution.Client.DistDirLayout
import Distribution.Client.ProjectConfig
13
import Distribution.Client.Config (getCabalDir)
14
15
import Distribution.Client.TargetSelector hiding (DirActions(..))
import qualified Distribution.Client.TargetSelector as TS (DirActions(..))
16
import Distribution.Client.ProjectPlanning
17
import Distribution.Client.ProjectPlanning.Types
18
import Distribution.Client.ProjectBuilding
19
20
import Distribution.Client.ProjectOrchestration
         ( resolveTargets, TargetProblemCommon(..), distinctTargetComponents )
21
import Distribution.Client.Types
22
23
         ( PackageLocation(..), UnresolvedSourcePackage
         , PackageSpecifier(..) )
24
25
import Distribution.Client.Targets
         ( UserConstraint(..), UserConstraintScope(UserAnyQualifier) )
26
import qualified Distribution.Client.InstallPlan as InstallPlan
27
import Distribution.Solver.Types.SourcePackage as SP
28
29
30
31
32
33
34
35
36
37
38
import Distribution.Solver.Types.ConstraintSource
         ( ConstraintSource(ConstraintSourceUnknown) )
import Distribution.Solver.Types.PackageConstraint
         ( PackageProperty(PackagePropertySource) )

import qualified Distribution.Client.CmdBuild   as CmdBuild
import qualified Distribution.Client.CmdRepl    as CmdRepl
import qualified Distribution.Client.CmdRun     as CmdRun
import qualified Distribution.Client.CmdTest    as CmdTest
import qualified Distribution.Client.CmdBench   as CmdBench
import qualified Distribution.Client.CmdHaddock as CmdHaddock
39

40
import Distribution.Package
41
import Distribution.PackageDescription
42
import qualified Distribution.Types.GenericPackageDescription as GPG
43
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
44
import Distribution.Simple.Setup (toFlag, HaddockFlags(..), defaultHaddockFlags)
45
46
import Distribution.Simple.Compiler
import Distribution.System
47
import Distribution.Version
48
import Distribution.ModuleName (ModuleName)
49
50
51
import Distribution.Verbosity
import Distribution.Text

52
53
54
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mempty, mappend)
#endif
55
56
import Data.List (sort)
import Data.String (IsString(..))
57
import qualified Data.Map as Map
58
import qualified Data.Set as Set
59
import Control.Monad
60
import Control.Exception hiding (assert)
61
62
63
64
65
import System.FilePath
import System.Directory

import Test.Tasty
import Test.Tasty.HUnit
66
67
68
69
import Test.Tasty.Options
import Data.Tagged (Tagged(..))
import Data.Proxy  (Proxy(..))
import Data.Typeable (Typeable)
70
71
72


main :: IO ()
73
74
75
76
77
78
79
main =
  defaultMainWithIngredients
    (defaultIngredients ++ [includingOptions projectConfigOptionDescriptions])
    (withProjectConfig $ \config ->
      testGroup "Integration tests (internal)"
                (tests config))

80

81
82
tests :: ProjectConfig -> [TestTree]
tests config =
83
84
85
    --TODO: tests for:
    -- * normal success
    -- * dry-run tests with changes
86
87
88
89
90
91
  [ testGroup "Discovery and planning" $
    [ testCase "find root"      testFindProjectRoot
    , testCase "find root fail" testExceptionFindProjectRoot
    , testCase "no package"    (testExceptionInFindingPackage config)
    , testCase "no package2"   (testExceptionInFindingPackage2 config)
    , testCase "proj conf1"    (testExceptionInProjectConfig config)
92
    ]
93
  , testGroup "Target selectors" $
94
95
96
97
98
99
    [ testCaseSteps "valid"             testTargetSelectors
    , testCase      "bad syntax"        testTargetSelectorBadSyntax
    , testCaseSteps "ambiguous syntax"  testTargetSelectorAmbiguous
    , testCase      "no current pkg"    testTargetSelectorNoCurrentPackage
    , testCase      "no targets"        testTargetSelectorNoTargets
    , testCase      "project empty"     testTargetSelectorProjectEmpty
100
101
102
103
104
105
106
    , testCase      "problems (common)"  (testTargetProblemsCommon config)
    , testCaseSteps "problems (build)"   (testTargetProblemsBuild config)
    , testCaseSteps "problems (repl)"    (testTargetProblemsRepl config)
    , testCaseSteps "problems (run)"     (testTargetProblemsRun config)
    , testCaseSteps "problems (test)"    (testTargetProblemsTest config)
    , testCaseSteps "problems (bench)"   (testTargetProblemsBench config)
    , testCaseSteps "problems (haddock)" (testTargetProblemsHaddock config)
107
    ]
108
  , testGroup "Exceptions during building (local inplace)" $
109
110
    [ testCase "configure"   (testExceptionInConfigureStep config)
    , testCase "build"       (testExceptionInBuildStep config)
111
112
113
--    , testCase "register"   testExceptionInRegisterStep
    ]
    --TODO: need to repeat for packages for the store
114
115
    --TODO: need to check we can build sub-libs, foreign libs and exes
    -- components for non-local packages / packages in the store.
116

117
118
  , testGroup "Successful builds" $
    [ testCaseSteps "Setup script styles" (testSetupScriptStyles config)
119
    , testCase      "keep-going"          (testBuildKeepGoing config)
120
    , testCase      "local tarball"       (testBuildLocalTarball config)
121
122
    ]

123
  , testGroup "Regression tests" $
124
    [ testCase "issue #3324" (testRegressionIssue3324 config)
125
    ]
126
127
  ]

128

129
130
131
132
133
134
testFindProjectRoot :: Assertion
testFindProjectRoot = do
    Left (BadProjectRootExplicitFile file) <- findProjectRoot (Just testdir)
                                                              (Just testfile)
    file @?= testfile
  where
Edward Z. Yang's avatar
Edward Z. Yang committed
135
    testdir  = basedir </> "exception" </> "no-pkg2"
136
137
    testfile = "bklNI8O1OpOUuDu3F4Ij4nv3oAqN"

138

139
140
141
142
143
144
testExceptionFindProjectRoot :: Assertion
testExceptionFindProjectRoot = do
    Right (ProjectRootExplicit dir _) <- findProjectRoot (Just testdir) Nothing
    cwd <- getCurrentDirectory
    dir @?= cwd </> testdir
  where
Edward Z. Yang's avatar
Edward Z. Yang committed
145
    testdir = basedir </> "exception" </> "no-pkg2"
146

147

148
149
150
151
152
153
154
155
testTargetSelectors :: (String -> IO ()) -> Assertion
testTargetSelectors reportSubCase = do
    (_, _, _, localPackages, _) <- configureProject testdir config
    let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir)
                                                       localPackages

    reportSubCase "cwd"
    do Right ts <- readTargetSelectors' []
156
       ts @?= [TargetPackage TargetImplicitCwd ["p-0.1"] Nothing]
157
158
159
160
161
162
163
164
165
166
167
168
169
170

    reportSubCase "all"
    do Right ts <- readTargetSelectors'
                     ["all", ":all"]
       ts @?= replicate 2 (TargetAllPackages Nothing)

    reportSubCase "filter"
    do Right ts <- readTargetSelectors'
                     [ "libs",  ":cwd:libs"
                     , "flibs", ":cwd:flibs"
                     , "exes",  ":cwd:exes"
                     , "tests", ":cwd:tests"
                     , "benchmarks", ":cwd:benchmarks"]
       zipWithM_ (@?=) ts
171
         [ TargetPackage TargetImplicitCwd ["p-0.1"] (Just kind)
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
         | kind <- concatMap (replicate 2) [LibKind .. ]
         ]

    reportSubCase "all:filter"
    do Right ts <- readTargetSelectors'
                     [ "all:libs",  ":all:libs"
                     , "all:flibs", ":all:flibs"
                     , "all:exes",  ":all:exes"
                     , "all:tests", ":all:tests"
                     , "all:benchmarks", ":all:benchmarks"]
       zipWithM_ (@?=) ts
         [ TargetAllPackages (Just kind)
         | kind <- concatMap (replicate 2) [LibKind .. ]
         ]

    reportSubCase "pkg"
    do Right ts <- readTargetSelectors'
                     [       ":pkg:p", ".",  "./",   "p.cabal"
                     , "q",  ":pkg:q", "q/", "./q/", "q/q.cabal"]
191
192
       ts @?= replicate 4 (mkTargetPackage "p-0.1")
           ++ replicate 5 (mkTargetPackage "q-0.1")
193
194
195
196
197
198
199
200
201
202
203
204
205
206

    reportSubCase "pkg:filter"
    do Right ts <- readTargetSelectors'
                     [ "p:libs",  ".:libs",  ":pkg:p:libs"
                     , "p:flibs", ".:flibs", ":pkg:p:flibs"
                     , "p:exes",  ".:exes",  ":pkg:p:exes"
                     , "p:tests", ".:tests",  ":pkg:p:tests"
                     , "p:benchmarks", ".:benchmarks", ":pkg:p:benchmarks"
                     , "q:libs",  "q/:libs", ":pkg:q:libs"
                     , "q:flibs", "q/:flibs", ":pkg:q:flibs"
                     , "q:exes",  "q/:exes", ":pkg:q:exes"
                     , "q:tests", "q/:tests", ":pkg:q:tests"
                     , "q:benchmarks", "q/:benchmarks", ":pkg:q:benchmarks"]
       zipWithM_ (@?=) ts $
207
         [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just kind)
208
209
         | kind <- concatMap (replicate 3) [LibKind .. ]
         ] ++
210
         [ TargetPackage TargetExplicitNamed ["q-0.1"] (Just kind)
211
212
213
214
215
216
217
         | kind <- concatMap (replicate 3) [LibKind .. ]
         ]

    reportSubCase "component"
    do Right ts <- readTargetSelectors'
                     [ "p", "lib:p", "p:lib:p", ":pkg:p:lib:p"
                     ,      "lib:q", "q:lib:q", ":pkg:q:lib:q" ]
218
219
       ts @?= replicate 4 (TargetComponent "p-0.1" CLibName WholeComponent)
           ++ replicate 3 (TargetComponent "q-0.1" CLibName WholeComponent)
220
221
222
223

    reportSubCase "module"
    do Right ts <- readTargetSelectors'
                     [ "P", "lib:p:P", "p:p:P", ":pkg:p:lib:p:module:P"
224
225
                     , "QQ", "lib:q:QQ", "q:q:QQ", ":pkg:q:lib:q:module:QQ"
                     , "pexe:PMain" -- p:P or q:QQ would be ambiguous here
226
227
                     , "qexe:QMain" -- package p vs component p
                     ]
228
       ts @?= replicate 4 (TargetComponent "p-0.1" CLibName (ModuleTarget "P"))
229
           ++ replicate 4 (TargetComponent "q-0.1" CLibName (ModuleTarget "QQ"))
230
231
           ++ [ TargetComponent "p-0.1" (CExeName "pexe") (ModuleTarget "PMain")
              , TargetComponent "q-0.1" (CExeName "qexe") (ModuleTarget "QMain")
232
233
234
235
236
237
              ]

    reportSubCase "file"
    do Right ts <- readTargetSelectors'
                     [ "./P.hs", "p:P.lhs", "lib:p:P.hsc", "p:p:P.hsc",
                                 ":pkg:p:lib:p:file:P.y"
238
239
                     , "q/QQ.hs", "q:QQ.lhs", "lib:q:QQ.hsc", "q:q:QQ.hsc",
                                  ":pkg:q:lib:q:file:QQ.y"
240
                     ]
241
       ts @?= replicate 5 (TargetComponent "p-0.1" CLibName (FileTarget "P"))
242
           ++ replicate 5 (TargetComponent "q-0.1" CLibName (FileTarget "QQ"))
243
244
245
246
247
248
249
250
251
       -- Note there's a bit of an inconsistency here: for the single-part
       -- syntax the target has to point to a file that exists, whereas for
       -- all the other forms we don't require that.

    cleanProject testdir
  where
    testdir = "targets/simple"
    config  = mempty

252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295

testTargetSelectorBadSyntax :: Assertion
testTargetSelectorBadSyntax = do
    (_, _, _, localPackages, _) <- configureProject testdir config
    let targets = [ "foo bar",  " foo"
                  , "foo:", "foo::bar"
                  , "foo: ", "foo: :bar"
                  , "a:b:c:d:e:f", "a:b:c:d:e:f:g:h" ]
    Left errs <- readTargetSelectors localPackages targets
    zipWithM_ (@?=) errs (map TargetSelectorUnrecognised targets)
    cleanProject testdir
  where
    testdir = "targets/empty"
    config  = mempty


testTargetSelectorAmbiguous :: (String -> IO ()) -> Assertion
testTargetSelectorAmbiguous reportSubCase = do

    -- 'all' is ambiguous with packages and cwd components
    reportSubCase "ambiguous: all vs pkg"
    assertAmbiguous "all"
      [mkTargetPackage "all", mkTargetAllPackages]
      [mkpkg "all" []]

    reportSubCase "ambiguous: all vs cwd component"
    assertAmbiguous "all"
      [mkTargetComponent "other" (CExeName "all"), mkTargetAllPackages]
      [mkpkg "other" [mkexe "all"]]

    -- but 'all' is not ambiguous with non-cwd components, modules or files
    reportSubCase "unambiguous: all vs non-cwd comp, mod, file"
    assertUnambiguous "All"
      mkTargetAllPackages
      [ mkpkgAt "foo" [mkexe "All"] "foo"
      , mkpkg   "bar" [ mkexe "bar" `withModules` ["All"]
                      , mkexe "baz" `withCFiles` ["All"] ]
      ]

    -- filters 'libs', 'exes' etc are ambiguous with packages and
    -- local components
    reportSubCase "ambiguous: cwd-pkg filter vs pkg"
    assertAmbiguous "libs"
      [ mkTargetPackage "libs"
296
      , TargetPackage TargetImplicitCwd ["libs"] (Just LibKind) ]
297
298
299
300
301
      [mkpkg "libs" []]

    reportSubCase "ambiguous: filter vs cwd component"
    assertAmbiguous "exes"
      [ mkTargetComponent "other" (CExeName "exes")
302
      , TargetPackage TargetImplicitCwd ["other"] (Just ExeKind) ]
303
304
305
306
307
      [mkpkg "other" [mkexe "exes"]]

    -- but filters are not ambiguous with non-cwd components, modules or files
    reportSubCase "unambiguous: filter vs non-cwd comp, mod, file"
    assertUnambiguous "Libs"
308
      (TargetPackage TargetImplicitCwd ["bar"] (Just LibKind))
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
      [ mkpkgAt "foo" [mkexe "Libs"] "foo"
      , mkpkg   "bar" [ mkexe "bar" `withModules` ["Libs"]
                      , mkexe "baz" `withCFiles` ["Libs"] ]
      ]

    -- local components shadow packages and other components
    reportSubCase "unambiguous: cwd comp vs pkg, non-cwd comp"
    assertUnambiguous "foo"
      (mkTargetComponent "other" (CExeName "foo"))
      [ mkpkg   "other"  [mkexe "foo"]
      , mkpkgAt "other2" [mkexe "foo"] "other2" -- shadows non-local foo
      , mkpkg "foo" [] ]                        -- shadows package foo

    -- local components shadow modules and files
    reportSubCase "unambiguous: cwd comp vs module, file"
    assertUnambiguous "Foo"
      (mkTargetComponent "bar" (CExeName "Foo"))
      [ mkpkg "bar" [mkexe "Foo"]
      , mkpkg "other" [ mkexe "other"  `withModules` ["Foo"]
                      , mkexe "other2" `withCFiles`  ["Foo"] ]
      ]

    -- packages shadow non-local components
    reportSubCase "unambiguous: pkg vs non-cwd comp"
    assertUnambiguous "foo"
      (mkTargetPackage "foo")
      [ mkpkg "foo" []
      , mkpkgAt "other" [mkexe "foo"] "other" -- shadows non-local foo
      ]

    -- packages shadow modules and files
    reportSubCase "unambiguous: pkg vs module, file"
    assertUnambiguous "Foo"
      (mkTargetPackage "Foo")
      [ mkpkgAt "Foo" [] "foo"
      , mkpkg "other" [ mkexe "other"  `withModules` ["Foo"]
                      , mkexe "other2" `withCFiles`  ["Foo"] ]
      ]

    -- non-exact case packages and components are ambiguous
    reportSubCase "ambiguous: non-exact-case pkg names"
    assertAmbiguous "Foo"
      [ mkTargetPackage "foo", mkTargetPackage "FOO" ]
      [ mkpkg "foo" [], mkpkg "FOO" [] ]
    reportSubCase "ambiguous: non-exact-case comp names"
    assertAmbiguous "Foo"
      [ mkTargetComponent "bar" (CExeName "foo")
      , mkTargetComponent "bar" (CExeName "FOO") ]
      [ mkpkg "bar" [mkexe "foo", mkexe "FOO"] ]

    -- exact-case Module or File over non-exact case package or component
    reportSubCase "unambiguous: module vs non-exact-case pkg, comp"
    assertUnambiguous "Baz"
      (mkTargetModule "other" (CExeName "other") "Baz")
      [ mkpkg "baz" [mkexe "BAZ"]
      , mkpkg "other" [ mkexe "other"  `withModules` ["Baz"] ]
      ]
    reportSubCase "unambiguous: file vs non-exact-case pkg, comp"
    assertUnambiguous "Baz"
      (mkTargetFile "other" (CExeName "other") "Baz")
      [ mkpkg "baz" [mkexe "BAZ"]
      , mkpkg "other" [ mkexe "other"  `withCFiles` ["Baz"] ]
      ]
  where
    assertAmbiguous :: String
374
                    -> [TargetSelector]
375
376
377
                    -> [SourcePackage (PackageLocation a)]
                    -> Assertion
    assertAmbiguous str tss pkgs = do
378
379
380
381
      res <- readTargetSelectorsWith
               fakeDirActions
               (map SpecificSourcePackage pkgs)
               [str]
382
383
384
385
386
387
388
      case res of
        Left [TargetSelectorAmbiguous _ tss'] ->
          sort (map snd tss') @?= sort tss
        _ -> assertFailure $ "expected Left [TargetSelectorAmbiguous _ _], "
                          ++ "got " ++ show res

    assertUnambiguous :: String
389
                      -> TargetSelector
390
391
392
                      -> [SourcePackage (PackageLocation a)]
                      -> Assertion
    assertUnambiguous str ts pkgs = do
393
394
395
396
      res <- readTargetSelectorsWith
               fakeDirActions
               (map SpecificSourcePackage pkgs)
               [str]
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
      case res of
        Right [ts'] -> ts' @?= ts
        _ -> assertFailure $ "expected Right [Target...], "
                          ++ "got " ++ show res

    fakeDirActions = TS.DirActions {
      TS.doesFileExist       = \_p -> return True,
      TS.doesDirectoryExist  = \_p -> return True,
      TS.canonicalizePath    = \p -> return ("/" </> p), -- FilePath.Unix.</> ?
      TS.getCurrentDirectory = return "/"
    }

    mkpkg :: String -> [Executable] -> SourcePackage (PackageLocation a)
    mkpkg pkgidstr exes = mkpkgAt pkgidstr exes ""

    mkpkgAt :: String -> [Executable] -> FilePath
            -> SourcePackage (PackageLocation a)
    mkpkgAt pkgidstr exes loc =
      SourcePackage {
        packageInfoId = pkgid,
        packageSource = LocalUnpackedPackage loc,
        packageDescrOverride  = Nothing,
        SP.packageDescription = GenericPackageDescription {
          GPG.packageDescription = emptyPackageDescription { package = pkgid },
          genPackageFlags    = [],
          condLibrary        = Nothing,
          condSubLibraries   = [],
          condForeignLibs    = [],
          condExecutables    = [ ( exeName exe, CondNode exe [] [] )
                               | exe <- exes ],
          condTestSuites     = [],
          condBenchmarks     = []
        }
      }
      where
        Just pkgid = simpleParse pkgidstr

    mkexe :: String -> Executable
    mkexe name = mempty { exeName = fromString name }

    withModules :: Executable -> [String] -> Executable
    withModules exe mods =
      exe { buildInfo = (buildInfo exe) { otherModules = map fromString mods } }

    withCFiles :: Executable -> [FilePath] -> Executable
    withCFiles exe files =
      exe { buildInfo = (buildInfo exe) { cSources = files } }


446
mkTargetPackage :: PackageId -> TargetSelector
447
mkTargetPackage pkgid =
448
    TargetPackage TargetExplicitNamed [pkgid] Nothing
449

450
mkTargetComponent :: PackageId -> ComponentName -> TargetSelector
451
452
453
mkTargetComponent pkgid cname =
    TargetComponent pkgid cname WholeComponent

454
mkTargetModule :: PackageId -> ComponentName -> ModuleName -> TargetSelector
455
456
457
mkTargetModule pkgid cname mname =
    TargetComponent pkgid cname (ModuleTarget mname)

458
mkTargetFile :: PackageId -> ComponentName -> String -> TargetSelector
459
460
461
mkTargetFile pkgid cname fname =
    TargetComponent pkgid cname (FileTarget fname)

462
mkTargetAllPackages :: TargetSelector
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
mkTargetAllPackages = TargetAllPackages Nothing

instance IsString PackageIdentifier where
    fromString pkgidstr = pkgid
      where Just pkgid = simpleParse pkgidstr


testTargetSelectorNoCurrentPackage :: Assertion
testTargetSelectorNoCurrentPackage = do
    (_, _, _, localPackages, _) <- configureProject testdir config
    let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir)
                                                       localPackages
        targets = [ "libs",  ":cwd:libs"
                  , "flibs", ":cwd:flibs"
                  , "exes",  ":cwd:exes"
                  , "tests", ":cwd:tests"
                  , "benchmarks", ":cwd:benchmarks"]
    Left errs <- readTargetSelectors' targets
    zipWithM_ (@?=) errs
      [ TargetSelectorNoCurrentPackage ts
      | target <- targets
      , let Just ts = parseTargetString target
      ]
    cleanProject testdir
  where
    testdir = "targets/complex"
    config  = mempty


testTargetSelectorNoTargets :: Assertion
testTargetSelectorNoTargets = do
    (_, _, _, localPackages, _) <- configureProject testdir config
    Left errs <- readTargetSelectors localPackages []
496
    errs @?= [TargetSelectorNoTargetsInCwd]
497
498
499
500
501
502
503
504
505
506
    cleanProject testdir
  where
    testdir = "targets/complex"
    config  = mempty


testTargetSelectorProjectEmpty :: Assertion
testTargetSelectorProjectEmpty = do
    (_, _, _, localPackages, _) <- configureProject testdir config
    Left errs <- readTargetSelectors localPackages []
507
    errs @?= [TargetSelectorNoTargetsInProject]
508
509
510
511
512
513
    cleanProject testdir
  where
    testdir = "targets/empty"
    config  = mempty


514
515
516
517
518
519
520
521
522
testTargetProblemsCommon :: ProjectConfig -> Assertion
testTargetProblemsCommon config0 = do
    (_,elaboratedPlan,_) <- planProject testdir config

    let pkgIdMap :: Map.Map PackageName PackageId
        pkgIdMap = Map.fromList
                     [ (packageName p, packageId p)
                     | p <- InstallPlan.toList elaboratedPlan ]

523
524
        cases :: [( TargetSelector -> CmdBuild.TargetProblem
                  , TargetSelector
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
                  )]
        cases =
          [ -- Cannot resolve packages outside of the project
            ( \_ -> CmdBuild.TargetProblemCommon $
                    TargetProblemNoSuchPackage "foobar"
            , mkTargetPackage "foobar" )

            -- We cannot currently build components like testsuites or
            -- benchmarks from packages that are not local to the project
          , ( \_ -> CmdBuild.TargetProblemCommon $
                    TargetComponentNotProjectLocal
                      (pkgIdMap Map.! "filepath") (CTestName "filepath-tests")
                      WholeComponent
            , mkTargetComponent (pkgIdMap Map.! "filepath")
                                (CTestName "filepath-tests") )

            -- Components can be explicitly @buildable: False@
          , ( \_ -> CmdBuild.TargetProblemCommon $
                    TargetComponentNotBuildable "q-0.1" (CExeName "buildable-false") WholeComponent
            , mkTargetComponent "q-0.1" (CExeName "buildable-false") )

            -- Testsuites and benchmarks can be disabled by the solver if it
            -- cannot satisfy deps
          , ( \_ -> CmdBuild.TargetProblemCommon $
                    TargetOptionalStanzaDisabledBySolver "q-0.1" (CTestName "solver-disabled") WholeComponent
            , mkTargetComponent "q-0.1" (CTestName "solver-disabled") )

            -- Testsuites and benchmarks can be disabled explicitly by the
            -- user via config
          , ( \_ -> CmdBuild.TargetProblemCommon $
                    TargetOptionalStanzaDisabledByUser
                      "q-0.1" (CBenchName "user-disabled") WholeComponent
            , mkTargetComponent "q-0.1" (CBenchName "user-disabled") )

            -- An unknown package. The target selector resolution should only
            -- produce known packages, so this should not happen with the
            -- output from 'readTargetSelectors'.
          , ( \_ -> CmdBuild.TargetProblemCommon $
                    TargetProblemNoSuchPackage "foobar"
            , mkTargetPackage "foobar" )

            -- An unknown component of a known package. The target selector
            -- resolution should only produce known packages, so this should
            -- not happen with the output from 'readTargetSelectors'.
          , ( \_ -> CmdBuild.TargetProblemCommon $
                    TargetProblemNoSuchComponent "q-0.1" (CExeName "no-such")
            , mkTargetComponent "q-0.1" (CExeName "no-such") )
          ]
    assertTargetProblems
      elaboratedPlan
      CmdBuild.selectPackageTargets
      CmdBuild.selectComponentTarget
      CmdBuild.TargetProblemCommon
      cases
  where
    testdir = "targets/complex"
    config  = config0 {
      projectConfigLocalPackages = (projectConfigLocalPackages config0) {
        packageConfigBenchmarks = toFlag False
      }
    , projectConfigShared = (projectConfigShared config0) {
        projectConfigConstraints =
          [( UserConstraint (UserAnyQualifier "filepath") PackagePropertySource
           , ConstraintSourceUnknown )]
      }
    }


testTargetProblemsBuild :: ProjectConfig -> (String -> IO ()) -> Assertion
testTargetProblemsBuild config reportSubCase = do

    reportSubCase "empty-pkg"
    assertProjectTargetProblems
      "targets/empty-pkg" config
      CmdBuild.selectPackageTargets
      CmdBuild.selectComponentTarget
      CmdBuild.TargetProblemCommon
      [ ( CmdBuild.TargetProblemNoTargets, mkTargetPackage "p-0.1" )
      ]

    reportSubCase "all-disabled"
    assertProjectTargetProblems
      "targets/all-disabled"
      config {
        projectConfigLocalPackages = (projectConfigLocalPackages config) {
          packageConfigBenchmarks = toFlag False
        }
      }
      CmdBuild.selectPackageTargets
      CmdBuild.selectComponentTarget
      CmdBuild.TargetProblemCommon
      [ ( flip CmdBuild.TargetProblemNoneEnabled
               [ AvailableTarget "p-0.1" (CBenchName "user-disabled")
                                 TargetDisabledByUser True
               , AvailableTarget "p-0.1" (CTestName "solver-disabled")
                                 TargetDisabledBySolver True
               , AvailableTarget "p-0.1" (CExeName "buildable-false")
                                 TargetNotBuildable True
               , AvailableTarget "p-0.1" CLibName
                                 TargetNotBuildable True
               ]
        , mkTargetPackage "p-0.1" )
      ]

    reportSubCase "enabled component kinds"
    -- When we explicitly enable all the component kinds then selecting the
    -- whole package selects those component kinds too
    do (_,elaboratedPlan,_) <- planProject "targets/variety" config {
           projectConfigLocalPackages = (projectConfigLocalPackages config) {
             packageConfigTests      = toFlag True,
             packageConfigBenchmarks = toFlag True
           }
         }
       assertProjectDistinctTargets
         elaboratedPlan
         CmdBuild.selectPackageTargets
         CmdBuild.selectComponentTarget
         CmdBuild.TargetProblemCommon
         [ mkTargetPackage "p-0.1" ]
         [ ("p-0.1-inplace",             CLibName)
         , ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")
         , ("p-0.1-inplace-a-testsuite", CTestName  "a-testsuite")
         , ("p-0.1-inplace-an-exe",      CExeName   "an-exe")
         , ("p-0.1-inplace-libp",        CFLibName  "libp")
         ]

    reportSubCase "disabled component kinds"
    -- When we explicitly disable all the component kinds then selecting the
    -- whole package only selects the library, foreign lib and exes
    do (_,elaboratedPlan,_) <- planProject "targets/variety" config {
           projectConfigLocalPackages = (projectConfigLocalPackages config) {
             packageConfigTests      = toFlag False,
             packageConfigBenchmarks = toFlag False
           }
         }
       assertProjectDistinctTargets
         elaboratedPlan
         CmdBuild.selectPackageTargets
         CmdBuild.selectComponentTarget
         CmdBuild.TargetProblemCommon
         [ mkTargetPackage "p-0.1" ]
         [ ("p-0.1-inplace",        CLibName)
         , ("p-0.1-inplace-an-exe", CExeName  "an-exe")
         , ("p-0.1-inplace-libp",   CFLibName "libp")
         ]

    reportSubCase "requested component kinds"
    -- When we selecting the package with an explicit filter then we get those
    -- components even though we did not explicitly enable tests/benchmarks
    do (_,elaboratedPlan,_) <- planProject "targets/variety" config
       assertProjectDistinctTargets
         elaboratedPlan
         CmdBuild.selectPackageTargets
         CmdBuild.selectComponentTarget
         CmdBuild.TargetProblemCommon
680
681
         [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)
         , TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind)
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
         ]
         [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")
         , ("p-0.1-inplace-a-testsuite", CTestName  "a-testsuite")
         ]


testTargetProblemsRepl :: ProjectConfig -> (String -> IO ()) -> Assertion
testTargetProblemsRepl config reportSubCase = do

    reportSubCase "multiple-libs"
    assertProjectTargetProblems
      "targets/multiple-libs" config
      CmdRepl.selectPackageTargets
      CmdRepl.selectComponentTarget
      CmdRepl.TargetProblemCommon
      [ ( flip CmdRepl.TargetProblemMatchesMultiple
               [ AvailableTarget "p-0.1" CLibName
                   (TargetBuildable () TargetRequestedByDefault) True
               , AvailableTarget "q-0.1" CLibName
                   (TargetBuildable () TargetRequestedByDefault) True
               ]
        , mkTargetAllPackages )
      ]

    reportSubCase "multiple-exes"
    assertProjectTargetProblems
      "targets/multiple-exes" config
      CmdRepl.selectPackageTargets
      CmdRepl.selectComponentTarget
      CmdRepl.TargetProblemCommon
      [ ( flip CmdRepl.TargetProblemMatchesMultiple
               [ AvailableTarget "p-0.1" (CExeName "p2")
                   (TargetBuildable () TargetRequestedByDefault) True
               , AvailableTarget "p-0.1" (CExeName "p1")
                   (TargetBuildable () TargetRequestedByDefault) True
               ]
        , mkTargetPackage "p-0.1" )
      ]

    reportSubCase "multiple-tests"
    assertProjectTargetProblems
      "targets/multiple-tests" config
      CmdRepl.selectPackageTargets
      CmdRepl.selectComponentTarget
      CmdRepl.TargetProblemCommon
      [ ( flip CmdRepl.TargetProblemMatchesMultiple
               [ AvailableTarget "p-0.1" (CTestName "p2")
                   (TargetBuildable () TargetNotRequestedByDefault) True
               , AvailableTarget "p-0.1" (CTestName "p1")
                   (TargetBuildable () TargetNotRequestedByDefault) True
               ]
733
        , TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind) )
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
      ]

    reportSubCase "multiple targets"
    do (_,elaboratedPlan,_) <- planProject "targets/multiple-exes" config
       assertProjectDistinctTargets
         elaboratedPlan
         CmdRepl.selectPackageTargets
         CmdRepl.selectComponentTarget
         CmdRepl.TargetProblemCommon
         [ mkTargetComponent "p-0.1" (CExeName "p1")
         , mkTargetComponent "p-0.1" (CExeName "p2")
         ]
         [ ("p-0.1-inplace-p1", CExeName "p1")
         , ("p-0.1-inplace-p2", CExeName "p2")
         ]

    reportSubCase "libs-disabled"
    assertProjectTargetProblems
      "targets/libs-disabled" config
      CmdRepl.selectPackageTargets
      CmdRepl.selectComponentTarget
      CmdRepl.TargetProblemCommon
      [ ( flip CmdRepl.TargetProblemNoneEnabled
               [ AvailableTarget "p-0.1" CLibName TargetNotBuildable True ]
        , mkTargetPackage "p-0.1" )
      ]

    reportSubCase "exes-disabled"
    assertProjectTargetProblems
      "targets/exes-disabled" config
      CmdRepl.selectPackageTargets
      CmdRepl.selectComponentTarget
      CmdRepl.TargetProblemCommon
      [ ( flip CmdRepl.TargetProblemNoneEnabled
               [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True
               ]
        , mkTargetPackage "p-0.1" )
      ]

    reportSubCase "test-only"
    assertProjectTargetProblems
      "targets/test-only" config
      CmdRepl.selectPackageTargets
      CmdRepl.selectComponentTarget
      CmdRepl.TargetProblemCommon
      [ ( flip CmdRepl.TargetProblemNoneEnabled
               [ AvailableTarget "p-0.1" (CTestName "pexe")
                   (TargetBuildable () TargetNotRequestedByDefault) True
               ]
        , mkTargetPackage "p-0.1" )
      ]

    reportSubCase "empty-pkg"
    assertProjectTargetProblems
      "targets/empty-pkg" config
      CmdRepl.selectPackageTargets
      CmdRepl.selectComponentTarget
      CmdRepl.TargetProblemCommon
      [ ( CmdRepl.TargetProblemNoTargets, mkTargetPackage "p-0.1" )
      ]

    reportSubCase "requested component kinds"
    do (_,elaboratedPlan,_) <- planProject "targets/variety" config
       -- by default we only get the lib
       assertProjectDistinctTargets
         elaboratedPlan
         CmdRepl.selectPackageTargets
         CmdRepl.selectComponentTarget
         CmdRepl.TargetProblemCommon
803
         [ TargetPackage TargetExplicitNamed ["p-0.1"] Nothing ]
804
805
806
807
808
809
810
811
         [ ("p-0.1-inplace", CLibName) ]
       -- When we select the package with an explicit filter then we get those
       -- components even though we did not explicitly enable tests/benchmarks
       assertProjectDistinctTargets
         elaboratedPlan
         CmdRepl.selectPackageTargets
         CmdRepl.selectComponentTarget
         CmdRepl.TargetProblemCommon
812
         [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind) ]
813
814
815
816
817
818
         [ ("p-0.1-inplace-a-testsuite", CTestName  "a-testsuite") ]
       assertProjectDistinctTargets
         elaboratedPlan
         CmdRepl.selectPackageTargets
         CmdRepl.selectComponentTarget
         CmdRepl.TargetProblemCommon
819
         [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind) ]
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
         [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark") ]


testTargetProblemsRun :: ProjectConfig -> (String -> IO ()) -> Assertion
testTargetProblemsRun config reportSubCase = do

    reportSubCase "multiple-exes"
    assertProjectTargetProblems
      "targets/multiple-exes" config
      CmdRun.selectPackageTargets
      CmdRun.selectComponentTarget
      CmdRun.TargetProblemCommon
      [ ( flip CmdRun.TargetProblemMatchesMultiple
               [ AvailableTarget "p-0.1" (CExeName "p2")
                   (TargetBuildable () TargetRequestedByDefault) True
               , AvailableTarget "p-0.1" (CExeName "p1")
                   (TargetBuildable () TargetRequestedByDefault) True
               ]
        , mkTargetPackage "p-0.1" )
      ]

    reportSubCase "multiple targets"
    do (_,elaboratedPlan,_) <- planProject "targets/multiple-exes" config
       assertProjectDistinctTargets
         elaboratedPlan
         CmdRun.selectPackageTargets
         CmdRun.selectComponentTarget
         CmdRun.TargetProblemCommon
         [ mkTargetComponent "p-0.1" (CExeName "p1")
         , mkTargetComponent "p-0.1" (CExeName "p2")
         ]
         [ ("p-0.1-inplace-p1", CExeName "p1")
         , ("p-0.1-inplace-p2", CExeName "p2")
         ]

    reportSubCase "exes-disabled"
    assertProjectTargetProblems
      "targets/exes-disabled" config
      CmdRun.selectPackageTargets
      CmdRun.selectComponentTarget
      CmdRun.TargetProblemCommon
      [ ( flip CmdRun.TargetProblemNoneEnabled
               [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True
               ]
        , mkTargetPackage "p-0.1" )
      ]

    reportSubCase "empty-pkg"
    assertProjectTargetProblems
      "targets/empty-pkg" config
      CmdRun.selectPackageTargets
      CmdRun.selectComponentTarget
      CmdRun.TargetProblemCommon
      [ ( CmdRun.TargetProblemNoTargets, mkTargetPackage "p-0.1" )
      ]

876
    reportSubCase "lib-only"
877
    assertProjectTargetProblems
878
      "targets/lib-only" config
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
      CmdRun.selectPackageTargets
      CmdRun.selectComponentTarget
      CmdRun.TargetProblemCommon
      [ ( CmdRun.TargetProblemNoExes, mkTargetPackage "p-0.1" )
      ]


testTargetProblemsTest :: ProjectConfig -> (String -> IO ()) -> Assertion
testTargetProblemsTest config reportSubCase = do

    reportSubCase "disabled by config"
    assertProjectTargetProblems
      "targets/tests-disabled"
      config {
        projectConfigLocalPackages = (projectConfigLocalPackages config) {
          packageConfigTests = toFlag False
        }
      }
      CmdTest.selectPackageTargets
      CmdTest.selectComponentTarget
      CmdTest.TargetProblemCommon
      [ ( flip CmdTest.TargetProblemNoneEnabled
               [ AvailableTarget "p-0.1" (CTestName "user-disabled")
                                 TargetDisabledByUser True
               , AvailableTarget "p-0.1" (CTestName "solver-disabled")
                                 TargetDisabledByUser True
               ]
        , mkTargetPackage "p-0.1" )
      ]

    reportSubCase "disabled by solver & buildable false"
    assertProjectTargetProblems
      "targets/tests-disabled"
      config
      CmdTest.selectPackageTargets
      CmdTest.selectComponentTarget
      CmdTest.TargetProblemCommon
      [ ( flip CmdTest.TargetProblemNoneEnabled
               [ AvailableTarget "p-0.1" (CTestName "user-disabled")
                                 TargetDisabledBySolver True
               , AvailableTarget "p-0.1" (CTestName "solver-disabled")
                                 TargetDisabledBySolver True
               ]
        , mkTargetPackage "p-0.1" )

      , ( flip CmdTest.TargetProblemNoneEnabled
               [ AvailableTarget "q-0.1" (CTestName "buildable-false")
                                 TargetNotBuildable True
               ]
        , mkTargetPackage "q-0.1" )
      ]

    reportSubCase "empty-pkg"
    assertProjectTargetProblems
      "targets/empty-pkg" config
      CmdTest.selectPackageTargets
      CmdTest.selectComponentTarget
      CmdTest.TargetProblemCommon
      [ ( CmdTest.TargetProblemNoTargets, mkTargetPackage "p-0.1" )
      ]

    reportSubCase "no tests"
    assertProjectTargetProblems
      "targets/simple"
      config
      CmdTest.selectPackageTargets
      CmdTest.selectComponentTarget
      CmdTest.TargetProblemCommon
      [ ( CmdTest.TargetProblemNoTests, mkTargetPackage "p-0.1" )
      , ( CmdTest.TargetProblemNoTests, mkTargetPackage "q-0.1" )
      ]

    reportSubCase "not a test"
    assertProjectTargetProblems
      "targets/variety"
      config
      CmdTest.selectPackageTargets
      CmdTest.selectComponentTarget
      CmdTest.TargetProblemCommon $
      [ ( const (CmdTest.TargetProblemComponentNotTest
                  "p-0.1" CLibName)
        , mkTargetComponent "p-0.1" CLibName )

      , ( const (CmdTest.TargetProblemComponentNotTest
                  "p-0.1" (CExeName "an-exe"))
        , mkTargetComponent "p-0.1" (CExeName "an-exe") )

      , ( const (CmdTest.TargetProblemComponentNotTest
                  "p-0.1" (CFLibName "libp"))
        , mkTargetComponent "p-0.1" (CFLibName "libp") )

      , ( const (CmdTest.TargetProblemComponentNotTest
                  "p-0.1" (CBenchName "a-benchmark"))
        , mkTargetComponent "p-0.1" (CBenchName "a-benchmark") )
      ] ++
      [ ( const (CmdTest.TargetProblemIsSubComponent
                          "p-0.1" cname (ModuleTarget modname))
        , mkTargetModule "p-0.1" cname modname )
      | (cname, modname) <- [ (CTestName  "a-testsuite", "TestModule")
                            , (CBenchName "a-benchmark", "BenchModule")
                            , (CExeName   "an-exe",      "ExeModule")
                            , (CLibName,                 "P")
                            ]
      ] ++
      [ ( const (CmdTest.TargetProblemIsSubComponent
                          "p-0.1" cname (FileTarget fname))
        , mkTargetFile "p-0.1" cname fname)
      | (cname, fname) <- [ (CTestName  "a-testsuite", "Test.hs")
                          , (CBenchName "a-benchmark", "Bench.hs")
                          , (CExeName   "an-exe",      "Main.hs")
                          ]
      ]


testTargetProblemsBench :: ProjectConfig -> (String -> IO ()) -> Assertion
testTargetProblemsBench config reportSubCase = do

    reportSubCase "disabled by config"
    assertProjectTargetProblems
      "targets/benchmarks-disabled"
      config {
        projectConfigLocalPackages = (projectConfigLocalPackages config) {
          packageConfigBenchmarks = toFlag False
        }
      }
      CmdBench.selectPackageTargets
      CmdBench.selectComponentTarget
      CmdBench.TargetProblemCommon
      [ ( flip CmdBench.TargetProblemNoneEnabled
               [ AvailableTarget "p-0.1" (CBenchName "user-disabled")
                                 TargetDisabledByUser True
               , AvailableTarget "p-0.1" (CBenchName "solver-disabled")
                                 TargetDisabledByUser True
               ]
        , mkTargetPackage "p-0.1" )
      ]

    reportSubCase "disabled by solver & buildable false"
    assertProjectTargetProblems
      "targets/benchmarks-disabled"
      config
      CmdBench.selectPackageTargets
      CmdBench.selectComponentTarget
      CmdBench.TargetProblemCommon
      [ ( flip CmdBench.TargetProblemNoneEnabled
               [ AvailableTarget "p-0.1" (CBenchName "user-disabled")
                                 TargetDisabledBySolver True
               , AvailableTarget "p-0.1" (CBenchName "solver-disabled")
                                 TargetDisabledBySolver True
               ]
        , mkTargetPackage "p-0.1" )

      , ( flip CmdBench.TargetProblemNoneEnabled
               [ AvailableTarget "q-0.1" (CBenchName "buildable-false")
                                 TargetNotBuildable True
               ]
        , mkTargetPackage "q-0.1" )
      ]

    reportSubCase "empty-pkg"
    assertProjectTargetProblems
      "targets/empty-pkg" config
      CmdBench.selectPackageTargets
      CmdBench.selectComponentTarget
      CmdBench.TargetProblemCommon
      [ ( CmdBench.TargetProblemNoTargets, mkTargetPackage "p-0.1" )
      ]

    reportSubCase "no benchmarks"
    assertProjectTargetProblems
      "targets/simple"
      config
      CmdBench.selectPackageTargets
      CmdBench.selectComponentTarget
      CmdBench.TargetProblemCommon
      [ ( CmdBench.TargetProblemNoBenchmarks, mkTargetPackage "p-0.1" )
      , ( CmdBench.TargetProblemNoBenchmarks, mkTargetPackage "q-0.1" )
      ]

    reportSubCase "not a benchmark"
    assertProjectTargetProblems
      "targets/variety"
      config
      CmdBench.selectPackageTargets
      CmdBench.selectComponentTarget
      CmdBench.TargetProblemCommon $
      [ ( const (CmdBench.TargetProblemComponentNotBenchmark
                  "p-0.1" CLibName)
        , mkTargetComponent "p-0.1" CLibName )

      , ( const (CmdBench.TargetProblemComponentNotBenchmark
                  "p-0.1" (CExeName "an-exe"))
        , mkTargetComponent "p-0.1" (CExeName "an-exe") )

      , ( const (CmdBench.TargetProblemComponentNotBenchmark
                  "p-0.1" (CFLibName "libp"))
        , mkTargetComponent "p-0.1" (CFLibName "libp") )

      , ( const (CmdBench.TargetProblemComponentNotBenchmark
                  "p-0.1" (CTestName "a-testsuite"))
        , mkTargetComponent "p-0.1" (CTestName "a-testsuite") )
      ] ++
      [ ( const (CmdBench.TargetProblemIsSubComponent
                          "p-0.1" cname (ModuleTarget modname))
        , mkTargetModule "p-0.1" cname modname )
      | (cname, modname) <- [ (CTestName  "a-testsuite", "TestModule")
                            , (CBenchName "a-benchmark", "BenchModule")
                            , (CExeName   "an-exe",      "ExeModule")
                            , (CLibName,                 "P")
                            ]
      ] ++
      [ ( const (CmdBench.TargetProblemIsSubComponent
                          "p-0.1" cname (FileTarget fname))
        , mkTargetFile "p-0.1" cname fname)
      | (cname, fname) <- [ (CTestName  "a-testsuite", "Test.hs")
                          , (CBenchName "a-benchmark", "Bench.hs")
                          , (CExeName   "an-exe",      "Main.hs")
                          ]
      ]


testTargetProblemsHaddock :: ProjectConfig -> (String -> IO ()) -> Assertion
testTargetProblemsHaddock config reportSubCase = do

    reportSubCase "all-disabled"
    assertProjectTargetProblems
      "targets/all-disabled"
      config
      (let haddockFlags = mkHaddockFlags False True True False
        in CmdHaddock.selectPackageTargets haddockFlags)
      CmdHaddock.selectComponentTarget
      CmdHaddock.TargetProblemCommon
      [ ( flip CmdHaddock.TargetProblemNoneEnabled
               [ AvailableTarget "p-0.1" (CBenchName "user-disabled")
                                 TargetDisabledByUser True
               , AvailableTarget "p-0.1" (CTestName "solver-disabled")
                                 TargetDisabledBySolver True
               , AvailableTarget "p-0.1" (CExeName "buildable-false")
                                 TargetNotBuildable True
               , AvailableTarget "p-0.1" CLibName
                                 TargetNotBuildable True
               ]
        , mkTargetPackage "p-0.1" )
      ]

    reportSubCase "empty-pkg"
    assertProjectTargetProblems
      "targets/empty-pkg" config
      (let haddockFlags = mkHaddockFlags False False False False
        in CmdHaddock.selectPackageTargets haddockFlags)
      CmdHaddock.selectComponentTarget
      CmdHaddock.TargetProblemCommon
      [ ( CmdHaddock.TargetProblemNoTargets, mkTargetPackage "p-0.1" )
      ]

    reportSubCase "enabled component kinds"
    -- When we explicitly enable all the component kinds then selecting the
    -- whole package selects those component kinds too
    (_,elaboratedPlan,_) <- planProject "targets/variety" config
    let haddockFlags = mkHaddockFlags True True True True
     in assertProjectDistinctTargets
          elaboratedPlan
          (CmdHaddock.selectPackageTargets haddockFlags)
          CmdHaddock.selectComponentTarget
          CmdHaddock.TargetProblemCommon
          [ mkTargetPackage "p-0.1" ]
          [ ("p-0.1-inplace",             CLibName)
          , ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")
          , ("p-0.1-inplace-a-testsuite", CTestName  "a-testsuite")
          , ("p-0.1-inplace-an-exe",      CExeName   "an-exe")
          , ("p-0.1-inplace-libp",        CFLibName  "libp")
          ]

    reportSubCase "disabled component kinds"
    -- When we explicitly disable all the component kinds then selecting the
    -- whole package only selects the library
    let haddockFlags = mkHaddockFlags False False False False
     in assertProjectDistinctTargets
          elaboratedPlan
          (CmdHaddock.selectPackageTargets haddockFlags)
          CmdHaddock.selectComponentTarget
          CmdHaddock.TargetProblemCommon
          [ mkTargetPackage "p-0.1" ]
          [ ("p-0.1-inplace", CLibName) ]

    reportSubCase "requested component kinds"
    -- When we selecting the package with an explicit filter then it does not
    -- matter if the config was to disable all the component kinds
    let haddockFlags = mkHaddockFlags False False False False
     in assertProjectDistinctTargets
          elaboratedPlan
          (CmdHaddock.selectPackageTargets haddockFlags)
          CmdHaddock.selectComponentTarget
          CmdHaddock.TargetProblemCommon
1173
1174
1175
1176
          [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just FLibKind)
          , TargetPackage TargetExplicitNamed ["p-0.1"] (Just ExeKind)
          , TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)
          , TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind)
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
          ]
          [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")
          , ("p-0.1-inplace-a-testsuite", CTestName  "a-testsuite")
          , ("p-0.1-inplace-an-exe",      CExeName   "an-exe")
          , ("p-0.1-inplace-libp",        CFLibName  "libp")
          ]
  where
    mkHaddockFlags flib exe test bench =
      defaultHaddockFlags {
        haddockForeignLibs = toFlag flib,
        haddockExecutables = toFlag exe,
        haddockTestSuites  = toFlag test,
        haddockBenchmarks  = toFlag bench
      }

assertProjectDistinctTargets
  :: forall err. (Eq err, Show err) =>
     ElaboratedInstallPlan
1195
  -> (forall k. TargetSelector -> [AvailableTarget k] -> Either err [k])
1196
  -> (forall k. SubComponentTarget ->  AvailableTarget k  -> Either err  k )
1197
  -> (TargetProblemCommon -> err)
1198
  -> [TargetSelector]
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
  -> [(UnitId, ComponentName)]
  -> Assertion
assertProjectDistinctTargets elaboratedPlan
                             selectPackageTargets
                             selectComponentTarget
                             liftProblem
                             targetSelectors
                             expectedTargets
  | Right targets <- results
  = distinctTargetComponents targets @?= Set.fromList expectedTargets

  | otherwise
  = assertFailure $ "assertProjectDistinctTargets: expected "
                 ++ "(Right targets) but got " ++ show results
  where
    results = resolveTargets
                selectPackageTargets
                selectComponentTarget
                liftProblem
                elaboratedPlan
1219
                Nothing
1220
1221
1222
1223
1224
1225
                targetSelectors


assertProjectTargetProblems
  :: forall err. (Eq err, Show err) =>
     FilePath -> ProjectConfig
1226
  -> (forall k. TargetSelector
1227
1228
             -> [AvailableTarget k]
             -> Either err [k])
1229
  -> (forall k. SubComponentTarget
1230
1231
1232
             -> AvailableTarget k
             -> Either err k )
  -> (TargetProblemCommon -> err)
1233
  -> [(TargetSelector -> err, TargetSelector)]
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
  -> Assertion
assertProjectTargetProblems testdir config
                            selectPackageTargets
                            selectComponentTarget
                            liftProblem
                            cases = do
    (_,elaboratedPlan,_) <- planProject testdir config
    assertTargetProblems
      elaboratedPlan
      selectPackageTargets
      selectComponentTarget
      liftProblem
      cases


assertTargetProblems
  :: forall err. (Eq err, Show err) =>
     ElaboratedInstallPlan
1252
  -> (forall k. TargetSelector -> [AvailableTarget k] -> Either err [k])
1253
  -> (forall k. SubComponentTarget ->  AvailableTarget k  -> Either err  k )
1254
  -> (TargetProblemCommon -> err)
1255
  -> [(TargetSelector -> err, TargetSelector)]
1256
1257
1258
1259
1260
1261
1262
1263
1264
  -> Assertion
assertTargetProblems elaboratedPlan
                     selectPackageTargets
                     selectComponentTarget
                     liftProblem =
    mapM_ (uncurry assertTargetProblem)
  where
    assertTargetProblem expected targetSelector =
      let res = resolveTargets selectPackageTargets selectComponentTarget
1265
1266
                               liftProblem elaboratedPlan Nothing
                               [targetSelector] in
1267
1268
1269
1270
1271
1272
1273
1274
1275
      case res of
        Left [problem] ->
          problem @?= expected targetSelector

        unexpected ->
          assertFailure $ "expected resolveTargets result: (Left [problem]) "
                       ++ "but got: " ++ show unexpected


1276
1277
testExceptionInFindingPackage :: ProjectConfig -> Assertion
testExceptionInFindingPackage config = do
1278
    BadPackageLocations _ locs <- expectException "BadPackageLocations" $
1279
1280
1281
1282
1283
1284
1285
1286
1287
      void $ planProject testdir config
    case locs of
      [BadLocGlobEmptyMatch "./*.cabal"] -> return ()
      _ -> assertFailure "expected BadLocGlobEmptyMatch"
    cleanProject testdir
  where
    testdir = "exception/no-pkg"


1288
1289
testExceptionInFindingPackage2 :: ProjectConfig -> Assertion
testExceptionInFindingPackage2 config = do
1290
    BadPackageLocations _ locs <- expectException "BadPackageLocations" $
1291
1292
      void $ planProject testdir config
    case locs of
1293
1294
      [BadPackageLocationFile (BadLocDirNoCabalFile ".")] -> return ()
      _ -> assertFailure $ "expected BadLocDirNoCabalFile, got " ++ show locs
1295
1296
1297
1298
1299
    cleanProject testdir
  where
    testdir = "exception/no-pkg2"


1300
1301
1302
1303
1304
testExceptionInProjectConfig :: ProjectConfig -> Assertion
testExceptionInProjectConfig config = do
    BadPerPackageCompilerPaths ps <- expectException "BadPerPackageCompilerPaths" $
      void $ planProject testdir config
    case ps of
1305
      [(pn,"ghc")] | "foo" == pn -> return ()
1306
1307
1308
1309
1310
1311
1312
      _ -> assertFailure $ "expected (PackageName \"foo\",\"ghc\"), got "
                        ++ show ps
    cleanProject testdir
  where
    testdir = "exception/bad-config"


1313
1314
testExceptionInConfigureStep :: ProjectConfig -> Assertion
testExceptionInConfigureStep config = do
1315
1316
    (plan, res) <- executePlan =<< planProject testdir config
    (_pkga1, failure) <- expectPackageFailed plan res pkgidA1
1317
1318
    case buildFailureReason failure of
      ConfigureFailed _ -> return ()
1319
1320
1321
1322
      _ -> assertFailure $ "expected ConfigureFailed, got " ++ show failure 
    cleanProject testdir
  where
    testdir = "exception/configure"
1323
    pkgidA1 = PackageIdentifier "a" (mkVersion [1])
1324
1325


1326
1327
testExceptionInBuildStep :: ProjectConfig -> Assertion
testExceptionInBuildStep config = do
1328
1329
    (plan, res) <- executePlan =<< planProject testdir config
    (_pkga1, failure) <- expectPackageFailed plan res pkgidA1
1330
    expectBuildFailed failure
1331
1332
  where
    testdir = "exception/build"
1333
    pkgidA1 = PackageIdentifier "a" (mkVersion [1])
1334

1335
1336
1337
testSetupScriptStyles :: ProjectConfig -> (String -> IO ()) -> Assertion
testSetupScriptStyles config reportSubCase = do

1338
1339
  reportSubCase (show SetupCustomExplicitDeps)

1340
  plan0@(_,_,sharedConfig) <- planProject testdir1 config
1341
1342
1343
1344
1345
1346
1347
1348

  let isOSX (Platform _ OSX) = True
      isOSX _ = False
  -- Skip the Custom tests when the shipped Cabal library is buggy
  unless (isOSX (pkgConfigPlatform sharedConfig)
       && compilerVersion (pkgConfigCompiler sharedConfig) < mkVersion [7,10]) $ do

    (plan1, res1) <- executePlan plan0
1349
    (pkg1,  _)    <- expectPackageInstalled plan1 res1 pkgidA
1350
    elabSetupScriptStyle pkg1 @?= SetupCustomExplicitDeps
1351
1352
1353
1354
1355
    hasDefaultSetupDeps pkg1 @?= Just False
    marker1 <- readFile (basedir </> testdir1 </> "marker")
    marker1 @?= "ok"
    removeFile (basedir </> testdir1 </> "marker")

1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
    -- implicit deps implies 'Cabal < 2' which conflicts w/ GHC 8.2 or later
    when (compilerVersion (pkgConfigCompiler sharedConfig) < mkVersion [8,2]) $ do
      reportSubCase (show SetupCustomImplicitDeps)
      (plan2, res2) <- executePlan =<< planProject testdir2 config
      (pkg2,  _)    <- expectPackageInstalled plan2 res2 pkgidA
      elabSetupScriptStyle pkg2 @?= SetupCustomImplicitDeps
      hasDefaultSetupDeps pkg2 @?= Just True
      marker2 <- readFile (basedir </> testdir2 </> "marker")
      marker2 @?= "ok"
      removeFile (basedir </> testdir2 </> "marker")
1366
1367

    reportSubCase (show SetupNonCustomInternalLib)
1368
1369
    (plan3, res3) <- executePlan =<< planProject testdir3 config
    (pkg3,  _)    <- expectPackageInstalled plan3 res3 pkgidA
1370
    elabSetupScriptStyle pkg3 @?= SetupNonCustomInternalLib
1371
1372
1373
1374
1375
1376
1377
{-
    --TODO: the SetupNonCustomExternalLib case is hard to test since it
    -- requires a version of Cabal that's later than the one we're testing
    -- e.g. needs a .cabal file that specifies cabal-version: >= 2.0
    -- and a corresponding Cabal package that we can use to try and build a
    -- default Setup.hs.
    reportSubCase (show SetupNonCustomExternalLib)
1378
1379
    (plan4, res4) <- executePlan =<< planProject testdir4 config
    (pkg4,  _)    <- expectPackageInstalled plan4 res4 pkgidA
1380
1381
1382
1383
1384
1385
    pkgSetupScriptStyle pkg4 @?= SetupNonCustomExternalLib
-}
  where
    testdir1 = "build/setup-custom1"
    testdir2 = "build/setup-custom2"
    testdir3 = "build/setup-simple"
1386
    pkgidA   = PackageIdentifier "a" (mkVersion [0,1])
1387
1388
    -- The solver fills in default setup deps explicitly, but marks them as such
    hasDefaultSetupDeps = fmap defaultSetupDepends
1389
                        . setupBuildInfo . elabPkgDescription
1390

1391
1392
1393
1394
1395
1396
-- | Test the behaviour with and without @--keep-going@
--
testBuildKeepGoing :: ProjectConfig -> Assertion
testBuildKeepGoing config = do
    -- P is expected to fail, Q does not depend on P but without
    -- parallel build and without keep-going then we don't build Q yet.
1397
    (plan1, res1) <- executePlan =<< planProject testdir (config `mappend` keepGoing False)
1398
    (_, failure1) <- expectPackageFailed plan1 res1 "p-0.1"
1399
    expectBuildFailed failure1
1400
    _ <- expectPackageConfigured plan1 res1 "q-0.1"
1401
1402

    -- With keep-going then we should go on to sucessfully build Q
1403
    (plan2, res2) <- executePlan
1404
                 =<< planProject testdir (config `mappend` keepGoing True)
1405
    (_, failure2) <- expectPackageFailed plan2 res2 "p-0.1"
1406
    expectBuildFailed failure2
1407
    _ <- expectPackageInstalled plan2 res2 "q-0.1"
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
    return ()
  where
    testdir = "build/keep-going"
    keepGoing kg =
      mempty {
        projectConfigBuildOnly = mempty {
          projectConfigKeepGoing = toFlag kg
        }
      }

1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
-- | Test we can successfully build packages from local tarball files.
--
testBuildLocalTarball :: ProjectConfig -> Assertion
testBuildLocalTarball config = do
    -- P is a tarball package, Q is a local dir package that depends on it.
    (plan, res) <- executePlan =<< planProject testdir config
    _ <- expectPackageInstalled plan res "p-0.1"
    _ <- expectPackageInstalled plan res "q-0.1"
    return ()
  where
    testdir = "build/local-tarball"

1430
1431
-- | See <https://github.com/haskell/cabal/issues/3324>
--
1432
1433
testRegressionIssue3324 :: ProjectConfig -> Assertion
testRegressionIssue3324 config = do
1434
    -- expected failure first time due to missing dep
1435
    (plan1, res1) <- executePlan =<< planProject testdir config
1436
    (_pkgq, failure) <- expectPackageFailed plan1 res1 "q-0.1"
1437
1438
1439
1440
1441
1442
    expectBuildFailed failure

    -- add the missing dep, now it should work
    let qcabal  = basedir </> testdir </> "q" </> "q.cabal"
    withFileFinallyRestore qcabal $ do
      appendFile qcabal ("  build-depends: p\n")
1443
      (plan2, res2) <- executePlan =<< planProject testdir config
1444
1445
      _ <- expectPackageInstalled plan2 res2 "p-0.1"
      _ <- expectPackageInstalled plan2 res2 "q-0.1"
1446
1447
1448
      return ()
  where
    testdir = "regression/3324"
1449
1450
1451
1452
1453
1454


---------------------------------
-- Test utils to plan and build
--

1455
1456
1457
basedir :: FilePath
basedir = "tests" </> "IntegrationTests2"

1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
dirActions :: FilePath -> TS.DirActions IO
dirActions testdir =
    defaultDirActions {
      TS.doesFileExist       = \p ->
        TS.doesFileExist defaultDirActions (virtcwd </> p),

      TS.doesDirectoryExist  = \p ->
        TS.doesDirectoryExist defaultDirActions (virtcwd </> p),

      TS.canonicalizePath    = \p ->
        TS.canonicalizePath defaultDirActions (virtcwd </> p),

      TS.getCurrentDirectory =
        TS.canonicalizePath defaultDirActions virtcwd
    }
  where
    virtcwd = basedir </> testdir

type ProjDetails = (DistDirLayout,
                    CabalDirLayout,
                    ProjectConfig,
1479
                    [PackageSpecifier UnresolvedSourcePackage],
1480
1481
1482
1483
                    BuildTimeSettings)

configureProject :: FilePath -> ProjectConfig -> IO ProjDetails
configureProject testdir cliConfig = do
1484
    cabalDir <- getCabalDir
1485
1486
    let cabalDirLayout = defaultCabalDirLayout cabalDir

1487
1488
1489
1490
1491
1492
1493
    projectRootDir <- canonicalizePath (basedir </> testdir)
    isexplict      <- doesFileExist (projectRootDir </> "cabal.project")
    let projectRoot
          | isexplict = ProjectRootExplicit projectRootDir
                                           (projectRootDir </> "cabal.project")
          | otherwise = ProjectRootImplicit projectRootDir
        distDirLayout = defaultDistDirLayout projectRoot Nothing
1494
1495
1496
1497
1498

    -- Clear state between test runs. The state remains if the previous run
    -- ended in an exception (as we leave the files to help with debugging).
    cleanProject testdir

1499
1500
    (projectConfig, localPackages) <-
      rebuildProjectConfig verbosity
1501
                           distDirLayout
1502
1503
1504
1505
1506
1507
                           cliConfig

    let buildSettings = resolveBuildTimeSettings
                          verbosity cabalDirLayout
                          projectConfig

1508
1509
1510
1511
1512
1513
    return (distDirLayout,
            cabalDirLayout,
            projectConfig,
            localPackages,
            buildSettings)

1514
1515
1516
1517
type PlanDetails = (ProjDetails,
                    ElaboratedInstallPlan,
                    ElaboratedSharedConfig)

1518
1519
1520
planProject :: FilePath -> ProjectConfig -> IO PlanDetails
planProject testdir cliConfig = do

1521
1522
1523
1524
1525
1526
    projDetails@
      (distDirLayout,
       cabalDirLayout,
       projectConfig,
       localPackages,
       _buildSettings) <- configureProject testdir cliConfig
1527

1528
1529
    (elaboratedPlan, _, elaboratedShared) <-
      rebuildInstallPlan verbosity
1530
                         distDirLayout cabalDirLayout
1531
1532
                         projectConfig
                         localPackages
1533

1534
1535
1536
1537
1538
    return (projDetails,
            elaboratedPlan,
            elaboratedShared)

executePlan :: PlanDetails -> IO (ElaboratedInstallPlan, BuildOutcomes)
1539
executePlan ((distDirLayout, cabalDirLayout, _, _, buildSettings),
1540
1541
1542
             elaboratedPlan,
             elaboratedShared) = do

1543
1544
    let targets :: Map.Map UnitId [ComponentTarget]
        targets =
1545
          Map.fromList
1546
1547
1548
1549
1550
1551
1552
1553
1554
            [ (unitid, [ComponentTarget cname WholeComponent])
            | ts <- Map.elems (availableTargets elaboratedPlan)
            , AvailableTarget {
                availableTargetStatus = TargetBuildable (unitid, cname) _
              } <- ts
            ]
        elaboratedPlan' = pruneInstallPlanToTargets
                            TargetActionBuild targets
                            elaboratedPlan
1555

1556
1557
    pkgsBuildStatus <-
      rebuildTargetsDryRun distDirLayout elaboratedShared
1558
1559
                           elaboratedPlan'

1560
1561
1562
    let elaboratedPlan'' = improveInstallPlanWithUpToDatePackages
                             pkgsBuildStatus elaboratedPlan'

1563
1564
1565
    buildOutcomes <-
      rebuildTargets verbosity
                     distDirLayout
1566
                     (cabalStoreDirLayout cabalDirLayout)
1567
1568
1569
1570
1571
                     elaboratedPlan''
                     elaboratedShared
                     pkgsBuildStatus
                     -- Avoid trying to use act-as-setup mode:
                     buildSettings { buildSettingNumJobs = 1 }
1572

1573
    return (elaboratedPlan'', buildOutcomes)
1574
1575
1576
1577
1578
1579

cleanProject :: FilePath -> IO ()
cleanProject testdir = do
    alreadyExists <- doesDirectoryExist distDir
    when alreadyExists $ removeDirectoryRecursive distDir
  where
1580
1581
    projectRoot    = ProjectRootImplicit (basedir </> testdir)
    distDirLayout  = defaultDistDirLayout projectRoot Nothing
1582
1583
1584
1585
1586
1587
    distDir        = distDirectory distDirLayout


verbosity :: Verbosity
verbosity = minBound --normal --verbose --maxBound --minBound

1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625


-------------------------------------------
-- Tasty integration to adjust the config
--

withProjectConfig :: (ProjectConfig -> TestTree) -> TestTree
withProjectConfig testtree =
    askOption $ \ghcPath ->
      testtree (mkProjectConfig ghcPath)

mkProjectConfig :: GhcPath -> ProjectConfig
mkProjectConfig (GhcPath ghcPath) =
    mempty {
      projectConfigShared = mempty {
        projectConfigHcPath = maybeToFlag ghcPath
      },
     projectConfigBuildOnly = mempty {
       projectConfigNumJobs = toFlag (Just 1)
     }
    }
  where
    maybeToFlag = maybe mempty toFlag


data GhcPath = GhcPath (Maybe FilePath)
  deriving Typeable

instance IsOption GhcPath where
  defaultValue = GhcPath Nothing
  optionName   = Tagged "with-ghc"
  optionHelp   = Tagged "The ghc compiler to use"
  parseValue   = Just . GhcPath . Just

projectConfigOptionDescriptions :: [OptionDescription]
projectConfigOptionDescriptions = [Option (Proxy :: Proxy GhcPath)]


1626
1627
1628
1629
1630
1631
1632
1633
1634
---------------------------------------
-- HUint style utils for this context
--

expectException :: Exception e => String -> IO a -> IO e
expectException expected action = do
    res <- try action
    case res of
      Left  e -> return e
1635
      Right _ -> throwIO $ HUnitFailure Nothing $ "expected an exception " ++ expected
1636

1637
expectPackagePreExisting :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId
1638
                         -> IO InstalledPackageInfo
1639
expectPackagePreExisting plan buildOutcomes pkgid = do
1640
    planpkg <- expectPlanPackage plan pkgid
1641
    case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of
1642
1643
1644
      (InstallPlan.PreExisting pkg, Nothing)
                       -> return pkg
      (_, buildResult) -> unexpectedBuildResult "PreExisting" planpkg buildResult
1645

1646
expectPackageConfigured :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId
1647
                        -> IO ElaboratedConfiguredPackage
1648
expectPackageConfigured plan buildOutcomes pkgid = do
1649
    planpkg <- expectPlanPackage plan pkgid
1650
    case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of
1651
      (InstallPlan.Configured pkg, Nothing)
1652
                       -> return pkg
1653
1654
      (_, buildResult) -> unexpectedBuildResult "Configured" planpkg buildResult

1655
expectPackageInstalled :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId
1656
                       -> IO (ElaboratedConfiguredPackage, BuildResult)
1657
expectPackageInstalled plan buildOutcomes pkgid = do
1658
    planpkg <- expectPlanPackage plan pkgid
1659
    case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of