Commit d0c3defe authored by quasicomputational's avatar quasicomputational Committed by Oleg Grenrus

Don't break when data-dir is null.

PR #5284 changed things around, and now matchDirFileGlob will break if
it's passed a null directory, which happens to be the default value
for data-dir. Its call sites have been fixed to check for this and to
substitute '.' for an empty path, which is the desired behaviour; in
addition, matchDirFileGlob itself will now warn about this if it's
detected, so that new broken call sites can't sneak in.

Fixes #5318.
parent cbdb135b
......@@ -142,9 +142,19 @@ matchFileGlob verbosity version = matchDirFileGlob verbosity version "."
-- The returned values do not include the supplied @dir@ prefix.
matchDirFileGlob :: Verbosity -> Version -> FilePath -> FilePath -> IO [FilePath]
matchDirFileGlob verbosity version dir filepath = case parseFileGlob version filepath of
matchDirFileGlob verbosity version rawDir filepath = case parseFileGlob version filepath of
Left err -> die' verbosity $ explainGlobSyntaxError filepath err
Right pat -> do
-- The default data-dir is null. Our callers -should- be
-- converting that to '.' themselves, but it's a certainty that
-- some future call-site will forget and trigger a really
-- hard-to-debug failure if we don't check for that here.
when (null rawDir) $
warn verbosity $
"Null dir passed to matchDirFileGlob; interpreting it "
++ "as '.'. This is probably an internal error."
let dir = if null rawDir then "." else rawDir
debug verbosity $ "Expanding glob '" ++ filepath ++ "' in directory '" ++ dir ++ "'."
-- This function might be called from the project root with dir as
-- ".". Walking the tree starting there involves going into .git/
-- and dist-newstyle/, which is a lot of work for no reward, so
......
......@@ -235,7 +235,10 @@ copyComponent _ _ _ (CTest _) _ _ = return ()
installDataFiles :: Verbosity -> PackageDescription -> FilePath -> IO ()
installDataFiles verbosity pkg_descr destDataDir =
flip traverse_ (dataFiles pkg_descr) $ \ file -> do
let srcDataDir = dataDir pkg_descr
let srcDataDirRaw = dataDir pkg_descr
srcDataDir = if null srcDataDirRaw
then "."
else srcDataDirRaw
files <- matchDirFileGlob verbosity (specVersion pkg_descr) srcDataDir file
let dir = takeDirectory file
createDirectoryIfMissingVerbose verbosity True (destDataDir </> dir)
......
......@@ -209,8 +209,12 @@ listPackageSourcesOrdinary verbosity pkg_descr pps =
-- Data files.
, fmap concat
. for (dataFiles pkg_descr) $ \filename ->
fmap (fmap (dataDir pkg_descr </>)) $
matchDirFileGlob verbosity (specVersion pkg_descr) (dataDir pkg_descr) filename
let srcDataDirRaw = dataDir pkg_descr
srcDataDir = if null srcDataDirRaw
then "."
else srcDataDirRaw
in fmap (fmap (srcDataDir </>)) $
matchDirFileGlob verbosity (specVersion pkg_descr) srcDataDir filename
-- Extra doc files.
, fmap concat
......
cabal-version: 2.0
name: empty-data-dir
version: 0
build-type: Simple
data-files: foo.dat
executable foo
default-language: Haskell2010
build-depends: base
main-is: Main.hs
# cabal install
Resolving dependencies...
Configuring empty-data-dir-0...
Preprocessing executable 'foo' for empty-data-dir-0..
Building executable 'foo' for empty-data-dir-0..
Installing executable foo in <PATH>
Warning: The directory <ROOT>/install.dist/home/.cabal/bin is not in the system search path.
Installed empty-data-dir-0
import Test.Cabal.Prelude
main = cabalTest $
cabal "install" []
# cabal sdist
List of package sources written to file '<TMPDIR>/sources'
List of package sources written to file '<TMPDIR>/sources'
import Test.Cabal.Prelude
main = cabalTest $ do
tmpdir <- fmap testTmpDir getTestEnv
let fn = tmpdir </> "sources"
cabal "sdist" ["--list-sources=" ++ fn]
-- --list-sources outputs with slashes on posix and backslashes on Windows. 'normalise' converts our needle to the necessary format.
assertFileDoesContain fn $ normalise "foo.dat"
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