Skip to content

Commit

Permalink
testsuite: Pass pkgdb of store used for intree Cabal
Browse files Browse the repository at this point in the history
  • Loading branch information
alt-romes committed May 2, 2024
1 parent 9b4ff94 commit c43d6ff
Show file tree
Hide file tree
Showing 3 changed files with 28 additions and 19 deletions.
33 changes: 21 additions & 12 deletions cabal-testsuite/main/cabal-tests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -125,29 +125,38 @@ mainArgParser = MainArgs
<*> commonArgParser

-- Unpack and build a specific released version of Cabal and Cabal-syntax libraries
buildCabalLibsProject :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO FilePath
buildCabalLibsProject :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO [FilePath]
buildCabalLibsProject projString verb mbGhc dir = do
let prog_db = userSpecifyPaths [("ghc", path) | Just path <- [mbGhc] ] defaultProgramDb
(cabal, _) <- requireProgram verb (simpleProgram "cabal") prog_db
(ghc, _) <- requireProgram verb ghcProgram prog_db

let storeRoot = dir </> "store"
let pv = fromMaybe (error "no ghc version") (programVersion ghc)
let final_package_db = dir </> "dist-newstyle" </> "packagedb" </> "ghc-" ++ prettyShow pv
createDirectoryIfMissing True dir
writeFile (dir </> "cabal.project-test") projString

runProgramInvocation verb
((programInvocation cabal
["--store-dir", dir </> "store"
["--store-dir", storeRoot
, "--project-file=" ++ dir </> "cabal.project-test"
, "build"
, "-w", programPath ghc
, "Cabal", "Cabal-syntax", "Cabal-hooks", "hooks-exe"
] ) { progInvokeCwd = Just dir })
return final_package_db

-- Determine the path to the packagedb in the store for this ghc version
storesByGhc <- getDirectoryContents storeRoot
case filter (prettyShow pv `isInfixOf`) storesByGhc of
[] -> return [final_package_db]
storeForGhc:_ -> do
let storePackageDB = (storeRoot </> storeForGhc </> "package.db")
return [storePackageDB, final_package_db]

buildCabalLibsSpecific :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO FilePath


buildCabalLibsSpecific :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO [FilePath]
buildCabalLibsSpecific ver verb mbGhc builddir_rel = do
let prog_db = userSpecifyPaths [("ghc", path) | Just path <- [mbGhc] ] defaultProgramDb
(cabal, _) <- requireProgram verb (simpleProgram "cabal") prog_db
Expand All @@ -166,7 +175,7 @@ buildCabalLibsSpecific ver verb mbGhc builddir_rel = do
buildCabalLibsProject ("packages: Cabal-" ++ ver ++ " Cabal-syntax-" ++ ver ++ " Cabal-hooks-" ++ hooksVer) verb mbGhc dir


buildCabalLibsIntree :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO FilePath
buildCabalLibsIntree :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO [FilePath]
buildCabalLibsIntree root verb mbGhc builddir_rel = do
dir <- canonicalizePath (builddir_rel </> "intree")
let libs = [ "Cabal", "Cabal-syntax", "Cabal-hooks", "hooks-exe" ]
Expand All @@ -183,26 +192,26 @@ main = do
args <- execParser $ info (mainArgParser <**> helper) mempty
let verbosity = if mainArgVerbose args then verbose else normal

mpkg_db <-
pkg_dbs <-
-- Not path to cabal-install so we're not going to run cabal-install tests so we
-- can skip setting up a Cabal library to use with cabal-install.
case argCabalInstallPath (mainCommonArgs args) of
Nothing -> do
when (isJust $ mainArgCabalSpec args)
(putStrLn "Ignoring Cabal library specification as cabal-install tests are not running")
return Nothing
return []
-- Path to cabal-install is passed, so need to install the requested relevant version of Cabal
-- library.
Just {} ->
case mainArgCabalSpec args of
Nothing -> do
putStrLn "No Cabal library specified, using boot Cabal library with cabal-install tests"
return Nothing
Just BootCabalLib -> return Nothing
return []
Just BootCabalLib -> return []
Just (InTreeCabalLib root build_dir) ->
Just <$> buildCabalLibsIntree root verbosity (argGhcPath (mainCommonArgs args)) build_dir
buildCabalLibsIntree root verbosity (argGhcPath (mainCommonArgs args)) build_dir
Just (SpecificCabalLib ver build_dir) ->
Just <$> buildCabalLibsSpecific ver verbosity (argGhcPath (mainCommonArgs args)) build_dir
buildCabalLibsSpecific ver verbosity (argGhcPath (mainCommonArgs args)) build_dir

-- To run our test scripts, we need to be able to run Haskell code
-- linked against the Cabal library under test. The most efficient
Expand All @@ -229,7 +238,7 @@ main = do
-> IO result
runTest runner path
= runner Nothing [] path $
["--builddir", dist_dir, path] ++ ["--extra-package-db=" ++ pkg_db | Just pkg_db <- [mpkg_db]] ++ renderCommonArgs (mainCommonArgs args)
["--builddir", dist_dir, path] ++ ["--extra-package-db=" ++ pkg_db | pkg_db <- pkg_dbs] ++ renderCommonArgs (mainCommonArgs args)

case mainArgTestPaths args of
[path] -> do
Expand Down
10 changes: 5 additions & 5 deletions cabal-testsuite/src/Test/Cabal/Monad.hs
Original file line number Diff line number Diff line change
Expand Up @@ -158,7 +158,7 @@ renderCommonArgs args =

data TestArgs = TestArgs {
testArgDistDir :: FilePath,
testArgPackageDb :: Maybe FilePath,
testArgPackageDb :: [FilePath],
testArgScriptPath :: FilePath,
testCommonArgs :: CommonArgs
}
Expand All @@ -169,7 +169,7 @@ testArgParser = TestArgs
( help "Build directory of cabal-testsuite"
<> long "builddir"
<> metavar "DIR")
<*> optional (option str
<*> many (option str
( help "Package DB which contains Cabal and Cabal-syntax"
<> long "extra-package-db"
<> metavar "DIR"))
Expand Down Expand Up @@ -333,7 +333,7 @@ runTestM mode m =
testMtimeChangeDelay = Nothing,
testScriptEnv = senv,
testSetupPath = dist_dir </> "build" </> "setup" </> "setup",
testPackageDbPath = testArgPackageDb args,
testPackageDbPath = case testArgPackageDb args of [] -> Nothing; xs -> Just xs,
testSkipSetupTests = argSkipSetupTests (testCommonArgs args),
testHaveCabalShared = runnerWithSharedLib senv,
testEnvironment =
Expand Down Expand Up @@ -649,8 +649,8 @@ data TestEnv = TestEnv
-- | Setup script path
, testSetupPath :: FilePath
-- | Setup package-db path which contains Cabal and Cabal-syntax for cabal-install to
-- use when compiling custom setups.
, testPackageDbPath :: Maybe FilePath
-- use when compiling custom setups, plus the store with possible dependencies of those setup packages.
, testPackageDbPath :: Maybe [FilePath]
-- | Skip Setup tests?
, testSkipSetupTests :: Bool
-- | Do we have shared libraries for the Cabal-under-tests?
Expand Down
4 changes: 2 additions & 2 deletions cabal-testsuite/src/Test/Cabal/Prelude.hs
Original file line number Diff line number Diff line change
Expand Up @@ -324,7 +324,7 @@ cabalGArgs global_args cmd args input = do
= [ "--builddir", testDistDir env
, "-j1" ]
++ [ "--project-file=" ++ fp | Just fp <- [testCabalProjectFile env] ]
++ ["--package-db=" ++ db | Just db <- [testPackageDbPath env]]
++ ["--package-db=" ++ db | Just dbs <- [testPackageDbPath env], db <- dbs]

| otherwise
= [ "--builddir", testDistDir env ] ++
Expand Down Expand Up @@ -871,7 +871,7 @@ allCabalVersion = isCabalVersion all
isCabalVersion :: WithCallStack (((Version -> Bool) -> [Version] -> Bool) -> String -> TestM Bool)
isCabalVersion decide range = do
env <- getTestEnv
cabal_pkgs <- ghcPkg_raw' $ ["--global", "list", "Cabal", "--simple"] ++ ["--package-db=" ++ db | Just db <- [testPackageDbPath env]]
cabal_pkgs <- ghcPkg_raw' $ ["--global", "list", "Cabal", "--simple"] ++ ["--package-db=" ++ db | Just dbs <- [testPackageDbPath env], db <- dbs]
let pkg_versions :: [PackageIdentifier] = mapMaybe simpleParsec (words (resultOutput cabal_pkgs))
vr <- case eitherParsec range of
Left err -> fail err
Expand Down

0 comments on commit c43d6ff

Please sign in to comment.