Properly assign component ID/build dir for LibV09 test libraries

Cabal's LibV09 support has always been a bit skeevy. The general idea was that a detailed-0.9 test-suite is built as a library and an Cabal-provided stub executable. In particular, the test suite library must be installed to the installed package database so that the executable can be compiled. Old versions of Cabal did something very skeevy here: they installed the test library as a "package", with the same package name as the "test-suite" stanza; furthermore, they built the products into the same directory as the library proper. Consequently, a lot of bad things could happen (both of which I've added tests for): 1. If the name of the test suite and the name of some other package coincide (and have the same version), they will clobber each other. In GHC 7.8 and earlier, this just flat out kills the build, because it will shadow. There's an explicit test to make sure test suites don't conflict with the package name, but you can get unlucky. 2. The test suite library is built into the same directory as the main library, which means that if the test library implements the same module name as something in the main library it will clobber the interface file and badness will ensue. This patchset fixes both of these issues, by (1) giving internal test libraries proper names which are guaranteed to be unique up to Cabal's dependency resolution, and (2) building the test suite library into a separate directory. In doing so, it also lays the groundwork for other types of internal libraries, e.g. #269, as well as extra (invisible) libraries which we may install. For GHC 7.8 and earlier, we follow the reserved namespace convention as per #3017. Signed-off-by: Edward Z. Yang <[email protected]>
haskell · Jan 2, 2016 · e8e47f6 · e8e47f6
1 parent 3ea7566
commit e8e47f6
Show file tree

Hide file tree

Showing 18 changed files with 325 additions and 103 deletions.
diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
@@ -82,6 +82,10 @@ extra-source-files:
   tests/PackageTests/CMain/my.cabal
   tests/PackageTests/DeterministicAr/Lib.hs
   tests/PackageTests/DeterministicAr/my.cabal
+  tests/PackageTests/DuplicateModuleName/DuplicateModuleName.cabal
+  tests/PackageTests/DuplicateModuleName/src/Foo.hs
+  tests/PackageTests/DuplicateModuleName/tests/Foo.hs
+  tests/PackageTests/DuplicateModuleName/tests2/Foo.hs
   tests/PackageTests/EmptyLib/empty/empty.cabal
   tests/PackageTests/Haddock/CPP.hs
   tests/PackageTests/Haddock/Literate.lhs
@@ -112,7 +116,11 @@ extra-source-files:
   tests/PackageTests/TemplateHaskell/vanilla/Lib.hs
   tests/PackageTests/TemplateHaskell/vanilla/TH.hs
   tests/PackageTests/TemplateHaskell/vanilla/my.cabal
-  tests/PackageTests/Tests.hs
+  tests/PackageTests/TestNameCollision/child/Child.hs
+  tests/PackageTests/TestNameCollision/child/child.cabal
+  tests/PackageTests/TestNameCollision/child/tests/Test.hs
+  tests/PackageTests/TestNameCollision/parent/Parent.hs
+  tests/PackageTests/TestNameCollision/parent/parent.cabal
   tests/PackageTests/TestOptions/TestOptions.cabal
   tests/PackageTests/TestOptions/test-TestOptions.hs
   tests/PackageTests/TestStanza/my.cabal

diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs
@@ -66,7 +66,7 @@ import Distribution.Version
          , asVersionIntervals, UpperBound(..), isNoVersion )
 import Distribution.Package
          ( PackageName(PackageName), packageName, packageVersion
-         , Dependency(..), pkgName )
+         , Dependency(..) )
 
 import Distribution.Text
          ( display, disp )
@@ -317,14 +317,6 @@ checkTestSuite pkg test =
       PackageDistInexcusable $
            "The package uses a C/C++/obj-C source file for the 'main-is' field. "
         ++ "To use this feature you must specify 'cabal-version: >= 1.18'."
-
-    -- Test suites might be built as (internal) libraries named after
-    -- the test suite and thus their names must not clash with the
-    -- name of the package.
-  , check libNameClash $
-      PackageBuildImpossible $
-           "The test suite " ++ testName test
-        ++ " has the same name as the package."
   ]
   where
     moduleDuplicates = dups $ testModules test
@@ -337,13 +329,8 @@ checkTestSuite pkg test =
       TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]
       _                   -> False
 
-    libNameClash = testName test `elem` [ libName
-                                        | _lib <- maybeToList (library pkg)
-                                        , let PackageName libName =
-                                                pkgName (package pkg) ]
-
 checkBenchmark :: PackageDescription -> Benchmark -> [PackageCheck]
-checkBenchmark pkg bm =
+checkBenchmark _pkg bm =
   catMaybes [
 
     case benchmarkInterface bm of
@@ -369,12 +356,6 @@ checkBenchmark pkg bm =
       PackageBuildImpossible $
            "The 'main-is' field must specify a '.hs' or '.lhs' file "
         ++ "(even if it is generated by a preprocessor)."
-
-    -- See comment for similar check on test suites.
-  , check libNameClash $
-      PackageBuildImpossible $
-           "The benchmark " ++ benchmarkName bm
-        ++ " has the same name as the package."
   ]
   where
     moduleDuplicates = dups $ benchmarkModules bm
@@ -383,11 +364,6 @@ checkBenchmark pkg bm =
       BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]
       _                   -> False
 
-    libNameClash = benchmarkName bm `elem` [ libName
-                                           | _lib <- maybeToList (library pkg)
-                                           , let PackageName libName =
-                                                   pkgName (package pkg) ]
-
 -- ------------------------------------------------------------
 -- * Additional pure checks
 -- ------------------------------------------------------------

diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs
@@ -35,15 +35,14 @@ import qualified Distribution.Simple.Build.PathsModule as Build.PathsModule
 
 import Distribution.Package
          ( Package(..), PackageName(..), PackageIdentifier(..)
-         , Dependency(..), thisPackageVersion, packageName
-         , ComponentId(..), ComponentId(..) )
+         , Dependency(..), thisPackageVersion )
 import Distribution.Simple.Compiler
          ( Compiler, CompilerFlavor(..), compilerFlavor
          , PackageDB(..), PackageDBStack )
 import Distribution.PackageDescription
          ( PackageDescription(..), BuildInfo(..), Library(..), Executable(..)
          , TestSuite(..), TestSuiteInterface(..), Benchmark(..)
-         , BenchmarkInterface(..), allBuildInfo, defaultRenaming )
+         , BenchmarkInterface(..), allBuildInfo )
 import qualified Distribution.InstalledPackageInfo as IPI
 import qualified Distribution.ModuleName as ModuleName
 import Distribution.ModuleName (ModuleName)
@@ -55,7 +54,7 @@ import Distribution.Simple.BuildTarget
 import Distribution.Simple.PreProcess
          ( preprocessComponent, preprocessExtras, PPSuffixHandler )
 import Distribution.Simple.LocalBuildInfo
-         ( LocalBuildInfo(compiler, buildDir, withPackageDB, withPrograms)
+         ( LocalBuildInfo(compiler, buildDir, withPackageDB, withPrograms, flagAssignment)
          , Component(..), componentName, getComponent, componentBuildInfo
          , ComponentLocalBuildInfo(..), pkgEnabledComponents
          , withComponentsInBuildOrder, componentsInBuildOrder
@@ -65,6 +64,7 @@ import Distribution.Simple.Program.Types
 import Distribution.Simple.Program.Db
 import Distribution.Simple.BuildPaths
          ( autogenModulesDir, autogenModuleName, cppHeaderName, exeExtension )
+import Distribution.Simple.Configure (computeComponentId, computeCompatPackageKey)
 import Distribution.Simple.Register
          ( registerPackage, inplaceInstalledPackageInfo
          , doesPackageDBExist, deletePackageDB, createPackageDB )
@@ -249,7 +249,10 @@ buildComponent verbosity numJobs pkg_descr lbi0 suffixes
     extras <- preprocessExtras comp lbi
     info verbosity $ "Building test suite " ++ testName test ++ "..."
     buildLib verbosity numJobs pkg lbi lib libClbi
-    registerPackage verbosity (compiler lbi) (withPrograms lbi) False
+    -- NB: need to enable multiple instances here, because on 7.10+
+    -- the package name is the same as the library, and we still
+    -- want the registration to go through.
+    registerPackage verbosity (compiler lbi) (withPrograms lbi) True
                     (withPackageDB lbi) ipi
     let ebi = buildInfo exe
         exe' = exe { buildInfo = addExtraCSources ebi extras }
@@ -401,17 +404,22 @@ testSuiteLibV09AsLibAndExe pkg_descr
             libExposed     = True,
             libBuildInfo   = bi
           }
+    cid = computeComponentId (package pkg_descr)
+                             (CTestName (testName test))
+                             (map fst (componentPackageDeps clbi))
+                             (flagAssignment lbi)
+    (pkg_name, compat_key) = computeCompatPackageKey
+                                (compiler lbi) (package pkg_descr)
+                                (CTestName (testName test)) cid
     libClbi = LibComponentLocalBuildInfo
                 { componentPackageDeps = componentPackageDeps clbi
                 , componentPackageRenaming = componentPackageRenaming clbi
-                , componentId = ComponentId $ display (packageId pkg)
-                , componentCompatPackageKey = ComponentId $ display (packageId pkg)
+                , componentId = cid
+                , componentCompatPackageKey = compat_key
                 , componentExposedModules = [IPI.ExposedModule m Nothing Nothing]
                 }
     pkg = pkg_descr {
-            package      = (package pkg_descr) {
-                             pkgName = PackageName (testName test)
-                           }
+            package      = (package pkg_descr) { pkgName = pkg_name }
           , buildDepends = targetBuildDepends $ testBuildInfo test
           , executables  = []
           , testSuites   = []
@@ -439,9 +447,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
                   : (filter (\(_, x) -> let PackageName name = pkgName x
                                         in name == "Cabal" || name == "base")
                             (componentPackageDeps clbi)),
-                componentPackageRenaming =
-                    Map.insert (packageName ipi) defaultRenaming
-                               (componentPackageRenaming clbi)
+                componentPackageRenaming = Map.empty
               }
 testSuiteLibV09AsLibAndExe _ TestSuite{} _ _ _ _ = error "testSuiteLibV09AsLibAndExe: wrong kind"
 
@@ -471,7 +477,7 @@ createInternalPackageDB :: Verbosity -> LocalBuildInfo -> FilePath
 createInternalPackageDB verbosity lbi distPref = do
     existsAlready <- doesPackageDBExist dbPath
     when existsAlready $ deletePackageDB dbPath
-    createPackageDB verbosity (compiler lbi) (withPrograms lbi) True dbPath 
+    createPackageDB verbosity (compiler lbi) (withPrograms lbi) False dbPath 
     return (SpecificPackageDB dbPath)
   where
       dbPath = case compilerFlavor (compiler lbi) of