Skip to content

Commit

Permalink
Don't break when data-dir is null.
Browse files Browse the repository at this point in the history
PR haskell#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 haskell#5318.
  • Loading branch information
quasicomputational committed May 13, 2018
1 parent 765de7b commit c8af0a4
Show file tree
Hide file tree
Showing 10 changed files with 54 additions and 4 deletions.
12 changes: 11 additions & 1 deletion Cabal/Distribution/Simple/Glob.hs
Original file line number Diff line number Diff line change
Expand Up @@ -145,6 +145,16 @@ matchDirFileGlob :: Verbosity -> Version -> FilePath -> FilePath -> IO [FilePath
matchDirFileGlob verbosity version dir 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 dir) $
warn verbosity $
"Null dir passed to matchDirFileGlob; interpreting it "
++ "as '.'. This is probably an internal error."
let dir' = if null dir then "." else dir
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
Expand All @@ -154,7 +164,7 @@ matchDirFileGlob verbosity version dir filepath = case parseFileGlob version fil
-- for!
let (prefixSegments, pat') = splitConstantPrefix pat
joinedPrefix = joinPath prefixSegments
files <- getDirectoryContentsRecursive (dir </> joinedPrefix)
files <- getDirectoryContentsRecursive (dir' </> joinedPrefix)
case filter (fileGlobMatches pat') files of
[] -> die' verbosity $
"filepath wildcard '" ++ filepath
Expand Down
5 changes: 4 additions & 1 deletion Cabal/Distribution/Simple/Install.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ""
files <- matchDirFileGlob verbosity (specVersion pkg_descr) srcDataDir file
let dir = takeDirectory file
createDirectoryIfMissingVerbose verbosity True (destDataDir </> dir)
Expand Down
8 changes: 6 additions & 2 deletions Cabal/Distribution/Simple/SrcDist.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ""
in fmap (fmap (srcDataDir </>)) $
matchDirFileGlob verbosity (specVersion pkg_descr) srcDataDir filename

-- Extra doc files.
, fmap concat
Expand Down
1 change: 1 addition & 0 deletions cabal-testsuite/PackageTests/Regression/T5318/Main.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
main = putStrLn "hi"
10 changes: 10 additions & 0 deletions cabal-testsuite/PackageTests/Regression/T5318/empty-data-dir.cabal
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
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
1 change: 1 addition & 0 deletions cabal-testsuite/PackageTests/Regression/T5318/foo.dat
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Hello!
8 changes: 8 additions & 0 deletions cabal-testsuite/PackageTests/Regression/T5318/install.out
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
# 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
3 changes: 3 additions & 0 deletions cabal-testsuite/PackageTests/Regression/T5318/install.test.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
import Test.Cabal.Prelude
main = cabalTest $
cabal "install" []
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
# cabal sdist
List of package sources written to file '<TMPDIR>/sources'
List of package sources written to file '<TMPDIR>/sources'
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
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"

0 comments on commit c8af0a4

Please sign in to comment.