Carry package dbs into testsuite

Prior to this patch, the testsuite used your global package db, and
sometimes, the inplace package db, which led to errors if you didn't
have old-time installed globally. They looked like this:

BuildDeps/SameDepsAllRound:          Cabal result was Result {successful = False, success = Failure, outputText = "\"/home/enolan/cabal/Cabal/tests/Setup configure --user -w  /home/enolan/.nix-profile/bin/ghc\" in PackageTests/BuildDeps/SameDepsAllRound\nConfiguring SameDepsAllRound-0.1...\nSetup: At least the following dependencies are missing:\nold-time -any\n"}

Cabal/tests/PackageTests.hs

@@ -39,6 +39,7 @@ import PackageTests.ReexportedModules.Check
 
 import Distribution.Simple.Configure
     ( ConfigStateFileError(..), findDistPrefOrDefault, getConfigStateFile )
+import Distribution.Simple.Compiler (PackageDB(..))
 import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
 import Distribution.Simple.Program.Types (programPath)
 import Distribution.Simple.Program.Builtin
@@ -52,6 +53,9 @@ import Distribution.Version (Version(Version))
 
 import Control.Exception (try, throw)
 import Distribution.Compat.Environment ( setEnv )
+#if !MIN_VERSION_base(4,8,0)
+import Data.Functor ((<$>))
+#endif
 import System.Directory
     ( canonicalizePath, setCurrentDirectory )
 import System.FilePath ((</>))
@@ -141,8 +145,9 @@ main = do
     (ghc, _) <- requireProgram normal ghcProgram (withPrograms lbi)
     (ghcPkg, _) <- requireProgram normal ghcPkgProgram (withPrograms lbi)
     (haddock, _) <- requireProgram normal haddockProgram (withPrograms lbi)
+    packageDBStack' <- mapM canonicalizePackageDB $ withPackageDB lbi
     let haddockPath = programPath haddock
-        dbFile = distPref_ </> "package.conf.inplace"
+        inplaceDBFile = distPref_ </> "package.conf.inplace"
         config = SuiteConfig
                  { cabalDistPref = distPref_
                  , ghcPath = programPath ghc
@@ -150,11 +155,12 @@ main = do
                  , inplaceSpec = PackageSpec
                    { directory = []
                    , configOpts =
-                     [ "--package-db=" ++ dbFile
+                     [ "--package-db=" ++ inplaceDBFile
                      , "--constraint=Cabal == " ++ display cabalVersion
                      ]
                    , distPref = Nothing
                    }
+                 , packageDBStack = packageDBStack'
                  }
     putStrLn $ "Cabal test suite - testing cabal version " ++ display cabalVersion
     putStrLn $ "Using ghc: " ++ ghcPath config
@@ -177,3 +183,7 @@ getPersistBuildConfig_ filename = do
       Left (ConfigStateFileBadVersion _ _ (Left err)) -> throw err
       Left err -> throw err
       Right lbi -> return lbi
+
+canonicalizePackageDB :: PackageDB -> IO PackageDB
+canonicalizePackageDB (SpecificPackageDB path) = SpecificPackageDB <$> canonicalizePath path
+canonicalizePackageDB x = return x

Cabal/tests/PackageTests/PackageTester.hs

@@ -47,6 +47,7 @@ import Test.Tasty.HUnit (Assertion, assertFailure)
 
 import Distribution.Compat.CreatePipe (createPipe)
 import Distribution.Simple.BuildPaths (exeExtension)
+import Distribution.Simple.Compiler (PackageDBStack, PackageDB(..))
 import Distribution.Simple.Program.Run (getEffectiveEnvironment)
 import Distribution.Simple.Utils (printRawCommandAndArgsAndEnv)
 import Distribution.ReadE (readEOrFail)
@@ -63,6 +64,7 @@ data SuiteConfig = SuiteConfig
     , ghcPkgPath :: FilePath
     , cabalDistPref :: FilePath
     , inplaceSpec :: PackageSpec
+    , packageDBStack :: PackageDBStack
     }
 
 data Success = Failure
@@ -107,9 +109,20 @@ doCabalConfigure config spec = do
     cleanResult@(_, _, _) <- cabal config spec [] ["clean"]
     requireSuccess cleanResult
     res <- cabal config spec []
-           (["configure", "--user", "-w", ghcPath config] ++ configOpts spec)
+           -- Use the package dbs from when we configured cabal rather than any
+           -- defaults.
+           (["configure", "--user", "-w", ghcPath config, "--package-db=clear"]
+            ++ packageDBParams (packageDBStack config)
+            ++ configOpts spec)
     return $ recordRun res ConfigureSuccess nullResult
 
+packageDBParams :: PackageDBStack -> [String]
+packageDBParams = map (("--package-db=" ++) . convert) where
+    convert :: PackageDB -> String
+    convert  GlobalPackageDB         = "global"
+    convert  UserPackageDB           = "user"
+    convert (SpecificPackageDB path) = path
+
 doCabalBuild :: SuiteConfig -> PackageSpec -> IO Result
 doCabalBuild config spec = do
     configResult <- doCabalConfigure config spec