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