Make sure sdist is robust to accidentally-listed directories

The refactor of the globbing modules re-uncovered this issue, and
required a prompt fix for the refactor not to break some things.

Fixes haskell#5349

Cabal-tests/tests/UnitTests/Distribution/Simple/Glob.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module UnitTests.Distribution.Simple.Glob
     ( tests
     ) where
@@ -54,7 +55,7 @@ compatibilityTests version =
   [ testCase "literal match" $
       testMatches "foo/a" [GlobMatch "foo/a"]
   , testCase "literal no match on prefix" $
-      testMatches "foo/c.html" []
+      testMatches "foo/c.html" [GlobMatchesDirectory "foo/c.html"]
   , testCase "literal no match on suffix" $
       testMatches "foo/a.html" [GlobMatch "foo/a.html"]
   , testCase "literal no prefix" $
@@ -64,7 +65,7 @@ compatibilityTests version =
   , testCase "glob" $
       testMatches "*.html" [GlobMatch "a.html", GlobMatch "b.html"]
   , testCase "glob in subdir" $
-      testMatches "foo/*.html" [GlobMatch "foo/a.html", GlobMatch "foo/b.html"]
+      testMatches "foo/*.html" [GlobMatchesDirectory "foo/c.html", GlobMatch "foo/b.html", GlobMatch "foo/a.html"]
   , testCase "glob multiple extensions" $
       testMatches "foo/*.html.gz" [GlobMatch "foo/a.html.gz", GlobMatch "foo/b.html.gz"]
   , testCase "glob in deep subdir" $
@@ -102,14 +103,17 @@ testMatchesVersion version pat expected = do
     isEqual = (==) `on` (sort . fmap (fmap normalise))
     checkPure globPat = do
       let actual = mapMaybe (\p -> (p <$) <$> fileGlobMatches version globPat p) sampleFileNames
-      unless (sort expected == sort actual) $
+          -- We drop directory matches from the expected results since the pure
+          -- check can't identify that kind of match.
+          expected' = filter (\case GlobMatchesDirectory _ -> False; _ -> True) expected
+      unless (sort expected' == sort actual) $
         assertFailure $ "Unexpected result (pure matcher): " ++ show actual
     checkIO globPat =
       withSystemTempDirectory "globstar-sample" $ \tmpdir -> do
         makeSampleFiles tmpdir
         actual <- runDirFileGlob Verbosity.normal (Just version) tmpdir globPat
         unless (isEqual actual expected) $
-          assertFailure $ "Unexpected result (impure matcher): " ++ show actual
+          assertFailure $ "Unexpected result (impure matcher): " ++ show actual ++ ". Normalised actual result (" ++ show (normalise actual) ++ ") doesn't match expected normalised result (" ++ show (normalise expected) ++ ")."
 
 testFailParseVersion :: CabalSpecVersion -> FilePath -> GlobSyntaxError -> Assertion
 testFailParseVersion version pat expected =

Cabal/src/Distribution/PackageDescription/Check.hs

@@ -861,6 +861,7 @@ checkGlobResult title fp rs = dirCheck ++ catMaybes (map getWarning rs)
     withoutNoMatchesWarning (GlobMatch _) = True
     withoutNoMatchesWarning (GlobWarnMultiDot _) = False
     withoutNoMatchesWarning (GlobMissingDirectory _) = True
+    withoutNoMatchesWarning (GlobMatchesDirectory _) = True
 
     getWarning :: GlobResult FilePath -> Maybe PackageCheck
     getWarning (GlobMatch _) = Nothing
@@ -872,6 +873,7 @@ checkGlobResult title fp rs = dirCheck ++ catMaybes (map getWarning rs)
       Just $ PackageDistSuspiciousWarn (GlobExactMatch title fp file)
     getWarning (GlobMissingDirectory dir) =
       Just $ PackageDistSuspiciousWarn (GlobNoDir title fp dir)
+    getWarning (GlobMatchesDirectory _) = Nothing -- is handled elsewhere if relevant, it is not necessarily a problem
 
 -- ------------------------------------------------------------
 -- Other exports

Cabal/src/Distribution/Simple/Glob.hs

@@ -148,6 +148,7 @@ matchFileGlobRel root glob =
     ( \case
         GlobMatch a -> Just a
         GlobWarnMultiDot a -> Just a
+        GlobMatchesDirectory a -> Just a
         GlobMissingDirectory{} -> Nothing
     )
     <$> runDirFileGlob silent Nothing root glob
@@ -414,6 +415,8 @@ data GlobResult a
     --   relative to the directory passed to 'matchDirFileGlob', and,
     --   for 'data-files', relative to 'data-dir').
     GlobMissingDirectory FilePath
+  | -- | The glob matched a directory when we were looking for files only. It didn't match a file!
+    GlobMatchesDirectory FilePath
   deriving (Show, Eq, Ord, Functor)
 
 -- | Extract the matches from a list of 'GlobResult's.
@@ -450,6 +453,7 @@ matchDirFileGlobWithDie verbosity rip version dir filepath = case parseFileGlob
     let missingDirectories =
           [missingDir | GlobMissingDirectory missingDir <- results]
         matches = globMatches results
+        directoryMatches = [a | GlobMatchesDirectory a <- results]
 
     let errors :: [String]
         errors =
@@ -462,11 +466,22 @@ matchDirFileGlobWithDie verbosity rip version dir filepath = case parseFileGlob
           | missingDir <- missingDirectories
           ]
             ++ [ "filepath wildcard '" ++ filepath ++ "' does not match any files."
-               | null matches
+               | null matches && null directoryMatches
+               -- we don't error out on directory matches, simply warn about them and ignore.
                ]
 
+        warns :: [String]
+        warns =
+          [ "Ignoring directory '" ++ path ++ "'" ++ " listed in a Cabal package field which should only include files (not directories)."
+          | path <- directoryMatches
+          ]
+
     if null errors
-      then return matches
+      then do
+        unless (null warns) $
+          warn verbosity $
+            unlines warns
+        return matches
       else rip verbosity $ MatchDirFileGlobErrors errors
 
 -- | Match files against a pre-parsed glob, starting in a directory.
@@ -523,11 +538,17 @@ runDirFileGlob verbosity mspec rawRoot pat = do
               -- when a cabal spec version is passed as an argument), we
               -- disallow matching a @GlobFile@ against a directory, preferring
               -- @GlobDir dir GlobDirTrailing@ to specify a directory match.
-              shouldMatch <- maybe (return True) (const $ doesFileExist (root </> dir </> s)) mspec
+              isFile <- maybe (return True) (const $ doesFileExist (root </> dir </> s)) mspec
+              let match = (dir </> s <$) <$> doesGlobMatch glob s
               return $
-                if shouldMatch
-                  then (dir </> s <$) <$> doesGlobMatch glob s
-                  else Nothing
+                if isFile
+                  then match
+                  else case match of
+                    Just (GlobMatch x) -> Just $ GlobMatchesDirectory x
+                    Just (GlobWarnMultiDot x) -> Just $ GlobMatchesDirectory x
+                    Just (GlobMatchesDirectory x) -> Just $ GlobMatchesDirectory x
+                    Just (GlobMissingDirectory x) -> Just $ GlobMissingDirectory x -- this should never match, unless you are in a file-delete-heavy concurrent setting i guess
+                    Nothing -> Nothing
           )
           entries
     go (GlobDirRecursive glob) dir = do
@@ -601,6 +622,8 @@ checkNameMatches spec glob candidate
   | otherwise = empty
 
 -- | How/does the glob match the given filepath, according to the cabal version?
+-- Since this is pure, we don't make a distinction between matching on
+-- directories or files (i.e. this function won't return 'GlobMatchesDirectory')
 fileGlobMatches :: CabalSpecVersion -> FilePathGlobRel -> FilePath -> Maybe (GlobResult ())
 fileGlobMatches version g path = go g (splitDirectories path)
   where

Cabal/src/Distribution/Simple/SrcDist.hs

@@ -245,12 +245,13 @@ listPackageSources' verbosity rip cwd pkg_descr pps =
     , -- Data files.
       fmap concat
         . for (dataFiles pkg_descr)
-        $ \filename -> do
-          let srcDataDirRaw = dataDir pkg_descr
-              srcDataDir
-                | null srcDataDirRaw = "."
-                | otherwise = srcDataDirRaw
-          matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd (srcDataDir </> filename)
+        $ \filename ->
+          do
+            let srcDataDirRaw = dataDir pkg_descr
+                srcDataDir
+                  | null srcDataDirRaw = "."
+                  | otherwise = srcDataDirRaw
+            matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd (srcDataDir </> filename)
     , -- Extra source files.
       fmap concat . for (extraSrcFiles pkg_descr) $ \fpath ->
         matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd fpath

cabal-testsuite/PackageTests/SDist/T5195and5349/actually-a-file

@@ -0,0 +1 @@
+Hi

cabal-testsuite/PackageTests/SDist/T5195and5349/cabal.test.hs

@@ -0,0 +1,5 @@
+import Test.Cabal.Prelude
+main = cabalTest $ do
+  tmpdir <- fmap testTmpDir getTestEnv
+  cabal' "v2-sdist" ["--list-only", "--output-directory", tmpdir]
+  return ()

cabal-testsuite/PackageTests/SDist/T5195and5349/t5195and5349.cabal

@@ -0,0 +1,19 @@
+cabal-version: 2.2
+name: t5195and5349
+version: 0
+
+extra-source-files:
+  ./actually-a-directory
+  ./actually-a-file
+
+extra-doc-files:
+  ./actually-a-directory
+  ./actually-a-file
+
+data-files:
+  ./actually-a-directory
+  ./actually-a-file
+
+executable foo
+  default-language: Haskell2010
+  main-is: Main.hs