From 7f0e066f253e627af072f8cd47ef93e0e7fdeafa Mon Sep 17 00:00:00 2001 From: quasicomputational Date: Tue, 26 Jun 2018 18:31:45 +0100 Subject: [PATCH] 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. --- Cabal/ChangeLog.md | 2 ++ Cabal/Distribution/PackageDescription/Check.hs | 16 ++++++++-------- Cabal/Distribution/Simple/Configure.hs | 10 +++++++--- Cabal/Distribution/Simple/SrcDist.hs | 4 +++- cabal-install/Distribution/Client/Check.hs | 4 +++- .../Regression/HadrianT634/pkg/Main.hs | 1 + .../Regression/HadrianT634/pkg/a.cabal | 9 +++++++++ .../Regression/HadrianT634/pkg/doc/hello.html | 1 + .../Regression/HadrianT634/setup.out | 2 ++ .../Regression/HadrianT634/setup.test.hs | 4 ++++ cabal-testsuite/Test/Cabal/Prelude.hs | 16 +++++++++++++--- 11 files changed, 53 insertions(+), 16 deletions(-) create mode 100644 cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/Main.hs create mode 100644 cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/a.cabal create mode 100644 cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/doc/hello.html create mode 100644 cabal-testsuite/PackageTests/Regression/HadrianT634/setup.out create mode 100644 cabal-testsuite/PackageTests/Regression/HadrianT634/setup.test.hs diff --git a/Cabal/ChangeLog.md b/Cabal/ChangeLog.md index fc8e3916fb4..f618b7c684e 100644 --- a/Cabal/ChangeLog.md +++ b/Cabal/ChangeLog.md @@ -61,6 +61,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. ---- diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs index 86027baa39b..e8567afb303 100644 --- a/Cabal/Distribution/PackageDescription/Check.hs +++ b/Cabal/Distribution/PackageDescription/Check.hs @@ -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" diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index dd81a40eb89..f927b8b9bde 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -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 ] diff --git a/Cabal/Distribution/Simple/SrcDist.hs b/Cabal/Distribution/Simple/SrcDist.hs index e14db820c4a..1ceecf848c6 100644 --- a/Cabal/Distribution/Simple/SrcDist.hs +++ b/Cabal/Distribution/Simple/SrcDist.hs @@ -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 diff --git a/cabal-install/Distribution/Client/Check.hs b/cabal-install/Distribution/Client/Check.hs index 20e841f5393..a0377b76a81 100644 --- a/cabal-install/Distribution/Client/Check.hs +++ b/cabal-install/Distribution/Client/Check.hs @@ -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 ] diff --git a/cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/Main.hs b/cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/Main.hs new file mode 100644 index 00000000000..cfff5fd1aaa --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/Main.hs @@ -0,0 +1 @@ +main = putStrLn "Main.hs" diff --git a/cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/a.cabal b/cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/a.cabal new file mode 100644 index 00000000000..2f987b469bc --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/a.cabal @@ -0,0 +1,9 @@ +cabal-version: 2.2 +name: a +version: 0 +extra-source-files: + doc/*.html + +executable foo + main-is: Main.hs + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/doc/hello.html b/cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/doc/hello.html new file mode 100644 index 00000000000..cf9dc4282c8 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/HadrianT634/pkg/doc/hello.html @@ -0,0 +1 @@ +hello.html diff --git a/cabal-testsuite/PackageTests/Regression/HadrianT634/setup.out b/cabal-testsuite/PackageTests/Regression/HadrianT634/setup.out new file mode 100644 index 00000000000..75717f817b3 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/HadrianT634/setup.out @@ -0,0 +1,2 @@ +# Setup configure +Configuring a-0... diff --git a/cabal-testsuite/PackageTests/Regression/HadrianT634/setup.test.hs b/cabal-testsuite/PackageTests/Regression/HadrianT634/setup.test.hs new file mode 100644 index 00000000000..0cf02afb4c4 --- /dev/null +++ b/cabal-testsuite/PackageTests/Regression/HadrianT634/setup.test.hs @@ -0,0 +1,4 @@ +import Test.Cabal.Prelude +import Test.Cabal.Script +main = setupTest $ + void $ setup'' "pkg" "configure" ["--cabal-file", "pkg/a.cabal"] diff --git a/cabal-testsuite/Test/Cabal/Prelude.hs b/cabal-testsuite/Test/Cabal/Prelude.hs index d6bedc47f2e..5f955d92792 100644 --- a/cabal-testsuite/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/Test/Cabal/Prelude.hs @@ -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