diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs
index e505869b91833d3f451da33c2e722d7a8cf7bce0..a5345fe7083be401b9733dcc923a9c2f83f90dc7 100644
--- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs
@@ -26,6 +26,7 @@ import qualified Distribution.PackageDescription as C
import qualified Distribution.Simple.PackageIndex as C.PackageIndex
import qualified Distribution.System as C
import qualified Distribution.Version as C
+import Language.Haskell.Extension (Extension(..), Language)
-- cabal-install
import Distribution.Client.ComponentDeps (ComponentDeps)
@@ -97,6 +98,13 @@ data ExampleDependency =
-- | Dependency if tests are enabled
| ExTest ExampleTestName [ExampleDependency]
+ -- | Dependency on a language extension
+ | ExExt Extension
+
+ -- | Dependency on a language version
+ | ExLang Language
+
+
data ExampleAvailable = ExAv {
exAvName :: ExamplePkgName
, exAvVersion :: ExamplePkgVersion
@@ -133,12 +141,12 @@ exDbPkgs = map (either exInstName exAvName)
exAvSrcPkg :: ExampleAvailable -> SourcePackage
exAvSrcPkg ex =
- let (libraryDeps, testSuites) = splitTopLevel (CD.libraryDeps (exAvDeps ex))
+ let (libraryDeps, testSuites, exts, mlang) = splitTopLevel (CD.libraryDeps (exAvDeps ex))
in SourcePackage {
packageInfoId = exAvPkgId ex
, packageSource = LocalTarballPackage "<<path>>"
, packageDescrOverride = Nothing
- , packageDescription = C.GenericPackageDescription{
+ , packageDescription = C.GenericPackageDescription {
C.packageDescription = C.emptyPackageDescription {
C.package = exAvPkgId ex
, C.library = error "not yet configured: library"
@@ -152,26 +160,39 @@ exAvSrcPkg ex =
}
, C.genPackageFlags = concatMap extractFlags
(CD.libraryDeps (exAvDeps ex))
- , C.condLibrary = Just $ mkCondTree libraryDeps
+ , C.condLibrary = Just $ mkCondTree (extsLib exts <> langLib mlang) libraryDeps
, C.condExecutables = []
- , C.condTestSuites = map (\(t, deps) -> (t, mkCondTree deps))
+ , C.condTestSuites = map (\(t, deps) -> (t, mkCondTree mempty deps))
testSuites
, C.condBenchmarks = []
}
}
where
+ -- Split the set of dependencies into the set of dependencies of the library,
+ -- the dependencies of the test suites and extensions.
splitTopLevel :: [ExampleDependency]
-> ( [ExampleDependency]
, [(ExampleTestName, [ExampleDependency])]
+ , [Extension]
+ , Maybe Language
)
- splitTopLevel [] = ([], [])
+ splitTopLevel [] =
+ ([], [], [], Nothing)
splitTopLevel (ExTest t a:deps) =
- let (other, testSuites) = splitTopLevel deps
- in (other, (t, a):testSuites)
- splitTopLevel (dep:deps) =
- let (other, testSuites) = splitTopLevel deps
- in (dep:other, testSuites)
-
+ let (other, testSuites, exts, lang) = splitTopLevel deps
+ in (other, (t, a):testSuites, exts, lang)
+ splitTopLevel (ExExt ext:deps) =
+ let (other, testSuites, exts, lang) = splitTopLevel deps
+ in (other, testSuites, ext:exts, lang)
+ splitTopLevel (ExLang lang:deps) =
+ case splitTopLevel deps of
+ (other, testSuites, exts, Nothing) -> (other, testSuites, exts, Just lang)
+ _ -> error "Only 1 Language dependency is supported"
+ splitTopLevel (dep:deps) =
+ let (other, testSuites, exts, lang) = splitTopLevel deps
+ in (dep:other, testSuites, exts, lang)
+
+ -- Extract the total set of flags used
extractFlags :: ExampleDependency -> [C.Flag]
extractFlags (ExAny _) = []
extractFlags (ExFix _ _) = []
@@ -183,13 +204,15 @@ exAvSrcPkg ex =
}
: concatMap extractFlags (a ++ b)
extractFlags (ExTest _ a) = concatMap extractFlags a
+ extractFlags (ExExt _) = []
+ extractFlags (ExLang _) = []
- mkCondTree :: Monoid a => [ExampleDependency] -> DependencyTree a
- mkCondTree deps =
+ mkCondTree :: Monoid a => a -> [ExampleDependency] -> DependencyTree a
+ mkCondTree x deps =
let (directDeps, flaggedDeps) = splitDeps deps
in C.CondNode {
- C.condTreeData = mempty -- irrelevant to the solver
- , C.condTreeConstraints = map mkDirect directDeps
+ C.condTreeData = x -- Necessary for language extensions
+ , C.condTreeConstraints = map mkDirect directDeps
, C.condTreeComponents = map mkFlagged flaggedDeps
}
@@ -204,10 +227,17 @@ exAvSrcPkg ex =
-> (C.Condition C.ConfVar
, DependencyTree a, Maybe (DependencyTree a))
mkFlagged (f, a, b) = ( C.Var (C.Flag (C.FlagName f))
- , mkCondTree a
- , Just (mkCondTree b)
+ , mkCondTree mempty a
+ , Just (mkCondTree mempty b)
)
+ -- Split a set of dependencies into direct dependencies and flagged
+ -- dependencies. A direct dependency is a tuple of the name of package and
+ -- maybe its version (no version means any version) meant to be converted
+ -- to a 'C.Dependency' with 'mkDirect' for example. A flagged dependency is
+ -- the set of dependencies guarded by a flag.
+ --
+ -- TODO: Take care of flagged language extensions and language flavours.
splitDeps :: [ExampleDependency]
-> ( [(ExamplePkgName, Maybe Int)]
, [(ExampleFlagName, [ExampleDependency], [ExampleDependency])]
@@ -225,12 +255,22 @@ exAvSrcPkg ex =
in (directDeps, (f, a, b):flaggedDeps)
splitDeps (ExTest _ _:_) =
error "Unexpected nested test"
+ splitDeps (_:deps) = splitDeps deps
-- Currently we only support simple setup dependencies
mkSetupDeps :: [ExampleDependency] -> [C.Dependency]
mkSetupDeps deps =
let (directDeps, []) = splitDeps deps in map mkDirect directDeps
+ -- A 'C.Library' with just the given extensions in its 'BuildInfo'
+ extsLib :: [Extension] -> C.Library
+ extsLib es = mempty { C.libBuildInfo = mempty { C.otherExtensions = es } }
+
+ -- A 'C.Library' with just the given extensions in its 'BuildInfo'
+ langLib :: Maybe Language -> C.Library
+ langLib (Just lang) = mempty { C.libBuildInfo = mempty { C.defaultLanguage = Just lang } }
+ langLib _ = mempty
+
exAvPkgId :: ExampleAvailable -> C.PackageIdentifier
exAvPkgId ex = C.PackageIdentifier {
pkgName = C.PackageName (exAvName ex)
@@ -258,15 +298,27 @@ exInstIdx :: [ExampleInstalled] -> C.PackageIndex.InstalledPackageIndex
exInstIdx = C.PackageIndex.fromList . map exInstInfo
exResolve :: ExampleDb
+ -- List of extensions supported by the compiler.
+ -> [Extension]
+ -- A compiler can support multiple languages.
+ -> [Language]
-> [ExamplePkgName]
-> Bool
-> ([String], Either String CI.InstallPlan.InstallPlan)
-exResolve db targets indepGoals = runProgress $
+exResolve db exts langs targets indepGoals = runProgress $
resolveDependencies C.buildPlatform
- (C.unknownCompilerInfo C.buildCompilerId C.NoAbiTag)
+ compiler
Modular
params
where
+ defaultCompiler = C.unknownCompilerInfo C.buildCompilerId C.NoAbiTag
+ compiler = defaultCompiler { C.compilerInfoExtensions = if null exts
+ then Nothing
+ else Just exts
+ , C.compilerInfoLanguages = if null langs
+ then Nothing
+ else Just langs
+ }
(inst, avai) = partitionEithers db
instIdx = exInstIdx inst
avaiIdx = SourcePackageDb {
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs
index e5162b8e60d9625bbbffc026e8983280b872af25..e7692d41b7eb7270ba2672e686d889c5f116bde2 100644
--- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs
@@ -13,6 +13,9 @@ import Test.Tasty as TF
import Test.Tasty.HUnit (testCase, assertEqual, assertBool)
import Test.Tasty.Options
+-- Cabal
+import Language.Haskell.Extension (Extension(..), KnownExtension(..), Language(..))
+
-- cabal-install
import UnitTests.Distribution.Client.Dependency.Modular.DSL
@@ -67,6 +70,21 @@ tests = [
, runTest $ mkTest db12 "baseShim5" ["D"] Nothing
, runTest $ mkTest db12 "baseShim6" ["E"] (Just [("E", 1), ("syb", 2)])
]
+ , testGroup "Extensions" [
+ runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupported" ["A"] Nothing
+ , runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupportedIndirect" ["B"] Nothing
+ , runTest $ mkTestExts [EnableExtension RankNTypes] dbExts1 "supported" ["A"] (Just [("A",1)])
+ , runTest $ mkTestExts (map EnableExtension [CPP,RankNTypes]) dbExts1 "supportedIndirect" ["C"] (Just [("A",1),("B",1), ("C",1)])
+ , runTest $ mkTestExts [EnableExtension CPP] dbExts1 "disabledExtension" ["D"] Nothing
+ , runTest $ mkTestExts (map EnableExtension [CPP,RankNTypes]) dbExts1 "disabledExtension" ["D"] Nothing
+ , runTest $ mkTestExts (UnknownExtension "custom" : map EnableExtension [CPP,RankNTypes]) dbExts1 "supportedUnknown" ["E"] (Just [("A",1),("B",1),("C",1),("E",1)])
+ ]
+ , testGroup "Languages" [
+ runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupported" ["A"] Nothing
+ , runTest $ mkTestLangs [Haskell98,Haskell2010] dbLangs1 "supported" ["A"] (Just [("A",1)])
+ , runTest $ mkTestLangs [Haskell98] dbLangs1 "unsupportedIndirect" ["B"] Nothing
+ , runTest $ mkTestLangs [Haskell98, Haskell2010, UnknownLanguage "Haskell3000"] dbLangs1 "supportedUnknown" ["C"] (Just [("A",1),("B",1),("C",1)])
+ ]
]
where
indep test = test { testIndepGoals = True }
@@ -76,11 +94,13 @@ tests = [
-------------------------------------------------------------------------------}
data SolverTest = SolverTest {
- testLabel :: String
- , testTargets :: [String]
- , testResult :: Maybe [(String, Int)]
- , testIndepGoals :: Bool
- , testDb :: ExampleDb
+ testLabel :: String
+ , testTargets :: [String]
+ , testResult :: Maybe [(String, Int)]
+ , testIndepGoals :: Bool
+ , testDb :: ExampleDb
+ , testSupportedExts :: [Extension]
+ , testSupportedLangs :: [Language]
}
mkTest :: ExampleDb
@@ -88,18 +108,45 @@ mkTest :: ExampleDb
-> [String]
-> Maybe [(String, Int)]
-> SolverTest
-mkTest db label targets result = SolverTest {
- testLabel = label
- , testTargets = targets
- , testResult = result
- , testIndepGoals = False
- , testDb = db
+mkTest = mkTestExtLang [] []
+
+mkTestExts :: [Extension]
+ -> ExampleDb
+ -> String
+ -> [String]
+ -> Maybe [(String, Int)]
+ -> SolverTest
+mkTestExts exts = mkTestExtLang exts []
+
+mkTestLangs :: [Language]
+ -> ExampleDb
+ -> String
+ -> [String]
+ -> Maybe [(String, Int)]
+ -> SolverTest
+mkTestLangs = mkTestExtLang []
+
+mkTestExtLang :: [Extension]
+ -> [Language]
+ -> ExampleDb
+ -> String
+ -> [String]
+ -> Maybe [(String, Int)]
+ -> SolverTest
+mkTestExtLang exts langs db label targets result = SolverTest {
+ testLabel = label
+ , testTargets = targets
+ , testResult = result
+ , testIndepGoals = False
+ , testDb = db
+ , testSupportedExts = exts
+ , testSupportedLangs = langs
}
runTest :: SolverTest -> TF.TestTree
runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) ->
testCase testLabel $ do
- let (_msgs, result) = exResolve testDb testTargets testIndepGoals
+ let (_msgs, result) = exResolve testDb testSupportedExts testSupportedLangs testTargets testIndepGoals
when showSolverLog $ mapM_ putStrLn _msgs
case result of
Left err -> assertBool ("Unexpected error:\n" ++ err) (isNothing testResult)
@@ -340,6 +387,23 @@ db12 =
, Right $ exAv "E" 1 [ExFix "base" 4, ExFix "syb" 2]
]
+dbExts1 :: ExampleDb
+dbExts1 = [
+ Right $ exAv "A" 1 [ExExt (EnableExtension RankNTypes)]
+ , Right $ exAv "B" 1 [ExExt (EnableExtension CPP), ExAny "A"]
+ , Right $ exAv "C" 1 [ExAny "B"]
+ , Right $ exAv "D" 1 [ExExt (DisableExtension CPP), ExAny "B"]
+ , Right $ exAv "E" 1 [ExExt (UnknownExtension "custom"), ExAny "C"]
+ ]
+
+dbLangs1 :: ExampleDb
+dbLangs1 = [
+ Right $ exAv "A" 1 [ExLang Haskell2010]
+ , Right $ exAv "B" 1 [ExLang Haskell98, ExAny "A"]
+ , Right $ exAv "C" 1 [ExLang (UnknownLanguage "Haskell3000"), ExAny "B"]
+ ]
+
+
{-------------------------------------------------------------------------------
Test options
-------------------------------------------------------------------------------}