Commit a31ab06a authored by quasicomputational's avatar quasicomputational

Make Setup.hs configure more CWD-independent.

Previously, we were checking the package with a hard-coded root
directory of ".". This was not a problem before, but with #5372 we
have started to expand globs while checking packages, which breaks if
the CWD is not the directory containing the `.cabal` file and causes
snowleopard/hadrian#634.

Luckily, this is an easy fix: the correct directory is easy to
determine. Writing a test and making sure it's tickling the failing
case took longer than writing the fix!

"." is hard-coded as the root directory passed to `checkPackageFiles`
in a few other places, but those are (a) non-trivial to test, and (b)
already in places that have other assumptions about their CWD, so I
have simply documented the CWD requirement for those.
parent beb992e2
......@@ -63,6 +63,8 @@
path components on Windows and warn about other unsafe characters
in the path to the source directory on all platforms
([#5386](https://github.com/haskell/cabal/issues/5386)).
* `Distribution.PackageDescription.Check.checkPackageFiles` now
accepts a `Verbosity` argument.
----
......
......@@ -1840,10 +1840,10 @@ checkDevelopmentOnlyFlags pkg =
-- | Sanity check things that requires IO. It looks at the files in the
-- package and expects to find the package unpacked in at the given file path.
--
checkPackageFiles :: PackageDescription -> FilePath -> NoCallStackIO [PackageCheck]
checkPackageFiles pkg root = do
checkPackageFiles :: Verbosity -> PackageDescription -> FilePath -> NoCallStackIO [PackageCheck]
checkPackageFiles verbosity pkg root = do
contentChecks <- checkPackageContent checkFilesIO pkg
missingFileChecks <- checkPackageMissingFiles pkg root
missingFileChecks <- checkPackageMissingFiles verbosity pkg root
-- Sort because different platforms will provide files from
-- `getDirectoryContents` in different orders, and we'd like to be
-- stable for test output.
......@@ -2155,20 +2155,20 @@ checkTarPath path
-- check these on the server; these checks only make sense in the development
-- and package-creation environment. Hence we can use IO, rather than needing
-- to pass a 'CheckPackageContentOps' dictionary around.
checkPackageMissingFiles :: PackageDescription -> FilePath -> NoCallStackIO [PackageCheck]
checkPackageMissingFiles :: Verbosity -> PackageDescription -> FilePath -> NoCallStackIO [PackageCheck]
checkPackageMissingFiles = checkGlobMultiDot
-- | Before Cabal 2.4, the extensions of globs had to match the file
-- exactly. This has been relaxed in 2.4 to allow matching only the
-- suffix. This warning detects when pre-2.4 package descriptions are
-- omitting files purely because of the stricter check.
checkGlobMultiDot :: PackageDescription
checkGlobMultiDot :: Verbosity
-> PackageDescription
-> FilePath
-> NoCallStackIO [PackageCheck]
checkGlobMultiDot pkg root =
checkGlobMultiDot verbosity pkg root =
fmap concat $ for allGlobs $ \(field, dir, glob) -> do
--TODO: baked-in verbosity
results <- matchDirFileGlob' normal (specVersion pkg) (root </> dir) glob
results <- matchDirFileGlob' verbosity (specVersion pkg) (root </> dir) glob
return
[ PackageDistSuspiciousWarn $
"In '" ++ field ++ "': the pattern '" ++ glob ++ "' does not"
......
......@@ -473,8 +473,10 @@ configure (pkg_descr0, pbi) cfg = do
debug verbosity $ "Finalized package description:\n"
++ showPackageDescription pkg_descr
let cabalFileDir = maybe "." takeDirectory $
flagToMaybe (configCabalFilePath cfg)
checkCompilerProblems verbosity comp pkg_descr enabled
checkPackageProblems verbosity pkg_descr0
checkPackageProblems verbosity cabalFileDir pkg_descr0
(updatePackageDescription pbi pkg_descr)
-- The list of 'InstalledPackageInfo' recording the selected
......@@ -1841,11 +1843,13 @@ checkForeignDeps pkg lbi verbosity =
-- | Output package check warnings and errors. Exit if any errors.
checkPackageProblems :: Verbosity
-> FilePath
-- ^ Path to the @.cabal@ file's directory
-> GenericPackageDescription
-> PackageDescription
-> IO ()
checkPackageProblems verbosity gpkg pkg = do
ioChecks <- checkPackageFiles pkg "."
checkPackageProblems verbosity dir gpkg pkg = do
ioChecks <- checkPackageFiles verbosity pkg dir
let pureChecks = checkPackage gpkg (Just pkg)
errors = [ e | PackageBuildImpossible e <- pureChecks ++ ioChecks ]
warnings = [ w | PackageBuildWarning w <- pureChecks ++ ioChecks ]
......
......@@ -468,9 +468,11 @@ allSourcesBuildInfo verbosity bi pps modules = do
++ "is autogenerated it should be added to 'autogen-modules'."
-- | Note: must be called with the CWD set to the directory containing
-- the '.cabal' file.
printPackageProblems :: Verbosity -> PackageDescription -> IO ()
printPackageProblems verbosity pkg_descr = do
ioChecks <- checkPackageFiles pkg_descr "."
ioChecks <- checkPackageFiles verbosity pkg_descr "."
let pureChecks = checkConfiguredPackage pkg_descr
isDistError (PackageDistSuspicious _) = False
isDistError (PackageDistSuspiciousWarn _) = False
......
......@@ -45,6 +45,8 @@ readGenericPackageDescriptionCheck verbosity fpath = do
die' verbosity $ "Failed parsing \"" ++ fpath ++ "\"."
Right x -> return (warnings, x)
-- | Note: must be called with the CWD set to the directory containing
-- the '.cabal' file.
check :: Verbosity -> IO Bool
check verbosity = do
pdfile <- defaultPackageDesc verbosity
......@@ -66,7 +68,7 @@ check verbosity = do
-- Hovever, this is the same way hackage does it, so we will yield
-- the exact same errors as it will.
let pkg_desc = flattenPackageDescription ppd
ioChecks <- checkPackageFiles pkg_desc "."
ioChecks <- checkPackageFiles verbosity pkg_desc "."
let packageChecks = ioChecks ++ checkPackage ppd (Just pkg_desc) ++ ws'
buildImpossible = [ x | x@PackageBuildImpossible {} <- packageChecks ]
buildWarning = [ x | x@PackageBuildWarning {} <- packageChecks ]
......
cabal-version: 2.2
name: a
version: 0
extra-source-files:
doc/*.html
executable foo
main-is: Main.hs
default-language: Haskell2010
import Test.Cabal.Prelude
import Test.Cabal.Script
main = setupTest $
void $ setup'' "pkg" "configure" ["--cabal-file", "pkg/a.cabal"]
......@@ -115,7 +115,17 @@ setup :: String -> [String] -> TestM ()
setup cmd args = void (setup' cmd args)
setup' :: String -> [String] -> TestM Result
setup' cmd args = do
setup' = setup'' "."
setup''
:: FilePath
-- ^ Subdirectory to find the @.cabal@ file in.
-> String
-- ^ Command name
-> [String]
-- ^ Arguments
-> TestM Result
setup'' prefix cmd args = do
env <- getTestEnv
when ((cmd == "register" || cmd == "copy") && not (testHavePackageDb env)) $
error "Cannot register/copy without using 'withPackageDb'"
......@@ -176,7 +186,7 @@ setup' cmd args = do
full_args' = if a `elem` legacyCmds then ("v1-" ++ a) : as else a:as
in runProgramM cabalProgram full_args'
else do
pdfile <- liftIO $ tryFindPackageDesc (testCurrentDir env)
pdfile <- liftIO $ tryFindPackageDesc (testCurrentDir env </> prefix)
pdesc <- liftIO $ readGenericPackageDescription (testVerbosity env) pdfile
if buildType (packageDescription pdesc) == Simple
then runM (testSetupPath env) full_args
......@@ -185,7 +195,7 @@ setup' cmd args = do
r <- liftIO $ runghc (testScriptEnv env)
(Just (testCurrentDir env))
(testEnvironment env)
(testCurrentDir env </> "Setup.hs")
(testCurrentDir env </> prefix </> "Setup.hs")
full_args
recordLog r
requireSuccess r
......
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