diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index 0b979930ba3b7bf7b12187bcca6cda0768de87bf..4cfdb62ea6579960134c11c95eb1375ac90b522c 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -138,6 +138,8 @@ extra-source-files:
   tests/ParserTests/regressions/common3.format
   tests/ParserTests/regressions/cxx-options-with-optimization.cabal
   tests/ParserTests/regressions/cxx-options-with-optimization.check
+  tests/ParserTests/regressions/denormalised-paths.cabal
+  tests/ParserTests/regressions/denormalised-paths.check
   tests/ParserTests/regressions/elif.cabal
   tests/ParserTests/regressions/elif.expr
   tests/ParserTests/regressions/elif.format
@@ -312,7 +314,7 @@ flag bundled-binary-generic
 library
   build-depends:
     array      >= 0.4.0.1  && < 0.6,
-    base       >= 4.6      && < 5,
+    base       >= 4.6      && < 4.16,
     bytestring >= 0.10.0.0 && < 0.11,
     containers >= 0.5.0.0  && < 0.7,
     deepseq    >= 1.3.0.1  && < 1.5,
diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs
index 003b4e3bc3ea1451121d2f6c4c74de2d55968a24..1b1a826b9e6efabfb50e6ef3ac879cc4235803a6 100644
--- a/Cabal/Distribution/PackageDescription/Check.hs
+++ b/Cabal/Distribution/PackageDescription/Check.hs
@@ -76,6 +76,9 @@ import qualified Distribution.Types.BuildInfo.Lens                 as L
 import qualified Distribution.Types.GenericPackageDescription.Lens as L
 import qualified Distribution.Types.PackageDescription.Lens        as L
 
+-- $setup
+-- >>> import Control.Arrow ((&&&))
+
 -- | Results of some kind of failed package check.
 --
 -- There are a range of severities, from merely dubious to totally insane.
@@ -762,6 +765,16 @@ checkSourceRepos pkg =
   , check (maybe False isAbsoluteOnAnyPlatform (repoSubdir repo)) $
       PackageDistInexcusable
         "The 'subdir' field of a source-repository must be a relative path."
+
+  , check (maybe False isAbsoluteOnAnyPlatform (repoSubdir repo)) $
+      PackageDistInexcusable
+        "The 'subdir' field of a source-repository must be a relative path."
+
+  , do
+      subdir <- repoSubdir repo
+      err    <- isGoodRelativeDirectoryPath subdir
+      return $ PackageDistInexcusable $
+        "The 'subdir' field of a source-repository is not a good relative path: " ++ show err
   ]
   | repo <- sourceRepos pkg ]
 
@@ -1038,27 +1051,42 @@ checkAlternatives badField goodField flags =
 
   where (badFlags, goodFlags) = unzip flags
 
+data PathKind
+    = PathKindFile
+    | PathKindDirectory
+    | PathKindGlob
+
 checkPaths :: PackageDescription -> [PackageCheck]
 checkPaths pkg =
   [ PackageBuildWarning $
-         quote (kind ++ ": " ++ path)
+         quote (field ++ ": " ++ path)
       ++ " is a relative path outside of the source tree. "
       ++ "This will not work when generating a tarball with 'sdist'."
-  | (path, kind) <- relPaths ++ absPaths
+  | (path, field, _) <- relPaths ++ absPaths
   , isOutsideTree path ]
   ++
   [ PackageDistInexcusable $
-      quote (kind ++ ": " ++ path) ++ " is an absolute path."
-  | (path, kind) <- relPaths
+      quote (field ++ ": " ++ path) ++ " is an absolute path."
+  | (path, field, _) <- relPaths
   , isAbsoluteOnAnyPlatform path ]
   ++
   [ PackageDistInexcusable $
-         quote (kind ++ ": " ++ path) ++ " points inside the 'dist' "
+      quote (field ++ ": " ++ path) ++ " is not good relative path: " ++ err
+  | (path, field, kind) <- relPaths
+  -- these are not paths, but globs...
+  , err <- maybeToList $ case kind of
+      PathKindFile      -> isGoodRelativeFilePath path
+      PathKindGlob      -> isGoodRelativeGlob path
+      PathKindDirectory -> isGoodRelativeDirectoryPath path
+  ]
+  ++
+  [ PackageDistInexcusable $
+         quote (field ++ ": " ++ path) ++ " points inside the 'dist' "
       ++ "directory. This is not reliable because the location of this "
       ++ "directory is configurable by the user (or package manager). In "
       ++ "addition the layout of the 'dist' directory is subject to change "
       ++ "in future versions of Cabal."
-  | (path, kind) <- relPaths ++ absPaths
+  | (path, field, _) <- relPaths ++ absPaths
   , isInsideDist path ]
   ++
   [ PackageDistInexcusable $
@@ -1098,29 +1126,35 @@ checkPaths pkg =
       "dist"    :_ -> True
       ".":"dist":_ -> True
       _            -> False
+
     -- paths that must be relative
+    relPaths :: [(FilePath, String, PathKind)]
     relPaths =
-         [ (path, "extra-source-files") | path <- extraSrcFiles pkg ]
-      ++ [ (path, "extra-tmp-files")    | path <- extraTmpFiles pkg ]
-      ++ [ (path, "extra-doc-files")    | path <- extraDocFiles pkg ]
-      ++ [ (path, "data-files")         | path <- dataFiles     pkg ]
-      ++ [ (path, "data-dir")           | path <- [dataDir      pkg]]
-      ++ [ (path, "license-file")       | path <- licenseFiles  pkg ]
-      ++ concat
-         [    [ (path, "asm-sources")      | path <- asmSources      bi ]
-           ++ [ (path, "cmm-sources")      | path <- cmmSources      bi ]
-           ++ [ (path, "c-sources")        | path <- cSources        bi ]
-           ++ [ (path, "cxx-sources")      | path <- cxxSources      bi ]
-           ++ [ (path, "js-sources")       | path <- jsSources       bi ]
-           ++ [ (path, "install-includes") | path <- installIncludes bi ]
-           ++ [ (path, "hs-source-dirs")   | path <- hsSourceDirs    bi ]
-         | bi <- allBuildInfo pkg ]
+      [ (path, "extra-source-files", PathKindGlob)      | path <- extraSrcFiles pkg ] ++
+      [ (path, "extra-tmp-files",    PathKindFile)      | path <- extraTmpFiles pkg ] ++
+      [ (path, "extra-doc-files",    PathKindGlob)      | path <- extraDocFiles pkg ] ++
+      [ (path, "data-files",         PathKindGlob)      | path <- dataFiles     pkg ] ++
+      [ (path, "data-dir",           PathKindDirectory) | path <- [dataDir      pkg]] ++
+      [ (path, "license-file",       PathKindFile)      | path <- licenseFiles  pkg ] ++
+      concat
+        [ [ (path, "asm-sources",      PathKindFile)      | path <- asmSources      bi ] ++
+          [ (path, "cmm-sources",      PathKindFile)      | path <- cmmSources      bi ] ++
+          [ (path, "c-sources",        PathKindFile)      | path <- cSources        bi ] ++
+          [ (path, "cxx-sources",      PathKindFile)      | path <- cxxSources      bi ] ++
+          [ (path, "js-sources",       PathKindFile)      | path <- jsSources       bi ] ++
+          [ (path, "install-includes", PathKindFile)      | path <- installIncludes bi ] ++
+          [ (path, "hs-source-dirs",   PathKindDirectory) | path <- hsSourceDirs bi ]
+        | bi <- allBuildInfo pkg
+        ]
+
     -- paths that are allowed to be absolute
+    absPaths :: [(FilePath, String, PathKind)]
     absPaths = concat
-      [    [ (path, "includes")         | path <- includes        bi ]
-        ++ [ (path, "include-dirs")     | path <- includeDirs     bi ]
-        ++ [ (path, "extra-lib-dirs")   | path <- extraLibDirs    bi ]
-      | bi <- allBuildInfo pkg ]
+      [ [ (path, "includes",       PathKindFile)      | path <- includes     bi ] ++
+        [ (path, "include-dirs",   PathKindDirectory) | path <- includeDirs  bi ] ++
+        [ (path, "extra-lib-dirs", PathKindDirectory) | path <- extraLibDirs bi ]
+      | bi <- allBuildInfo pkg
+      ]
 
 --TODO: check sets of paths that would be interpreted differently between Unix
 -- and windows, ie case-sensitive or insensitive. Things that might clash, or
@@ -2110,3 +2144,246 @@ fileExtensionSupportedLanguage path =
     extension = takeExtension path
     isHaskell = extension `elem` [".hs", ".lhs"]
     isC       = isJust (filenameCDialect extension)
+
+-- | Whether a path is a good relative path.
+--
+-- >>> let test fp = putStrLn $ show (isGoodRelativeDirectoryPath fp) ++ "; " ++ show (isGoodRelativeFilePath fp)
+--
+-- >>> test "foo/bar/quu"
+-- Nothing; Nothing
+--
+-- Trailing slash is not allowed for files, for directories it is ok.
+--
+-- >>> test "foo/"
+-- Nothing; Just "trailing slash"
+--
+-- Leading @./@ is fine, but @.@ and @./@ are not valid files.
+--
+-- >>> traverse_ test [".", "./", "./foo/bar"]
+-- Nothing; Just "trailing dot segment"
+-- Nothing; Just "trailing slash"
+-- Nothing; Nothing
+--
+-- Lastly, not good file nor directory cases:
+--
+-- >>> traverse_ test ["", "/tmp/src", "foo//bar", "foo/.", "foo/./bar", "foo/../bar", "foo*bar"]
+-- Just "empty path"; Just "empty path"
+-- Just "posix absolute path"; Just "posix absolute path"
+-- Just "empty path segment"; Just "empty path segment"
+-- Just "trailing same directory segment: ."; Just "trailing same directory segment: ."
+-- Just "same directory segment: ."; Just "same directory segment: .."
+-- Just "parent directory segment: .."; Just "parent directory segment: .."
+-- Just "reserved character '*'"; Just "reserved character '*'"
+--
+-- For the last case, 'isGoodRelativeGlob' doesn't warn:
+--
+-- >>> traverse_ (print . isGoodRelativeGlob) ["foo/../bar", "foo*bar"]
+-- Just "parent directory segment: .."
+-- Nothing
+--
+isGoodRelativeFilePath :: FilePath -> Maybe String
+isGoodRelativeFilePath = state0
+  where
+    -- Reserved characters
+    -- https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file
+    isReserved c = c `elem` "<>:\"\\/|?*"
+
+    -- initial state
+    state0 []                    = Just "empty path"
+    state0 (c:cs) | c == '.'     = state1 cs
+                  | c == '/'     = Just "posix absolute path"
+                  | isReserved c = Just ("reserved character " ++ show c)
+                  | otherwise    = state3 cs
+
+    -- after .
+    state1 []                    = Just "trailing dot segment"
+    state1 (c:cs) | c == '.'     = state4 cs
+                  | c == '/'     = state2 cs
+                  | isReserved c = Just ("reserved character " ++ show c)
+                  | otherwise    = state5 cs
+
+    -- after ./
+    state2 []                    = Just "trailing slash"
+    state2 (c:cs) | c == '.'     = state3 cs
+                  | c == '/'     = Just "empty path segment"
+                  | isReserved c = Just ("reserved character " ++ show c)
+                  | otherwise    = state5 cs
+
+    -- after non-first segment's .
+    state3 []                    = Just "trailing same directory segment: ."
+    state3 (c:cs) | c == '.'     = state4 cs
+                  | c == '/'     = Just "same directory segment: .."
+                  | isReserved c = Just ("reserved character " ++ show c)
+                  | otherwise    = state5 cs
+
+    -- after non-first segment's ..
+    state4 []                    = Just "trailing parent directory segment: .."
+    state4 (c:cs) | c == '.'     = state5 cs
+                  | c == '/'     = Just "parent directory segment: .."
+                  | isReserved c = Just ("reserved character " ++ show c)
+                  | otherwise    = state5 cs
+
+    -- in a segment which is ok.
+    state5 []                    = Nothing
+    state5 (c:cs) | c == '.'     = state3 cs
+                  | c == '/'     = state2 cs
+                  | isReserved c = Just ("reserved character " ++ show c)
+                  | otherwise    = state5 cs
+
+-- | See 'isGoodRelativeFilePath'.
+--
+-- This is barebones function. We check whether the glob is a valid file
+-- by replacing stars @*@ with @x@ses.
+isGoodRelativeGlob :: FilePath -> Maybe String
+isGoodRelativeGlob = isGoodRelativeFilePath . map f where
+    f '*' = 'x'
+    f c   = c
+
+-- | See 'isGoodRelativeFilePath'.
+isGoodRelativeDirectoryPath :: FilePath -> Maybe String
+isGoodRelativeDirectoryPath = state0
+  where
+    -- Reserved characters
+    -- https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file
+    isReserved c = c `elem` "<>:\"\\/|?*"
+
+    -- initial state
+    state0 []                    = Just "empty path"
+    state0 (c:cs) | c == '.'     = state5 cs
+                  | c == '/'     = Just "posix absolute path"
+                  | isReserved c = Just ("reserved character " ++ show c)
+                  | otherwise    = state4 cs
+
+    -- after ./
+    state1 []                    = Nothing -- "./"
+    state1 (c:cs) | c == '.'     = state2 cs
+                  | c == '/'     = Just "empty path segment"
+                  | isReserved c = Just ("reserved character " ++ show c)
+                  | otherwise    = state4 cs
+
+    -- after non-first setgment's .
+    state2 []                    = Just "trailing same directory segment: ."
+    state2 (c:cs) | c == '.'     = state3 cs
+                  | c == '/'     = Just "same directory segment: ."
+                  | isReserved c = Just ("reserved character " ++ show c)
+                  | otherwise    = state4 cs
+
+    -- after non-first segment's ..
+    state3 []                    = Just "trailing parent directory segment: ."
+    state3 (c:cs) | c == '.'     = state4 cs
+                  | c == '/'     = Just "parent directory segment: .."
+                  | isReserved c = Just ("reserved character " ++ show c)
+                  | otherwise    = state4 cs
+
+    -- in a segment which is ok.
+    state4 []                    = Nothing
+    state4 (c:cs) | c == '.'     = state4 cs
+                  | c == '/'     = state1 cs
+                  | isReserved c = Just ("reserved character " ++ show c)
+                  | otherwise    = state4 cs
+
+    -- after .
+    state5 []                    = Nothing -- "."
+    state5 (c:cs) | c == '.'     = state3 cs
+                  | c == '/'     = state1 cs
+                  | isReserved c = Just ("reserved character " ++ show c)
+                  | otherwise    = state4 cs
+
+-- [Note: Good relative paths]
+--
+-- Using @kleene@ we can define an extended regex:
+--
+-- @
+-- import Algebra.Lattice
+-- import Kleene
+-- import Kleene.ERE (ERE (..), intersections)
+--
+-- data C = CDot | CSlash | COtherReserved | CChar
+--   deriving (Eq, Ord, Enum, Bounded, Show)
+--
+-- reservedR :: ERE C
+-- reservedR = notChar CSlash /\ notChar COtherReserved
+--
+-- pathPieceR :: ERE C
+-- pathPieceR = intersections
+--     [ plus reservedR
+--     , ERENot (string [CDot])
+--     , ERENot (string [CDot,CDot])
+--     ]
+--
+-- filePathR :: ERE C
+-- filePathR = optional (string [CDot, CSlash]) <> pathPieceR <> star (char CSlash <> pathPieceR)
+--
+-- dirPathR :: ERE C
+-- dirPathR = (char CDot \/ filePathR) <> optional (char CSlash)
+--
+-- plus :: ERE C -> ERE C
+-- plus r = r <> star r
+--
+-- optional :: ERE C -> ERE C
+-- optional r = mempty \/ r
+-- @
+--
+-- Results in following state machine for @filePathR@
+--
+-- @
+-- 0 -> \x -> if
+--     | x <= CDot           -> 1
+--     | x <= COtherReserved -> 6
+--     | otherwise           -> 5
+-- 1 -> \x -> if
+--     | x <= CDot           -> 4
+--     | x <= CSlash         -> 2
+--     | x <= COtherReserved -> 6
+--     | otherwise           -> 5
+-- 2 -> \x -> if
+--     | x <= CDot           -> 3
+--     | x <= COtherReserved -> 6
+--     | otherwise           -> 5
+-- 3 -> \x -> if
+--     | x <= CDot           -> 4
+--     | x <= COtherReserved -> 6
+--     | otherwise           -> 5
+-- 4 -> \x -> if
+--     | x <= CDot           -> 5
+--     | x <= COtherReserved -> 6
+--     | otherwise           -> 5
+-- 5+ -> \x -> if
+--     | x <= CDot           -> 5
+--     | x <= CSlash         -> 2
+--     | x <= COtherReserved -> 6
+--     | otherwise           -> 5
+-- 6 -> \_ -> 6 -- black hole
+-- @
+--
+-- and @dirPathR@:
+--
+-- @
+-- 0 -> \x -> if
+--     | x <= CDot           -> 5
+--     | x <= COtherReserved -> 6
+--     | otherwise           -> 4
+-- 1+ -> \x -> if
+--     | x <= CDot           -> 2
+--     | x <= COtherReserved -> 6
+--     | otherwise           -> 4
+-- 2 -> \x -> if
+--     | x <= CDot           -> 3
+--     | x <= COtherReserved -> 6
+--     | otherwise           -> 4
+-- 3 -> \x -> if
+--     | x <= CDot           -> 4
+--     | x <= COtherReserved -> 6
+--     | otherwise           -> 4
+-- 4+ -> \x -> if
+--     | x <= CDot           -> 4
+--     | x <= CSlash         -> 1
+--     | x <= COtherReserved -> 6
+--     | otherwise           -> 4
+-- 5+ -> \x -> if
+--     | x <= CDot           -> 3
+--     | x <= CSlash         -> 1
+--     | x <= COtherReserved -> 6
+--     | otherwise           -> 4
+-- 6 -> \_ -> 6 -- black hole
+-- @
diff --git a/Cabal/Distribution/PackageDescription/FieldGrammar.hs b/Cabal/Distribution/PackageDescription/FieldGrammar.hs
index 2db4d541b1b4496525b5effe9e51efc7efa770a4..65985bca4071925280bc24c28af4c94a007ffc1a 100644
--- a/Cabal/Distribution/PackageDescription/FieldGrammar.hs
+++ b/Cabal/Distribution/PackageDescription/FieldGrammar.hs
@@ -117,7 +117,7 @@ packageDescriptionFieldGrammar = PackageDescription
     <*> pure []       -- benchmarks
     --  * Files
     <*> monoidalFieldAla    "data-files"         (alaList' VCat FilePathNT) L.dataFiles
-    <*> optionalFieldDefAla "data-dir"           FilePathNT                 L.dataDir ""
+    <*> optionalFieldDefAla "data-dir"           FilePathNT                 L.dataDir "."
     <*> monoidalFieldAla    "extra-source-files" formatExtraSourceFiles     L.extraSrcFiles
     <*> monoidalFieldAla    "extra-tmp-files"    (alaList' VCat FilePathNT) L.extraTmpFiles
     <*> monoidalFieldAla    "extra-doc-files"    (alaList' VCat FilePathNT) L.extraDocFiles
diff --git a/Cabal/Distribution/Types/PackageDescription.hs b/Cabal/Distribution/Types/PackageDescription.hs
index a7858d42f9bd61f9f73f34517c9e9bd8f93ab59b..f3397b577b1ff12c5d6613edb4a095bed899d924 100644
--- a/Cabal/Distribution/Types/PackageDescription.hs
+++ b/Cabal/Distribution/Types/PackageDescription.hs
@@ -222,7 +222,7 @@ emptyPackageDescription
                       testSuites   = [],
                       benchmarks   = [],
                       dataFiles    = [],
-                      dataDir      = "",
+                      dataDir      = ".",
                       extraSrcFiles = [],
                       extraTmpFiles = [],
                       extraDocFiles = []
diff --git a/Cabal/Distribution/Utils/Generic.hs b/Cabal/Distribution/Utils/Generic.hs
index 03510db7d1277c314d411f3aab6a40b4d9d55ce2..f3a8a9a5c970cc11c6ad3d121c0ac262ad951bf8 100644
--- a/Cabal/Distribution/Utils/Generic.hs
+++ b/Cabal/Distribution/Utils/Generic.hs
@@ -560,6 +560,7 @@ trdOf3 (_,_,c) = c
 isAbsoluteOnAnyPlatform :: FilePath -> Bool
 -- C:\\directory
 isAbsoluteOnAnyPlatform (drive:':':'\\':_) = isAlpha drive
+isAbsoluteOnAnyPlatform (drive:':':'/':_)  = isAlpha drive
 -- UNC
 isAbsoluteOnAnyPlatform ('\\':'\\':_) = True
 -- Posix root
diff --git a/Cabal/tests/CheckTests.hs b/Cabal/tests/CheckTests.hs
index ed3bd15bcb1700b3f07dd68fd2ee1cd4fc8f2004..eeaebc6efdb2640e2e94fcabe90cc7b63c2653f3 100644
--- a/Cabal/tests/CheckTests.hs
+++ b/Cabal/tests/CheckTests.hs
@@ -48,6 +48,7 @@ checkTests = testGroup "regressions"
     , checkTest "issue-6288-d.cabal"
     , checkTest "issue-6288-e.cabal"
     , checkTest "issue-6288-f.cabal"
+    , checkTest "denormalised-paths.cabal"
     ]
 
 checkTest :: FilePath -> TestTree
diff --git a/Cabal/tests/ParserTests/regressions/Octree-0.5.expr b/Cabal/tests/ParserTests/regressions/Octree-0.5.expr
index bc734f304b12a40bcdd938fcb0a70c50899d422f..fd795d5abf9c83f4a7fad5661ade31c3d55aa439 100644
--- a/Cabal/tests/ParserTests/regressions/Octree-0.5.expr
+++ b/Cabal/tests/ParserTests/regressions/Octree-0.5.expr
@@ -320,7 +320,7 @@ GenericPackageDescription
                            category = "Data",
                            copyright = "Copyright by Michal J. Gajda '2012",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "Octree data structure is relatively shallow data structure for space partitioning.",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/anynone.expr b/Cabal/tests/ParserTests/regressions/anynone.expr
index a2bef24f55f227432b4e9eeb2f0901cde3b3668a..ef1093b572aa5905f5bb4efd7ebb40f0a7e5c10c 100644
--- a/Cabal/tests/ParserTests/regressions/anynone.expr
+++ b/Cabal/tests/ParserTests/regressions/anynone.expr
@@ -78,7 +78,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/big-version.expr b/Cabal/tests/ParserTests/regressions/big-version.expr
index 27d9eeb4d74a8602b3d9233c628683e85fed6bfe..009e781bda5544705f90a87b4d2592c75beef281 100644
--- a/Cabal/tests/ParserTests/regressions/big-version.expr
+++ b/Cabal/tests/ParserTests/regressions/big-version.expr
@@ -69,7 +69,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/common-conditional.expr b/Cabal/tests/ParserTests/regressions/common-conditional.expr
index d4320b2bb6a36a3858aa176e7048a53cdcce6e6b..66cdf1a6c909ff052a6f2e9fb03ede910f69a68b 100644
--- a/Cabal/tests/ParserTests/regressions/common-conditional.expr
+++ b/Cabal/tests/ParserTests/regressions/common-conditional.expr
@@ -648,7 +648,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/common.expr b/Cabal/tests/ParserTests/regressions/common.expr
index 6a9f0775cd5296cdf55932f9603a21e7f09c418b..045239f649f109844c44406a1b750eec7634f8dd 100644
--- a/Cabal/tests/ParserTests/regressions/common.expr
+++ b/Cabal/tests/ParserTests/regressions/common.expr
@@ -143,7 +143,7 @@ GenericPackageDescription
                            copyright = "",
                            customFieldsPD = [_×_ "x-revision" "1",
                                              _×_ "x-follows-version-policy" ""],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/common2.expr b/Cabal/tests/ParserTests/regressions/common2.expr
index 910d988eaaa7b713c06dfb48a5edf51975898ef5..a19ab2d765326c63530bbb1b21e645be419cb68d 100644
--- a/Cabal/tests/ParserTests/regressions/common2.expr
+++ b/Cabal/tests/ParserTests/regressions/common2.expr
@@ -674,7 +674,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/common3.expr b/Cabal/tests/ParserTests/regressions/common3.expr
index b992101f09fd7761d82c45da0b8d798881aa73ac..a2511e3bda5835c2d4f0fe38b9ad761d6e4545fb 100644
--- a/Cabal/tests/ParserTests/regressions/common3.expr
+++ b/Cabal/tests/ParserTests/regressions/common3.expr
@@ -173,7 +173,7 @@ GenericPackageDescription
                            copyright = "",
                            customFieldsPD = [_×_ "x-revision" "1",
                                              _×_ "x-follows-version-policy" ""],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/denormalised-paths.cabal b/Cabal/tests/ParserTests/regressions/denormalised-paths.cabal
new file mode 100644
index 0000000000000000000000000000000000000000..338109cabda8ccaa7a9da09a4b0709f1206c3aed
--- /dev/null
+++ b/Cabal/tests/ParserTests/regressions/denormalised-paths.cabal
@@ -0,0 +1,71 @@
+cabal-version: 2.4
+name:          assoc
+version:       1.1
+license:       BSD-3-Clause
+license-files: LICENSE LICENSE2/ .
+synopsis:      swap and assoc: Symmetric and Semigroupy Bifunctors
+category:      Data
+description:
+  Provides generalisations of
+  @swap :: (a,b) -> (b,a)@ and
+  @assoc :: ((a,b),c) -> (a,(b,c))@
+  to
+  @Bifunctor@s supporting similar operations (e.g. @Either@, @These@).
+
+author:        Oleg Grenrus <oleg.grenrus@iki.fi>
+maintainer:    Oleg Grenrus <oleg.grenrus@iki.fi>
+build-type:    Simple
+tested-with:
+  GHC ==7.0.4
+   || ==7.2.2
+   || ==7.4.2
+   || ==7.6.3
+   || ==7.8.4
+   || ==7.10.3
+   || ==8.0.2
+   || ==8.2.2
+   || ==8.4.4
+   || ==8.6.5
+   || ==8.8.1
+
+extra-source-files:
+  files/**/*.txt/
+  files/../foo.txt
+
+source-repository head
+  type:     git
+  location: https://github.com/phadej/assoc.git
+  subdir:   ./.
+
+source-repository this
+  type:     git
+  location: https://github.com/phadej/assoc.git
+  tag:      v1.1
+  subdir:   foo/
+
+library
+  default-language: Haskell2010
+  build-depends:
+      base        >=4.3   && <4.13
+    , bifunctors  >=5.5.4 && <5.6
+
+  exposed-modules:
+    Data.Bifunctor.Assoc
+    Data.Bifunctor.Swap
+
+  -- this is fine
+  hs-source-dirs:   src/
+
+  -- collection of invalid sources
+  hs-source-dirs:   src/.
+  hs-source-dirs:   src/../src
+  hs-source-dirs:   src/../../assoc/src
+  -- this is forbidden by a parser
+  -- hs-source-dirs:   C:/foo/bar
+  hs-source-dirs:   C:foo/bar
+  hs-source-dirs:   ||s
+  -- this is forbidden by a parser
+  -- hs-source-dirs:   /var/secret/source
+
+  -- this is the only case catched by Cabal-3.0.2.0
+  hs-source-dirs:   ../../assoc/src
diff --git a/Cabal/tests/ParserTests/regressions/denormalised-paths.check b/Cabal/tests/ParserTests/regressions/denormalised-paths.check
new file mode 100644
index 0000000000000000000000000000000000000000..02fe04a457b0f796592327e04208e71a3ce7e19c
--- /dev/null
+++ b/Cabal/tests/ParserTests/regressions/denormalised-paths.check
@@ -0,0 +1,12 @@
+The 'subdir' field of a source-repository is not a good relative path: "trailing same directory segment: ."
+'hs-source-dirs: ../../assoc/src' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'.
+'extra-source-files: files/**/*.txt/' is not good relative path: trailing slash
+'extra-source-files: files/../foo.txt' is not good relative path: parent directory segment: ..
+'license-file: LICENSE2/' is not good relative path: trailing slash
+'license-file: .' is not good relative path: trailing dot segment
+'hs-source-dirs: src/.' is not good relative path: trailing same directory segment: .
+'hs-source-dirs: src/../src' is not good relative path: parent directory segment: ..
+'hs-source-dirs: src/../../assoc/src' is not good relative path: parent directory segment: ..
+'hs-source-dirs: C:foo/bar' is not good relative path: reserved character ':'
+'hs-source-dirs: ||s' is not good relative path: reserved character '|'
+'hs-source-dirs: ../../assoc/src' is not good relative path: parent directory segment: ..
diff --git a/Cabal/tests/ParserTests/regressions/elif.expr b/Cabal/tests/ParserTests/regressions/elif.expr
index 2e5d560ba0c08a08596444a5bb3ec082708fc7ce..52ea1e251852836080b77cc5a8b902f119919683 100644
--- a/Cabal/tests/ParserTests/regressions/elif.expr
+++ b/Cabal/tests/ParserTests/regressions/elif.expr
@@ -145,7 +145,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/elif2.expr b/Cabal/tests/ParserTests/regressions/elif2.expr
index 82c44eb45c832171ae94863a73cc2902e3dbdda6..a0b01cc4ff451a5fc94852ca22a8436ee576cb5e 100644
--- a/Cabal/tests/ParserTests/regressions/elif2.expr
+++ b/Cabal/tests/ParserTests/regressions/elif2.expr
@@ -345,7 +345,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/encoding-0.8.expr b/Cabal/tests/ParserTests/regressions/encoding-0.8.expr
index 3e9595d99f7936a94eb23abddd1f61ce92e89506..fe520bcdc530be61a7aa64b2f8a7af8f44144cc2 100644
--- a/Cabal/tests/ParserTests/regressions/encoding-0.8.expr
+++ b/Cabal/tests/ParserTests/regressions/encoding-0.8.expr
@@ -90,7 +90,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/generics-sop.expr b/Cabal/tests/ParserTests/regressions/generics-sop.expr
index 0a5c481ac0c355420305978083c74011250bef27..dd5dc2d5b17b532069eebf1fb2d6ce1fe627fa61 100644
--- a/Cabal/tests/ParserTests/regressions/generics-sop.expr
+++ b/Cabal/tests/ParserTests/regressions/generics-sop.expr
@@ -701,7 +701,7 @@ GenericPackageDescription
                            category = "Generics",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = concat
                                            ["A library to support the definition of generic functions.\n",
diff --git a/Cabal/tests/ParserTests/regressions/hasktorch.expr b/Cabal/tests/ParserTests/regressions/hasktorch.expr
index 839f850f71004e8c1203f8e1dd0d8b6c54b9eeba..f42e79d43bbd999978b4a33e371dcd3163a2b92e 100644
--- a/Cabal/tests/ParserTests/regressions/hasktorch.expr
+++ b/Cabal/tests/ParserTests/regressions/hasktorch.expr
@@ -9781,7 +9781,7 @@ GenericPackageDescription
                            category = "Tensors, Machine Learning, AI",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "Hasktorch is a library for tensors and neural networks in Haskell. It is an independent open source community project which leverages the core C libraries shared by Torch and PyTorch. This library leverages @cabal v2-build@ and @backpack@. *Note that this project is in early development and should only be used by contributing developers. Expect substantial changes to the library API as it evolves. Contributions and PRs are welcome (see details on github).*",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/hidden-main-lib.expr b/Cabal/tests/ParserTests/regressions/hidden-main-lib.expr
index 9ebf8601a035b94b80930a69a209fa948a6478c6..76c37cd82c52116be20edf7f76c85eea3536a5ff 100644
--- a/Cabal/tests/ParserTests/regressions/hidden-main-lib.expr
+++ b/Cabal/tests/ParserTests/regressions/hidden-main-lib.expr
@@ -78,7 +78,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/indentation.expr b/Cabal/tests/ParserTests/regressions/indentation.expr
index 35218221503ebef890ec1d4016e8895851500bd7..f8300bfc496b3e3b857a1782b5105d3b2ed2403d 100644
--- a/Cabal/tests/ParserTests/regressions/indentation.expr
+++ b/Cabal/tests/ParserTests/regressions/indentation.expr
@@ -69,7 +69,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = concat
                                            ["* foo\n",
diff --git a/Cabal/tests/ParserTests/regressions/indentation2.expr b/Cabal/tests/ParserTests/regressions/indentation2.expr
index 84bf6f56af8b6d4c3366de83c66e1c5ea9720915..a99ad7607d692a3a0b0f304c257293f80a60f15a 100644
--- a/Cabal/tests/ParserTests/regressions/indentation2.expr
+++ b/Cabal/tests/ParserTests/regressions/indentation2.expr
@@ -69,7 +69,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = concat ["foo\n", "  indent2\n", "    indent4"],
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/indentation3.expr b/Cabal/tests/ParserTests/regressions/indentation3.expr
index cc60253e16beba45f31d9a194c2d9cb181c3fe53..9654a3db255aca0d467a5474153bbceee6980520 100644
--- a/Cabal/tests/ParserTests/regressions/indentation3.expr
+++ b/Cabal/tests/ParserTests/regressions/indentation3.expr
@@ -69,7 +69,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = concat
                                            ["indent0\n",
diff --git a/Cabal/tests/ParserTests/regressions/issue-5055.expr b/Cabal/tests/ParserTests/regressions/issue-5055.expr
index 5d422d43161f51df64e62249e99570debedd4b28..7aefb48df5def092ecd583caa27627d046dded02 100644
--- a/Cabal/tests/ParserTests/regressions/issue-5055.expr
+++ b/Cabal/tests/ParserTests/regressions/issue-5055.expr
@@ -219,7 +219,7 @@ GenericPackageDescription
                            category = "Test",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "no type in all branches.",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/issue-5846.expr b/Cabal/tests/ParserTests/regressions/issue-5846.expr
index 62c7873a92d3a1e33d801580e17be4af244e9d41..8389ab61c4fadb9672b6f5da3448e243194009db 100644
--- a/Cabal/tests/ParserTests/regressions/issue-5846.expr
+++ b/Cabal/tests/ParserTests/regressions/issue-5846.expr
@@ -143,7 +143,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/issue-6083-a.expr b/Cabal/tests/ParserTests/regressions/issue-6083-a.expr
index a9a43ea7541705b5dfdd84848973d14f6418b6bf..49f937ccad6ff78142f8a5756d2fa9b7fc8ea25c 100644
--- a/Cabal/tests/ParserTests/regressions/issue-6083-a.expr
+++ b/Cabal/tests/ParserTests/regressions/issue-6083-a.expr
@@ -306,7 +306,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/issue-6083-b.expr b/Cabal/tests/ParserTests/regressions/issue-6083-b.expr
index b32841cf2df368c3d6b0bd63cdad1c96dcaf977f..2bef0e581b50ddc0b45e94ea4af465f0e48b17d3 100644
--- a/Cabal/tests/ParserTests/regressions/issue-6083-b.expr
+++ b/Cabal/tests/ParserTests/regressions/issue-6083-b.expr
@@ -313,7 +313,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/issue-6083-c.expr b/Cabal/tests/ParserTests/regressions/issue-6083-c.expr
index 4f5bbc2b53524d7e1a34f11fe9cc980def954c15..1038dd813130196c446eb86d5af4144d41dff0b0 100644
--- a/Cabal/tests/ParserTests/regressions/issue-6083-c.expr
+++ b/Cabal/tests/ParserTests/regressions/issue-6083-c.expr
@@ -154,7 +154,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr b/Cabal/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr
index 46316d6ff1c5e4b073979f287abbf56efe03018c..0dbc0baac1d8244be5957c36ff15e4d7a0f2f5b4 100644
--- a/Cabal/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr
+++ b/Cabal/tests/ParserTests/regressions/issue-6083-pkg-pkg.expr
@@ -89,7 +89,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/issue-774.expr b/Cabal/tests/ParserTests/regressions/issue-774.expr
index 0037b6929abcdb10911e6662068076372bbf8de8..ea6040bfbf04b300dacf9db1ac696e6a5b62bab1 100644
--- a/Cabal/tests/ParserTests/regressions/issue-774.expr
+++ b/Cabal/tests/ParserTests/regressions/issue-774.expr
@@ -74,7 +74,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = concat
                                            ["Here is some C code:\n",
diff --git a/Cabal/tests/ParserTests/regressions/jaeger-flamegraph.expr b/Cabal/tests/ParserTests/regressions/jaeger-flamegraph.expr
index 179815c87f9f8ad808fc90bad21d7f41f6fbfe4f..428a467112fff2fb90d8f33e2840e7a8edbc2d52 100644
--- a/Cabal/tests/ParserTests/regressions/jaeger-flamegraph.expr
+++ b/Cabal/tests/ParserTests/regressions/jaeger-flamegraph.expr
@@ -419,7 +419,7 @@ GenericPackageDescription
                            category = "Testing",
                            copyright = "(c) 2018 Symbiont.io",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = concat
                                            ["This is a small tool to convert JSON dumps obtained from a Jaeger\n",
diff --git a/Cabal/tests/ParserTests/regressions/leading-comma-2.expr b/Cabal/tests/ParserTests/regressions/leading-comma-2.expr
index 5ac5c358b9e93aa1fc3b87bad3082e9bbe88e248..926321a7789a8b7abf0335f8e150a6cadaa21d29 100644
--- a/Cabal/tests/ParserTests/regressions/leading-comma-2.expr
+++ b/Cabal/tests/ParserTests/regressions/leading-comma-2.expr
@@ -140,7 +140,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/leading-comma.expr b/Cabal/tests/ParserTests/regressions/leading-comma.expr
index a48271ab3dc9f1c4801a00d5028f518bd8c6a780..893b1b002609fed73285db96e7e80687ce02008a 100644
--- a/Cabal/tests/ParserTests/regressions/leading-comma.expr
+++ b/Cabal/tests/ParserTests/regressions/leading-comma.expr
@@ -133,7 +133,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/libpq1.expr b/Cabal/tests/ParserTests/regressions/libpq1.expr
index 94fc94e075371791920f23550088b7ecc53a7470..5f0087b39ac4ce78b703483212bf12742cdf3a25 100644
--- a/Cabal/tests/ParserTests/regressions/libpq1.expr
+++ b/Cabal/tests/ParserTests/regressions/libpq1.expr
@@ -628,7 +628,7 @@ GenericPackageDescription
                            copyright = concat
                                          ["(c) 2010 Grant Monroe\n", "(c) 2011 Leon P Smith"],
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = concat
                                            ["This is a binding to libpq: the C application\n",
diff --git a/Cabal/tests/ParserTests/regressions/libpq2.expr b/Cabal/tests/ParserTests/regressions/libpq2.expr
index b6882e00c9bef012b32e483e286d554108056a1a..436025c772ec45f33a5b75a67497803a83c44962 100644
--- a/Cabal/tests/ParserTests/regressions/libpq2.expr
+++ b/Cabal/tests/ParserTests/regressions/libpq2.expr
@@ -628,7 +628,7 @@ GenericPackageDescription
                            copyright = concat
                                          ["(c) 2010 Grant Monroe\n", "(c) 2011 Leon P Smith"],
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = concat
                                            ["This is a binding to libpq: the C application\n",
diff --git a/Cabal/tests/ParserTests/regressions/mixin-1.expr b/Cabal/tests/ParserTests/regressions/mixin-1.expr
index 30f5cf05771fe83d2de39079d7e130694f8ad2b1..360371fc60acf5ffa0daace8abe54a417095ca26 100644
--- a/Cabal/tests/ParserTests/regressions/mixin-1.expr
+++ b/Cabal/tests/ParserTests/regressions/mixin-1.expr
@@ -121,7 +121,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/mixin-2.expr b/Cabal/tests/ParserTests/regressions/mixin-2.expr
index edf5b4b4ad032a2bb5c804c5486c0d089d6a87bf..13bd23bc6178ce602b23e9fe6b4e4215a5e25ec5 100644
--- a/Cabal/tests/ParserTests/regressions/mixin-2.expr
+++ b/Cabal/tests/ParserTests/regressions/mixin-2.expr
@@ -121,7 +121,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/mixin-3.expr b/Cabal/tests/ParserTests/regressions/mixin-3.expr
index 40625612d25a362a20f3d6a2145bc82707dc8e37..86c427edc2d5a8ff8330fdb7c424fd83b5e2ed15 100644
--- a/Cabal/tests/ParserTests/regressions/mixin-3.expr
+++ b/Cabal/tests/ParserTests/regressions/mixin-3.expr
@@ -106,7 +106,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/monad-param.expr b/Cabal/tests/ParserTests/regressions/monad-param.expr
index 4667db1c99bbafc5b76afe7f0cb23af7e0aed399..afa6a10f9770ddb925451cf4334be1024f02963b 100644
--- a/Cabal/tests/ParserTests/regressions/monad-param.expr
+++ b/Cabal/tests/ParserTests/regressions/monad-param.expr
@@ -115,7 +115,7 @@ GenericPackageDescription
                            category = "Control",
                            copyright = "Copyright (C) 2006-2007, Edward Kmett",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "Implements parameterized monads by overloading the monad sugar with more liberal types.",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/multiple-libs-2.expr b/Cabal/tests/ParserTests/regressions/multiple-libs-2.expr
index d383e9d51d3f40f2147b1604d6902157b411816e..2330e00453939974e9bf46d0ece7cba2a98714da 100644
--- a/Cabal/tests/ParserTests/regressions/multiple-libs-2.expr
+++ b/Cabal/tests/ParserTests/regressions/multiple-libs-2.expr
@@ -145,7 +145,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/noVersion.expr b/Cabal/tests/ParserTests/regressions/noVersion.expr
index aae902b1eb3c1f69ccfcfc8a04baecb9664e8e59..ed86c6a03cf23e3534abc27497ff6a1e236d3d40 100644
--- a/Cabal/tests/ParserTests/regressions/noVersion.expr
+++ b/Cabal/tests/ParserTests/regressions/noVersion.expr
@@ -78,7 +78,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/nothing-unicode.expr b/Cabal/tests/ParserTests/regressions/nothing-unicode.expr
index bcb0bb11117f13e007f2fe5a66a9447ebeb7171d..99f8e5d514c1aea23f4625694084d2a510f9c93a 100644
--- a/Cabal/tests/ParserTests/regressions/nothing-unicode.expr
+++ b/Cabal/tests/ParserTests/regressions/nothing-unicode.expr
@@ -137,7 +137,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [_×_ "x-\28961" "\28961"],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/shake.expr b/Cabal/tests/ParserTests/regressions/shake.expr
index f063e1ff7b9e213ff2fea8dc2608a619e8d60cbd..ec97c8b0c1a2080c60478a423fe1bd39586c1a9f 100644
--- a/Cabal/tests/ParserTests/regressions/shake.expr
+++ b/Cabal/tests/ParserTests/regressions/shake.expr
@@ -2420,7 +2420,7 @@ GenericPackageDescription
                            category = "Development, Shake",
                            copyright = "Neil Mitchell 2011-2017",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = ["html/viz.js",
                                         "html/profile.html",
                                         "html/progress.html",
diff --git a/Cabal/tests/ParserTests/regressions/spdx-1.expr b/Cabal/tests/ParserTests/regressions/spdx-1.expr
index a63b5dbfedb5e3d63716c807c3f46cb7fef716d8..c18f0dd590ba6dc17a00d1ee2f384d1b696b096b 100644
--- a/Cabal/tests/ParserTests/regressions/spdx-1.expr
+++ b/Cabal/tests/ParserTests/regressions/spdx-1.expr
@@ -69,7 +69,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/spdx-2.expr b/Cabal/tests/ParserTests/regressions/spdx-2.expr
index a05d7679fc18b7c0418a8bdefbd1182edd298cd2..3ff0c9d3e5289ea773befd17ad7a5bf8ac0df3c7 100644
--- a/Cabal/tests/ParserTests/regressions/spdx-2.expr
+++ b/Cabal/tests/ParserTests/regressions/spdx-2.expr
@@ -69,7 +69,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/spdx-3.expr b/Cabal/tests/ParserTests/regressions/spdx-3.expr
index adc84278e82a2a7d3e38e88f2d30704ed268edda..96bf8f1bfd99cc040eb9622bc94a3965fd3edf9a 100644
--- a/Cabal/tests/ParserTests/regressions/spdx-3.expr
+++ b/Cabal/tests/ParserTests/regressions/spdx-3.expr
@@ -69,7 +69,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/th-lift-instances.expr b/Cabal/tests/ParserTests/regressions/th-lift-instances.expr
index 1760b5915498a04ada060a2be742eb221d73f98b..4895cff50a644d78de1001b14c0cabfadd5480c5 100644
--- a/Cabal/tests/ParserTests/regressions/th-lift-instances.expr
+++ b/Cabal/tests/ParserTests/regressions/th-lift-instances.expr
@@ -529,7 +529,7 @@ GenericPackageDescription
                            category = "Template Haskell",
                            copyright = "Copyright (C) 2013-2014 Benno F\252nfst\252ck",
                            customFieldsPD = [_×_ "x-revision" "1"],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = concat
                                            ["Most data types in haskell platform do not have Lift instances. This package provides orphan instances\n",
diff --git a/Cabal/tests/ParserTests/regressions/version-sets.expr b/Cabal/tests/ParserTests/regressions/version-sets.expr
index 8a513edd991456c854e1167f932f192ee96846d7..245d489507ded34ee78132ecb82adc50c6acbdd2 100644
--- a/Cabal/tests/ParserTests/regressions/version-sets.expr
+++ b/Cabal/tests/ParserTests/regressions/version-sets.expr
@@ -239,7 +239,7 @@ GenericPackageDescription
                            category = "",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = "",
                            executables = [],
diff --git a/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr
index c5e72f5a1be61669a64f9a9626706358fd862f4d..e0cc4b5c54d031a9b3f7202bc63af73e030b9599 100644
--- a/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr
+++ b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr
@@ -180,7 +180,7 @@ GenericPackageDescription
                            category = "Text",
                            copyright = "",
                            customFieldsPD = [],
-                           dataDir = "",
+                           dataDir = ".",
                            dataFiles = [],
                            description = concat
                                            ["This is a pretty printing library based on Wadler's paper \"A Prettier\n",