Commit eb4783d4 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add a number of TargetSelector tests

We already had tests covering valid syntax. This adds tests for invalid
syntax and ambigious cases. Also cases for empty projects, or when there
is no cwd package.
parent 8072ee82
......@@ -25,6 +25,7 @@ module Distribution.Client.TargetSelector (
reportTargetSelectorProblems,
TargetString,
showTargetString,
parseTargetString,
-- ** non-IO
readTargetSelectorsWith,
DirActions(..),
......
......@@ -170,6 +170,11 @@ Extra-Source-Files:
tests/IntegrationTests2/regression/3324/p/p.cabal
tests/IntegrationTests2/regression/3324/q/Q.hs
tests/IntegrationTests2/regression/3324/q/q.cabal
tests/IntegrationTests2/targets/complex/cabal.project
tests/IntegrationTests2/targets/complex/q/Q.hs
tests/IntegrationTests2/targets/complex/q/q.cabal
tests/IntegrationTests2/targets/empty/cabal.project
tests/IntegrationTests2/targets/empty/foo.hs
tests/IntegrationTests2/targets/simple/P.hs
tests/IntegrationTests2/targets/simple/cabal.project
tests/IntegrationTests2/targets/simple/p.cabal
......
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
-- For the handy instance IsString PackageIdentifier
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main where
......@@ -10,22 +15,28 @@ import qualified Distribution.Client.TargetSelector as TS (DirActions(..))
import Distribution.Client.ProjectPlanning
import Distribution.Client.ProjectPlanning.Types
import Distribution.Client.ProjectBuilding
import Distribution.Client.Types (UnresolvedSourcePackage)
import Distribution.Client.Types
( PackageLocation(..), UnresolvedSourcePackage )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Solver.Types.SourcePackage as SP
import Distribution.Package
import Distribution.PackageDescription
import qualified Distribution.Types.GenericPackageDescription as GPG
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import Distribution.Simple.Setup (toFlag)
import Distribution.Simple.Compiler
import Distribution.System
import Distribution.Version
import Distribution.ModuleName (ModuleName)
import Distribution.ModuleName as M (fromString)
import Distribution.Verbosity
import Distribution.Text
import Distribution.Types.UnqualComponentName
import Data.Monoid
import Data.List (sort)
import Data.String (IsString(..))
import qualified Data.Map as Map
import Control.Monad
import Control.Exception
......@@ -61,7 +72,12 @@ tests config =
, testCase "proj conf1" (testExceptionInProjectConfig config)
]
, testGroup "Target selectors" $
[ testCaseSteps "valid" testTargetSelectors
[ testCaseSteps "valid" testTargetSelectors
, testCase "bad syntax" testTargetSelectorBadSyntax
, testCaseSteps "ambiguous syntax" testTargetSelectorAmbiguous
, testCase "no current pkg" testTargetSelectorNoCurrentPackage
, testCase "no targets" testTargetSelectorNoTargets
, testCase "project empty" testTargetSelectorProjectEmpty
]
, testGroup "Exceptions during building (local inplace)" $
[ testCase "configure" (testExceptionInConfigureStep config)
......@@ -207,6 +223,262 @@ testTargetSelectors reportSubCase = do
pkgidP = PackageIdentifier (mkPackageName "p") (mkVersion [0,1])
pkgidQ = PackageIdentifier (mkPackageName "q") (mkVersion [0,1])
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"
, TargetPackage TargetImplicitCwd "dummyPackageInfo" (Just LibKind) ]
[mkpkg "libs" []]
reportSubCase "ambiguous: filter vs cwd component"
assertAmbiguous "exes"
[ mkTargetComponent "other" (CExeName "exes")
, TargetPackage TargetImplicitCwd "dummyPackageInfo" (Just ExeKind) ]
[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"
(TargetPackage TargetImplicitCwd "bar" (Just LibKind))
[ 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
-> [TargetSelector PackageId]
-> [SourcePackage (PackageLocation a)]
-> Assertion
assertAmbiguous str tss pkgs = do
res <- readTargetSelectorsWith fakeDirActions pkgs [str]
case res of
Left [TargetSelectorAmbiguous _ tss'] ->
sort (map snd tss') @?= sort tss
_ -> assertFailure $ "expected Left [TargetSelectorAmbiguous _ _], "
++ "got " ++ show res
assertUnambiguous :: String
-> TargetSelector PackageId
-> [SourcePackage (PackageLocation a)]
-> Assertion
assertUnambiguous str ts pkgs = do
res <- readTargetSelectorsWith fakeDirActions pkgs [str]
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 } }
mkTargetPackage :: PackageId -> TargetSelector PackageId
mkTargetPackage pkgid =
TargetPackage TargetExplicitNamed pkgid Nothing
mkTargetComponent :: PackageId -> ComponentName -> TargetSelector PackageId
mkTargetComponent pkgid cname =
TargetComponent pkgid cname WholeComponent
mkTargetModule :: PackageId -> ComponentName -> ModuleName -> TargetSelector PackageId
mkTargetModule pkgid cname mname =
TargetComponent pkgid cname (ModuleTarget mname)
mkTargetFile :: PackageId -> ComponentName -> String -> TargetSelector PackageId
mkTargetFile pkgid cname fname =
TargetComponent pkgid cname (FileTarget fname)
mkTargetAllPackages :: TargetSelector PackageId
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 []
errs @?= [TargetSelectorNoTargets]
cleanProject testdir
where
testdir = "targets/complex"
config = mempty
testTargetSelectorProjectEmpty :: Assertion
testTargetSelectorProjectEmpty = do
(_, _, _, localPackages, _) <- configureProject testdir config
Left errs <- readTargetSelectors localPackages []
errs @?= [TargetSelectorNoTargets]
cleanProject testdir
where
testdir = "targets/empty"
config = mempty
testExceptionInFindingPackage :: ProjectConfig -> Assertion
testExceptionInFindingPackage config = do
BadPackageLocations _ locs <- expectException "BadPackageLocations" $
......
name: q
version: 0.1
build-type: Simple
cabal-version: >= 1.2
library
exposed-modules: Q
build-depends: base, filepath
executable buildable-false
main-is: Main.hs
buildable: False
test-suite solver-disabled
type: exitcode-stdio-1.0
main-is: Test.hs
build-depends: a-package-that-does-not-exist
benchmark user-disabled
type: exitcode-stdio-1.0
main-is: Test.hs
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment