From 8a00e000f181a4c0da46949dea38cf022567b2c3 Mon Sep 17 00:00:00 2001 From: quasicomputational Date: Wed, 25 Apr 2018 18:12:14 +0100 Subject: [PATCH] Allow ** wildcards in globs. These are inspired by a plan described in a comment in #2522, and only implement a quite limited form of recursive matching: only a single ** wildcard is accepted, it must be the final directory, and, if a ** wildcard is present, the file name must include a wildcard. Or-patterns are not implemented, for simplicity. Closes #3178, #2030. --- Cabal/Cabal.cabal | 2 + Cabal/ChangeLog.md | 3 + .../Distribution/PackageDescription/Check.hs | 24 ++- Cabal/Distribution/Simple/Glob.hs | 145 ++++++++++++++++++ Cabal/Distribution/Simple/Haddock.hs | 3 +- Cabal/Distribution/Simple/Install.hs | 5 +- Cabal/Distribution/Simple/SrcDist.hs | 13 +- Cabal/Distribution/Simple/Utils.hs | 53 +------ Cabal/doc/developing-packages.rst | 33 ++-- Cabal/tests/CheckTests.hs | 3 + .../regressions/bad-glob-syntax.cabal | 16 ++ .../regressions/bad-glob-syntax.check | 2 + .../regressions/pre-1.6-glob.cabal | 17 ++ .../regressions/pre-1.6-glob.check | 1 + .../regressions/pre-2.4-globstar.cabal | 19 +++ .../regressions/pre-2.4-globstar.check | 3 + Cabal/tests/UnitTests.hs | 3 + .../UnitTests/Distribution/Simple/Glob.hs | 116 ++++++++++++++ 18 files changed, 387 insertions(+), 74 deletions(-) create mode 100644 Cabal/Distribution/Simple/Glob.hs create mode 100644 Cabal/tests/ParserTests/regressions/bad-glob-syntax.cabal create mode 100644 Cabal/tests/ParserTests/regressions/bad-glob-syntax.check create mode 100644 Cabal/tests/ParserTests/regressions/pre-1.6-glob.cabal create mode 100644 Cabal/tests/ParserTests/regressions/pre-1.6-glob.check create mode 100644 Cabal/tests/ParserTests/regressions/pre-2.4-globstar.cabal create mode 100644 Cabal/tests/ParserTests/regressions/pre-2.4-globstar.check create mode 100644 Cabal/tests/UnitTests/Distribution/Simple/Glob.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index f3e84175ca5..cab9cf8c386 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -258,6 +258,7 @@ library Distribution.Simple.GHCJS Distribution.Simple.Haddock Distribution.Simple.Doctest + Distribution.Simple.Glob Distribution.Simple.HaskellSuite Distribution.Simple.Hpc Distribution.Simple.Install @@ -479,6 +480,7 @@ test-suite unit-tests UnitTests.Distribution.Compat.ReadP UnitTests.Distribution.Compat.Time UnitTests.Distribution.Compat.Graph + UnitTests.Distribution.Simple.Glob UnitTests.Distribution.Simple.Program.Internal UnitTests.Distribution.Simple.Utils UnitTests.Distribution.SPDX diff --git a/Cabal/ChangeLog.md b/Cabal/ChangeLog.md index 1b24d167b53..9e4fe28a962 100644 --- a/Cabal/ChangeLog.md +++ b/Cabal/ChangeLog.md @@ -8,6 +8,9 @@ out of its misery (#4383). * Added `Eta` to `CompilerFlavor` and to known compilers. * `cabal haddock` now generates per-component documentation (#5226). + * Allow `**` wildcards in `data-files`, `extra-source-files` and + `extra-doc-files`. These allow a limited form of recursive + matching. (#3178 et al). ---- diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs index 9bae54e14ff..b2c80f6e7b1 100644 --- a/Cabal/Distribution/PackageDescription/Check.hs +++ b/Cabal/Distribution/PackageDescription/Check.hs @@ -48,6 +48,7 @@ import Distribution.Pretty (prettyShow) import Distribution.Simple.BuildPaths (autogenPathsModuleName) import Distribution.Simple.BuildToolDepends import Distribution.Simple.CCompiler +import Distribution.Simple.Glob import Distribution.Simple.Utils hiding (findPackageDesc, notice) import Distribution.System import Distribution.Text @@ -1045,6 +1046,24 @@ checkPaths pkg = , (GHC, flags) <- options bi , path <- flags , isInsideDist path ] + ++ + [ PackageDistInexcusable $ + "In the 'data-files' field: " ++ explainGlobSyntaxError pat err + | pat <- dataFiles pkg + , Left err <- [parseFileGlob (specVersion pkg) pat] + ] + ++ + [ PackageDistInexcusable $ + "In the 'extra-source-files' field: " ++ explainGlobSyntaxError pat err + | pat <- extraSrcFiles pkg + , Left err <- [parseFileGlob (specVersion pkg) pat] + ] + ++ + [ PackageDistInexcusable $ + "In the 'extra-doc-files' field: " ++ explainGlobSyntaxError pat err + | pat <- extraDocFiles pkg + , Left err <- [parseFileGlob (specVersion pkg) pat] + ] where isOutsideTree path = case splitDirectories path of "..":_ -> True @@ -1358,11 +1377,10 @@ checkCabalVersion pkg = | otherwise = check cond pc buildInfoField field = map field (allBuildInfo pkg) + dataFilesUsingGlobSyntax = filter usesGlobSyntax (dataFiles pkg) extraSrcFilesUsingGlobSyntax = filter usesGlobSyntax (extraSrcFiles pkg) - usesGlobSyntax str = case parseFileGlob str of - Just (FileGlob _ _) -> True - _ -> False + usesGlobSyntax = not . isLiteralFileGlob versionRangeExpressions = [ dep | dep@(Dependency _ vr) <- allBuildDepends pkg diff --git a/Cabal/Distribution/Simple/Glob.hs b/Cabal/Distribution/Simple/Glob.hs new file mode 100644 index 00000000000..171528dc1f7 --- /dev/null +++ b/Cabal/Distribution/Simple/Glob.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Glob +-- Copyright : Isaac Jones, Simon Marlow 2003-2004 +-- License : BSD3 +-- portions Copyright (c) 2007, Galois Inc. +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Simple file globbing. + +module Distribution.Simple.Glob ( + matchFileGlob, + matchDirFileGlob, + isLiteralFileGlob, + fileGlobMatches, + parseFileGlob, + explainGlobSyntaxError, + GlobSyntaxError(..), + GlobPat, + ) where + +import Prelude () +import Distribution.Compat.Prelude + +import Distribution.Simple.Utils +import Distribution.Verbosity +import Distribution.Version + +import System.FilePath (splitExtensions, splitPath, takeExtensions) + +data GlobSyntaxError + = StarInDirectory + | StarInFileName + | StarInExtension + | NoExtensionOnStar + | EmptyGlob + | LiteralFileNameGlobStar + | VersionDoesNotSupportGlobStar + deriving (Eq, Show) + +explainGlobSyntaxError :: FilePath -> GlobSyntaxError -> String +explainGlobSyntaxError filepath StarInDirectory = + "invalid file glob '" ++ filepath + ++ "'. A wildcard '**' is only allowed as the final parent" + ++ " directory. Stars must not otherwise appear in the parent" + ++ " directories." +explainGlobSyntaxError filepath StarInExtension = + "invalid file glob '" ++ filepath + ++ "'. Wildcards '*' are only allowed as the" + ++ " file's base name, not in the file extension." +explainGlobSyntaxError filepath StarInFileName = + "invalid file glob '" ++ filepath + ++ "'. Wildcards '*' may only totally replace the" + ++ " file's base name, not only parts of it." +explainGlobSyntaxError filepath NoExtensionOnStar = + "invalid file glob '" ++ filepath + ++ "'. If a wildcard '*' is used it must be with an file extension." +explainGlobSyntaxError filepath LiteralFileNameGlobStar = + "invalid file glob '" ++ filepath + ++ "'. If a wildcard '**' is used as a parent directory, the" + ++ " file's base name must be a wildcard '*'." +explainGlobSyntaxError _ EmptyGlob = + "invalid file glob. A glob cannot be the empty string." +explainGlobSyntaxError filepath VersionDoesNotSupportGlobStar = + "invalid file glob '" ++ filepath + ++ "'. Using the double-star syntax requires 'cabal-version: 2.4'" + ++ " or greater. Alternatively, for compatibility with earlier Cabal" + ++ " versions, list the included directories explicitly." + +data IsRecursive = Recursive | NonRecursive + +data GlobPat = PatStem String GlobPat -- ^ A single subdirectory component + remainder. + | PatMatch IsRecursive -- ^ Is this a **/*.ext pattern? + String -- ^ Extensions + | PatLit FilePath -- ^ Literal file name. + +isLiteralFileGlob :: FilePath -> Bool +isLiteralFileGlob filepath = case parseFileGlob (mkVersion [2,4]) filepath of + Left _ -> False + Right pat -> check pat + where + check (PatStem _ pat) = check pat + check (PatMatch _ _) = False + check (PatLit _) = True + +fileGlobMatches :: GlobPat -> FilePath -> Bool +fileGlobMatches pat = fileGlobMatchesSegments pat . splitPath + +fileGlobMatchesSegments :: GlobPat -> [FilePath] -> Bool +fileGlobMatchesSegments _ [] = False +fileGlobMatchesSegments pat (seg : segs) = case pat of + PatStem dir pat' -> + dir == seg && fileGlobMatchesSegments pat' segs + PatMatch Recursive ext -> + ext == takeExtensions (foldl' (flip const) seg segs) + PatMatch NonRecursive ext -> + null segs && ext == takeExtensions seg + PatLit filename -> + null segs && filename == seg + +parseFileGlob :: Version -> FilePath -> Either GlobSyntaxError GlobPat +parseFileGlob version filepath = case reverse (splitPath filepath) of + [] -> + Left EmptyGlob + (filename : "**/" : segments) + | allowGlobStar -> do + ext <- case splitExtensions filename of + ("*", ext) | '*' `elem` ext -> Left StarInExtension + | null ext -> Left NoExtensionOnStar + | otherwise -> Right ext + _ -> Left LiteralFileNameGlobStar + foldM addStem (PatMatch Recursive ext) segments + | otherwise -> Left VersionDoesNotSupportGlobStar + (filename : segments) -> do + pat <- case splitExtensions filename of + ("*", ext) | '*' `elem` ext -> Left StarInExtension + | null ext -> Left NoExtensionOnStar + | otherwise -> Right (PatMatch NonRecursive ext) + (_, ext) | '*' `elem` ext -> Left StarInExtension + | '*' `elem` filename -> Left StarInFileName + | otherwise -> Right (PatLit filename) + foldM addStem pat segments + where + allowGlobStar = version >= mkVersion [2,4] + addStem pat seg + | '*' `elem` seg = Left StarInDirectory + | otherwise = Right (PatStem seg pat) + +matchFileGlob :: Verbosity -> Version -> FilePath -> IO [FilePath] +matchFileGlob verbosity version = matchDirFileGlob verbosity version "." + +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 + files <- getDirectoryContentsRecursive dir + case filter (fileGlobMatches pat) files of + [] -> die' verbosity $ + "filepath wildcard '" ++ filepath + ++ "' does not match any files." + matches -> return matches diff --git a/Cabal/Distribution/Simple/Haddock.hs b/Cabal/Distribution/Simple/Haddock.hs index 5ec1e83a451..68b46eef24f 100644 --- a/Cabal/Distribution/Simple/Haddock.hs +++ b/Cabal/Distribution/Simple/Haddock.hs @@ -42,6 +42,7 @@ import Distribution.Package import qualified Distribution.ModuleName as ModuleName import Distribution.PackageDescription as PD hiding (Flag) import Distribution.Simple.Compiler hiding (Flag) +import Distribution.Simple.Glob import Distribution.Simple.Program.GHC import Distribution.Simple.Program.ResponseFile import Distribution.Simple.Program @@ -258,7 +259,7 @@ haddock pkg_descr lbi suffixes flags' = do CBench _ -> when (flag haddockBenchmarks) $ smsg >> doExe component for_ (extraDocFiles pkg_descr) $ \ fpath -> do - files <- matchFileGlob fpath + files <- matchFileGlob verbosity (specVersion pkg_descr) fpath for_ files $ copyFileTo verbosity (unDir $ argOutputDir commonArgs) -- ------------------------------------------------------------------------------ diff --git a/Cabal/Distribution/Simple/Install.hs b/Cabal/Distribution/Simple/Install.hs index 8ba8f89b758..ce9a2d9fba0 100644 --- a/Cabal/Distribution/Simple/Install.hs +++ b/Cabal/Distribution/Simple/Install.hs @@ -33,10 +33,11 @@ import Distribution.Package import Distribution.PackageDescription import Distribution.Simple.LocalBuildInfo import Distribution.Simple.BuildPaths (haddockName, haddockPref) +import Distribution.Simple.Glob (matchDirFileGlob) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose , installDirectoryContents, installOrdinaryFile, isInSearchPath - , die', info, noticeNoWrap, warn, matchDirFileGlob ) + , die', info, noticeNoWrap, warn ) import Distribution.Simple.Compiler ( CompilerFlavor(..), compilerFlavor ) import Distribution.Simple.Setup @@ -235,7 +236,7 @@ installDataFiles :: Verbosity -> PackageDescription -> FilePath -> IO () installDataFiles verbosity pkg_descr destDataDir = flip traverse_ (dataFiles pkg_descr) $ \ file -> do let srcDataDir = dataDir pkg_descr - files <- matchDirFileGlob srcDataDir file + files <- matchDirFileGlob verbosity (specVersion pkg_descr) srcDataDir file let dir = takeDirectory file createDirectoryIfMissingVerbose verbosity True (destDataDir dir) sequence_ [ installOrdinaryFile verbosity (srcDataDir file') diff --git a/Cabal/Distribution/Simple/SrcDist.hs b/Cabal/Distribution/Simple/SrcDist.hs index 1011788f02e..a9271031986 100644 --- a/Cabal/Distribution/Simple/SrcDist.hs +++ b/Cabal/Distribution/Simple/SrcDist.hs @@ -52,6 +52,7 @@ import Distribution.Package import Distribution.ModuleName import qualified Distribution.ModuleName as ModuleName import Distribution.Version +import Distribution.Simple.Glob import Distribution.Simple.Utils import Distribution.Simple.Setup import Distribution.Simple.PreProcess @@ -137,16 +138,16 @@ listPackageSources :: Verbosity -- ^ verbosity listPackageSources verbosity pkg_descr0 pps = do -- Call helpers that actually do all work. ordinary <- listPackageSourcesOrdinary verbosity pkg_descr pps - maybeExecutable <- listPackageSourcesMaybeExecutable pkg_descr + maybeExecutable <- listPackageSourcesMaybeExecutable verbosity pkg_descr return (ordinary, maybeExecutable) where pkg_descr = filterAutogenModules pkg_descr0 -- | List those source files that may be executable (e.g. the configure script). -listPackageSourcesMaybeExecutable :: PackageDescription -> IO [FilePath] -listPackageSourcesMaybeExecutable pkg_descr = +listPackageSourcesMaybeExecutable :: Verbosity -> PackageDescription -> IO [FilePath] +listPackageSourcesMaybeExecutable verbosity pkg_descr = -- Extra source files. - fmap concat . for (extraSrcFiles pkg_descr) $ \fpath -> matchFileGlob fpath + fmap concat . for (extraSrcFiles pkg_descr) $ \fpath -> matchFileGlob verbosity (specVersion pkg_descr) fpath -- | List those source files that should be copied with ordinary permissions. listPackageSourcesOrdinary :: Verbosity @@ -208,12 +209,12 @@ listPackageSourcesOrdinary verbosity pkg_descr pps = -- Data files. , fmap concat . for (dataFiles pkg_descr) $ \filename -> - matchFileGlob (dataDir pkg_descr filename) + matchFileGlob verbosity (specVersion pkg_descr) (dataDir pkg_descr filename) -- Extra doc files. , fmap concat . for (extraDocFiles pkg_descr) $ \ filename -> - matchFileGlob filename + matchFileGlob verbosity (specVersion pkg_descr) filename -- License file(s). , return (licenseFiles pkg_descr) diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs index 35c5a2edcc0..ea8caf58bc0 100644 --- a/Cabal/Distribution/Simple/Utils.hs +++ b/Cabal/Distribution/Simple/Utils.hs @@ -108,12 +108,6 @@ module Distribution.Simple.Utils ( isInSearchPath, addLibraryPath, - -- * simple file globbing - matchFileGlob, - matchDirFileGlob, - parseFileGlob, - FileGlob(..), - -- * modification time moreRecentFile, existsAndIsMoreRecentThan, @@ -219,9 +213,8 @@ import System.Exit ( exitWith, ExitCode(..) ) import System.FilePath ( normalise, (), (<.>) - , getSearchPath, joinPath, takeDirectory, splitFileName - , splitExtension, splitExtensions, splitDirectories - , searchPathSeparator ) + , getSearchPath, joinPath, takeDirectory, splitExtension + , splitDirectories, searchPathSeparator ) import System.IO ( Handle, hSetBinaryMode, hGetContents, stderr, stdout, hPutStr, hFlush , hClose, hSetBuffering, BufferMode(..) ) @@ -1111,48 +1104,6 @@ addLibraryPath os paths = addEnv else (key,value ++ (searchPathSeparator:pathsString)):xs | otherwise = (key,value):addEnv xs ----------------- --- File globbing - -data FileGlob - -- | No glob at all, just an ordinary file - = NoGlob FilePath - - -- | dir prefix and extension, like @\"foo\/bar\/\*.baz\"@ corresponds to - -- @FileGlob \"foo\/bar\" \".baz\"@ - | FileGlob FilePath String - -parseFileGlob :: FilePath -> Maybe FileGlob -parseFileGlob filepath = case splitExtensions filepath of - (filepath', ext) -> case splitFileName filepath' of - (dir, "*") | '*' `elem` dir - || '*' `elem` ext - || null ext -> Nothing - | null dir -> Just (FileGlob "." ext) - | otherwise -> Just (FileGlob dir ext) - _ | '*' `elem` filepath -> Nothing - | otherwise -> Just (NoGlob filepath) - -matchFileGlob :: FilePath -> IO [FilePath] -matchFileGlob = matchDirFileGlob "." - -matchDirFileGlob :: FilePath -> FilePath -> IO [FilePath] -matchDirFileGlob dir filepath = case parseFileGlob filepath of - Nothing -> die $ "invalid file glob '" ++ filepath - ++ "'. Wildcards '*' are only allowed in place of the file" - ++ " name, not in the directory name or file extension." - ++ " If a wildcard is used it must be with an file extension." - Just (NoGlob filepath') -> return [filepath'] - Just (FileGlob dir' ext) -> do - files <- getDirectoryContents (dir dir') - case [ dir' file - | file <- files - , let (name, ext') = splitExtensions file - , not (null name) && ext' == ext ] of - [] -> die $ "filepath wildcard '" ++ filepath - ++ "' does not match any files." - matches -> return matches - -------------------- -- Modification time diff --git a/Cabal/doc/developing-packages.rst b/Cabal/doc/developing-packages.rst index bc02be314b4..fea42a0ede6 100644 --- a/Cabal/doc/developing-packages.rst +++ b/Cabal/doc/developing-packages.rst @@ -981,17 +981,28 @@ describe the package as a whole: A limited form of ``*`` wildcards in file names, for example ``data-files: images/*.png`` matches all the ``.png`` files in the - ``images`` directory. - - The limitation is that ``*`` wildcards are only allowed in place of - the file name, not in the directory name or file extension. In - particular, wildcards do not include directories contents - recursively. Furthermore, if a wildcard is used it must be used with - an extension, so ``data-files: data/*`` is not allowed. When - matching a wildcard plus extension, a file's full extension must - match exactly, so ``*.gz`` matches ``foo.gz`` but not - ``foo.tar.gz``. A wildcard that does not match any files is an - error. + ``images`` directory. ``data-files: audio/**/*.mp3`` matches all + the ``.mp3`` files in the ``audio`` directory, including + subdirectories. + + The specific limitations of this wildcard syntax are + + - ``*`` wildcards are only allowed in place of the file name, not + in the directory name or file extension. It must replace the + whole file name (e.g., ``*.html`` is allowed, but + ``chapter-*.html`` is not). Furthermore, if a wildcard is used + it must be used with an extension, so ``data-files: data/*`` is + not allowed. When matching a wildcard plus extension, a file's + full extension must match exactly, so ``*.gz`` matches + ``foo.gz`` but not ``foo.tar.gz``. + + - ``**`` wildcards can only appear as the final path component + before the file name (e.g., ``data/**/images/*.jpg`` is not + allowed). If a ``**`` wildcard is used, then the file name must + include a ``*`` wildcard (e.g., ``data/**/README.rst`` is not + allowed). + + - A wildcard that does not match any files is an error. The reason for providing only a very limited form of wildcard is to concisely express the common case of a large number of related files diff --git a/Cabal/tests/CheckTests.hs b/Cabal/tests/CheckTests.hs index 12105a67912..e637f59d33f 100644 --- a/Cabal/tests/CheckTests.hs +++ b/Cabal/tests/CheckTests.hs @@ -30,6 +30,9 @@ checkTests = testGroup "regressions" , checkTest "issue-774.cabal" , checkTest "MiniAgda.cabal" , checkTest "extensions-paths-5054.cabal" + , checkTest "pre-1.6-glob.cabal" + , checkTest "pre-2.4-globstar.cabal" + , checkTest "bad-glob-syntax.cabal" ] checkTest :: FilePath -> TestTree diff --git a/Cabal/tests/ParserTests/regressions/bad-glob-syntax.cabal b/Cabal/tests/ParserTests/regressions/bad-glob-syntax.cabal new file mode 100644 index 00000000000..d8eb24e1f86 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/bad-glob-syntax.cabal @@ -0,0 +1,16 @@ +cabal-version: 2.2 +name: pre-2dot4-globstar +version: 0 +extra-source-files: + foo/**/.hs + foo/*/bar +license: BSD-3-Clause +synopsis: no +description: none +category: Test +maintainer: none + +library + default-language: Haskell2010 + exposed-modules: + Foo diff --git a/Cabal/tests/ParserTests/regressions/bad-glob-syntax.check b/Cabal/tests/ParserTests/regressions/bad-glob-syntax.check new file mode 100644 index 00000000000..5d3086b1964 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/bad-glob-syntax.check @@ -0,0 +1,2 @@ +In the 'extra-source-files' field: invalid file glob 'foo/**/.hs'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. +In the 'extra-source-files' field: invalid file glob 'foo/*/bar'. A wildcard '**' is only allowed as the final parent directory. Stars must not otherwise appear in the parent directories. diff --git a/Cabal/tests/ParserTests/regressions/pre-1.6-glob.cabal b/Cabal/tests/ParserTests/regressions/pre-1.6-glob.cabal new file mode 100644 index 00000000000..2760f48f64f --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/pre-1.6-glob.cabal @@ -0,0 +1,17 @@ +cabal-version: >= 1.4 +name: pre-1dot6-glob +version: 0 +license: BSD3 +license-file: pre-1.6-glob.cabal +synopsis: no +description: none +build-type: Simple +category: Test +maintainer: none + +extra-source-files: + foo/*.hs + +library + exposed-modules: + Foo diff --git a/Cabal/tests/ParserTests/regressions/pre-1.6-glob.check b/Cabal/tests/ParserTests/regressions/pre-1.6-glob.check new file mode 100644 index 00000000000..4c28ee6debf --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/pre-1.6-glob.check @@ -0,0 +1 @@ +Using wildcards like 'foo/*.hs' in the 'extra-source-files' field requires 'cabal-version: >= 1.6'. Alternatively if you require compatibility with earlier Cabal versions then list all the files explicitly. diff --git a/Cabal/tests/ParserTests/regressions/pre-2.4-globstar.cabal b/Cabal/tests/ParserTests/regressions/pre-2.4-globstar.cabal new file mode 100644 index 00000000000..b34448150ea --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/pre-2.4-globstar.cabal @@ -0,0 +1,19 @@ +cabal-version: 2.2 +name: pre-2dot4-globstar +version: 0 +extra-source-files: + foo/**/*.hs +extra-doc-files: + foo/**/*.html +data-files: + foo/**/*.dat +license: BSD-3-Clause +synopsis: no +description: none +category: Test +maintainer: none + +library + default-language: Haskell2010 + exposed-modules: + Foo diff --git a/Cabal/tests/ParserTests/regressions/pre-2.4-globstar.check b/Cabal/tests/ParserTests/regressions/pre-2.4-globstar.check new file mode 100644 index 00000000000..331d5a0ade9 --- /dev/null +++ b/Cabal/tests/ParserTests/regressions/pre-2.4-globstar.check @@ -0,0 +1,3 @@ +In the 'data-files' field: invalid file glob 'foo/**/*.dat'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. +In the 'extra-source-files' field: invalid file glob 'foo/**/*.hs'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. +In the 'extra-doc-files' field: invalid file glob 'foo/**/*.html'. Using the double-star syntax requires 'cabal-version: 2.4' or greater. Alternatively, for compatibility with earlier Cabal versions, list the included directories explicitly. diff --git a/Cabal/tests/UnitTests.hs b/Cabal/tests/UnitTests.hs index 3b381da0b32..7df187c68db 100644 --- a/Cabal/tests/UnitTests.hs +++ b/Cabal/tests/UnitTests.hs @@ -17,6 +17,7 @@ import qualified UnitTests.Distribution.Compat.CreatePipe import qualified UnitTests.Distribution.Compat.ReadP import qualified UnitTests.Distribution.Compat.Time import qualified UnitTests.Distribution.Compat.Graph +import qualified UnitTests.Distribution.Simple.Glob import qualified UnitTests.Distribution.Simple.Program.Internal import qualified UnitTests.Distribution.Simple.Utils import qualified UnitTests.Distribution.System @@ -43,6 +44,8 @@ tests mtimeChangeCalibrated = (UnitTests.Distribution.Compat.Time.tests mtimeChange) , testGroup "Distribution.Compat.Graph" UnitTests.Distribution.Compat.Graph.tests + , testGroup "Distribution.Simple.Glob" + UnitTests.Distribution.Simple.Glob.tests , testGroup "Distribution.Simple.Program.Internal" UnitTests.Distribution.Simple.Program.Internal.tests , testGroup "Distribution.Simple.Utils" diff --git a/Cabal/tests/UnitTests/Distribution/Simple/Glob.hs b/Cabal/tests/UnitTests/Distribution/Simple/Glob.hs new file mode 100644 index 00000000000..5ca06668294 --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Simple/Glob.hs @@ -0,0 +1,116 @@ +module UnitTests.Distribution.Simple.Glob + ( tests + ) where + +import Control.Monad +import Data.List (sort) +import Distribution.Simple.Glob +import Distribution.Version + +import Test.Tasty +import Test.Tasty.HUnit + +sampleFileNames :: [FilePath] +sampleFileNames = + [ "a" + , "a.html" + , "b.html" + , "b.html.gz" + , "c.en.html" + , "foo/a" + , "foo/a.html" + , "foo/a.html.gz" + , "foo/a.tex" + , "foo/a.tex.gz" + , "foo/b.html" + , "foo/b.html.gz" + , "foo/bar/a.html" + , "foo/bar/a.html.gz" + , "foo/bar/a.tex" + , "foo/bar/a.tex.gz" + , "foo/bar/b.html" + , "foo/bar/b.html.gz" + , "foo/c.html/blah" + , "xyz/foo/a.html" + ] + +compatibilityTests :: Version -> [TestTree] +compatibilityTests version = + [ testCase "literal match" $ + testMatches "foo/a" ["foo/a"] + , testCase "literal no match on prefix" $ + testMatches "foo/c.html" [] + , testCase "literal no match on suffix" $ + testMatches "foo/a.html" ["foo/a.html"] + , testCase "literal no prefix" $ + testMatches "a" ["a"] + , testCase "literal multiple prefix" $ + testMatches "foo/bar/a.html" ["foo/bar/a.html"] + , testCase "glob" $ + testMatches "*.html" ["a.html", "b.html"] + , testCase "glob in subdir" $ + testMatches "foo/*.html" ["foo/a.html", "foo/b.html"] + , testCase "glob multiple extensions" $ + testMatches "foo/*.html.gz" ["foo/a.html.gz", "foo/b.html.gz"] + , testCase "glob single extension not matching multiple" $ + testMatches "foo/*.gz" [] + , testCase "glob in deep subdir" $ + testMatches "foo/bar/*.tex" ["foo/bar/a.tex"] + , testCase "star in directory" $ + testFailParse "blah/*/foo" StarInDirectory + , testCase "star plus text in segment" $ + testFailParse "xyz*/foo" StarInDirectory + , testCase "star in filename plus text" $ + testFailParse "foo*.bar" StarInFileName + , testCase "no extension on star" $ + testFailParse "foo/*" NoExtensionOnStar + , testCase "star in extension" $ + testFailParse "foo.*.gz" StarInExtension + ] + where + testMatches = testMatchesVersion version + testFailParse = testFailParseVersion version + +testMatchesVersion :: Version -> FilePath -> [FilePath] -> Assertion +testMatchesVersion version pat expected = + case parseFileGlob version pat of + Left _ -> assertFailure "Couldn't compile the pattern." + Right globPat -> + let actual = filter (fileGlobMatches globPat) sampleFileNames + in unless (sort expected == sort actual) $ + assertFailure $ "Unexpected result: " ++ show actual + +testFailParseVersion :: Version -> FilePath -> GlobSyntaxError -> Assertion +testFailParseVersion version pat expected = + case parseFileGlob version pat of + Left err -> unless (expected == err) $ + assertFailure $ "Unexpected error: " ++ show err + Right _ -> assertFailure "Unexpected success in parsing." + +globstarTests :: [TestTree] +globstarTests = + [ testCase "fails to parse on early spec version" $ + testFailParseVersion (mkVersion [2,2]) "**/*.html" VersionDoesNotSupportGlobStar + , testCase "out-of-place double star" $ + testFailParse "blah/**/blah/*.foo" StarInDirectory + , testCase "multiple double star" $ + testFailParse "blah/**/**/*.foo" StarInDirectory + , testCase "fails with literal filename" $ + testFailParse "**/a.html" LiteralFileNameGlobStar + , testCase "with glob filename" $ + testMatches "**/*.html" ["a.html", "b.html", "foo/a.html", "foo/b.html", "foo/bar/a.html", "foo/bar/b.html", "xyz/foo/a.html"] + , testCase "glob with prefix" $ + testMatches "foo/**/*.html" ["foo/a.html", "foo/b.html", "foo/bar/a.html", "foo/bar/b.html"] + ] + where + testFailParse = testFailParseVersion (mkVersion [2,4]) + testMatches = testMatchesVersion (mkVersion [2,4]) + +tests :: [TestTree] +tests = + [ testGroup "pre-2.4 compatibility" $ + compatibilityTests (mkVersion [2,2]) + , testGroup "post-2.4 compatibility" $ + compatibilityTests (mkVersion [2,4]) + , testGroup "globstar" globstarTests + ]