Merge pull request #10830 from haskell/wip/t10717

mergify[bot] · web-flow · commit e49dc816963e · 2025-04-06T21:32:57.000Z
Set &lt;pkgname_datadir&gt; to an absolute path
diff --git a/Cabal/src/Distribution/Simple/Bench.hs b/Cabal/src/Distribution/Simple/Bench.hs
@@ -56,6 +56,7 @@ bench
   -- ^ flags sent to benchmark
   -> IO ()
 bench args pkg_descr lbi flags = do
+  curDir <- LBI.absoluteWorkingDirLBI lbi
   let verbosity = fromFlag $ benchmarkVerbosity flags
       benchmarkNames = args
       pkgBenchmarks = PD.benchmarks pkg_descr
@@ -71,6 +72,7 @@ bench args pkg_descr lbi flags = do
                 { -- Include any build-tool-depends on build tools internal to the current package.
                   LBI.withPrograms =
                     addInternalBuildTools
+                      curDir
                       pkg_descr
                       lbi
                       (benchmarkBuildInfo bm)
diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs
@@ -187,13 +187,15 @@ build_setupHooks
     -- dumped.
     dumpBuildInfo verbosity distPref (configDumpBuildInfo (configFlags lbi)) pkg_descr lbi flags
 
+    curDir <- absoluteWorkingDirLBI lbi
+
     -- Now do the actual building
     (\f -> foldM_ f (installedPkgs lbi) componentsToBuild) $ \index target -> do
       let comp = targetComponent target
           clbi = targetCLBI target
           bi = componentBuildInfo comp
           -- Include any build-tool-depends on build tools internal to the current package.
-          progs' = addInternalBuildTools pkg_descr lbi bi (withPrograms lbi)
+          progs' = addInternalBuildTools curDir pkg_descr lbi bi (withPrograms lbi)
           lbi' =
             lbi
               { withPrograms = progs'
@@ -375,17 +377,20 @@ repl_setupHooks
 
     internalPackageDB <- createInternalPackageDB verbosity lbi distPref
 
-    let lbiForComponent comp lbi' =
-          lbi'
-            { withPackageDB = withPackageDB lbi ++ [internalPackageDB]
-            , withPrograms =
-                -- Include any build-tool-depends on build tools internal to the current package.
-                addInternalBuildTools
-                  pkg_descr
-                  lbi'
-                  (componentBuildInfo comp)
-                  (withPrograms lbi')
-            }
+    let lbiForComponent comp lbi' = do
+          curDir <- absoluteWorkingDirLBI lbi'
+          return $
+            lbi'
+              { withPackageDB = withPackageDB lbi' ++ [internalPackageDB]
+              , withPrograms =
+                  -- Include any build-tool-depends on build tools internal to the current package.
+                  addInternalBuildTools
+                    curDir
+                    pkg_descr
+                    lbi'
+                    (componentBuildInfo comp)
+                    (withPrograms lbi')
+              }
         runPreBuildHooks :: LocalBuildInfo -> TargetInfo -> IO ()
         runPreBuildHooks lbi2 tgt =
           let inputs =
@@ -403,7 +408,7 @@ repl_setupHooks
       [ do
         let clbi = targetCLBI subtarget
             comp = targetComponent subtarget
-            lbi' = lbiForComponent comp lbi
+        lbi' <- lbiForComponent comp lbi
         preBuildComponent runPreBuildHooks verbosity lbi' subtarget
         buildComponent
           (mempty{buildCommonFlags = mempty{setupVerbosity = toFlag verbosity}})
@@ -420,7 +425,7 @@ repl_setupHooks
     -- REPL for target components
     let clbi = targetCLBI target
         comp = targetComponent target
-        lbi' = lbiForComponent comp lbi
+    lbi' <- lbiForComponent comp lbi
     preBuildComponent runPreBuildHooks verbosity lbi' target
     replComponent flags verbosity pkg_descr lbi' suffixHandlers comp clbi distPref
 
@@ -925,12 +930,13 @@ createInternalPackageDB verbosity lbi distPref = do
 --    'progOverrideEnv', so that any programs configured from now on will be
 --    able to invoke these build tools.
 addInternalBuildTools
-  :: PackageDescription
+  :: AbsolutePath (Dir Pkg)
+  -> PackageDescription
   -> LocalBuildInfo
   -> BuildInfo
   -> ProgramDb
   -> ProgramDb
-addInternalBuildTools pkg lbi bi progs =
+addInternalBuildTools pwd pkg lbi bi progs =
   prependProgramSearchPathNoLogging
     internalToolPaths
     [pkgDataDirVar]
@@ -949,13 +955,11 @@ addInternalBuildTools pkg lbi bi progs =
                 buildDir lbi
                   </> makeRelativePathEx (toolName' </> toolName' <.> exeExtension (hostPlatform lbi))
       ]
-    mbWorkDir = mbWorkDirLBI lbi
-    rawDataDir = dataDir pkg
-    dataDirPath
-      | null $ getSymbolicPath rawDataDir =
-          interpretSymbolicPath mbWorkDir sameDirectory
-      | otherwise =
-          interpretSymbolicPath mbWorkDir rawDataDir
+
+    -- This is an absolute path, so if a process changes directory, it can still
+    -- find the datadir (#10717)
+    dataDirPath :: FilePath
+    dataDirPath = interpretSymbolicPathAbsolute pwd (dataDir pkg)
 
 -- TODO: build separate libs in separate dirs so that we can build
 -- multiple libs, e.g. for 'LibTest' library-style test suites
diff --git a/Cabal/src/Distribution/Simple/Haddock.hs b/Cabal/src/Distribution/Simple/Haddock.hs
@@ -331,12 +331,13 @@ haddock_setupHooks
       createInternalPackageDB verbosity lbi (flag $ setupDistPref . haddockCommonFlags)
 
     (\f -> foldM_ f (installedPkgs lbi) targets') $ \index target -> do
+      curDir <- absoluteWorkingDirLBI lbi
       let
         component = targetComponent target
         clbi = targetCLBI target
         bi = componentBuildInfo component
         -- Include any build-tool-depends on build tools internal to the current package.
-        progs' = addInternalBuildTools pkg_descr lbi bi (withPrograms lbi)
+        progs' = addInternalBuildTools curDir pkg_descr lbi bi (withPrograms lbi)
         lbi' =
           lbi
             { withPrograms = progs'
diff --git a/Cabal/src/Distribution/Simple/Test.hs b/Cabal/src/Distribution/Simple/Test.hs
@@ -70,6 +70,7 @@ test
   -- ^ flags sent to test
   -> IO ()
 test args pkg_descr lbi0 flags = do
+  curDir <- LBI.absoluteWorkingDirLBI lbi0
   let common = testCommonFlags flags
       verbosity = fromFlag $ setupVerbosity common
       distPref = fromFlag $ setupDistPref common
@@ -96,6 +97,7 @@ test args pkg_descr lbi0 flags = do
                 { withPrograms =
                     -- Include any build-tool-depends on build tools internal to the current package.
                     addInternalBuildTools
+                      curDir
                       pkg_descr
                       lbi
                       (PD.testBuildInfo suite)
diff --git a/cabal-install/src/Distribution/Client/Run.hs b/cabal-install/src/Distribution/Client/Run.hs
@@ -35,6 +35,7 @@ import Distribution.Simple.Flag (fromFlag)
 import Distribution.Simple.LocalBuildInfo
   ( ComponentName (..)
   , LocalBuildInfo (..)
+  , absoluteWorkingDirLBI
   , buildDir
   , depLibraryPaths
   , interpretSymbolicPathLBI
@@ -142,6 +143,7 @@ splitRunArgs verbosity lbi args =
 -- | Run a given executable.
 run :: Verbosity -> LocalBuildInfo -> Executable -> [String] -> IO ()
 run verbosity lbi exe exeArgs = do
+  curDir <- absoluteWorkingDirLBI lbi
   let distPref = fromFlag $ configDistPref $ configFlags lbi
       buildPref = buildDir lbi
       pkg_descr = localPkgDescr lbi
@@ -154,6 +156,7 @@ run verbosity lbi exe exeArgs = do
           , -- Include any build-tool-depends on build tools internal to the current package.
             withPrograms =
               addInternalBuildTools
+                curDir
                 pkg_descr
                 lbi
                 (buildInfo exe)
diff --git a/cabal-testsuite/PackageTests/DataDirSetupTest/Setup.hs b/cabal-testsuite/PackageTests/DataDirSetupTest/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/cabal-testsuite/PackageTests/DataDirSetupTest/cabal.cabal.out b/cabal-testsuite/PackageTests/DataDirSetupTest/cabal.cabal.out
@@ -0,0 +1,13 @@
+# Setup configure
+Configuring datadir-test-0.1.0.0...
+# Setup build
+Preprocessing library for datadir-test-0.1.0.0...
+Building library for datadir-test-0.1.0.0...
+Preprocessing test suite 'datadir-test' for datadir-test-0.1.0.0...
+Building test suite 'datadir-test' for datadir-test-0.1.0.0...
+# Setup test
+Running 1 test suites...
+Test suite datadir-test: RUNNING...
+Test suite datadir-test: PASS
+Test suite logged to: cabal.cabal.dist/work/dist/test/datadir-test-0.1.0.0-datadir-test.log
+1 of 1 test suites (1 of 1 test cases) passed.
diff --git a/cabal-testsuite/PackageTests/DataDirSetupTest/cabal.out b/cabal-testsuite/PackageTests/DataDirSetupTest/cabal.out
@@ -0,0 +1,13 @@
+# Setup configure
+Configuring datadir-test-0.1.0.0...
+# Setup build
+Preprocessing library for datadir-test-0.1.0.0...
+Building library for datadir-test-0.1.0.0...
+Preprocessing test suite 'datadir-test' for datadir-test-0.1.0.0...
+Building test suite 'datadir-test' for datadir-test-0.1.0.0...
+# Setup test
+Running 1 test suites...
+Test suite datadir-test: RUNNING...
+Test suite datadir-test: PASS
+Test suite logged to: cabal.dist/work/dist/test/datadir-test-0.1.0.0-datadir-test.log
+1 of 1 test suites (1 of 1 test cases) passed.
diff --git a/cabal-testsuite/PackageTests/DataDirSetupTest/cabal.test.hs b/cabal-testsuite/PackageTests/DataDirSetupTest/cabal.test.hs
@@ -0,0 +1,5 @@
+import Test.Cabal.Prelude
+
+main = setupAndCabalTest $ do
+    setup_build ["--enable-tests"]
+    setup "test" ["--show-details=streaming"]
diff --git a/cabal-testsuite/PackageTests/DataDirSetupTest/datadir-test.cabal b/cabal-testsuite/PackageTests/DataDirSetupTest/datadir-test.cabal
@@ -0,0 +1,27 @@
+cabal-version:      2.4
+name:               datadir-test
+version:            0.1.0.0
+synopsis:           Test for datadir environment variable
+license:            BSD-3-Clause
+author:             Cabal Test Suite
+maintainer:         cabal-dev@haskell.org
+build-type:         Simple
+
+data-files:
+    testdata/sample.txt
+
+library
+    exposed-modules:     MyLib
+    build-depends:       base >=4.7 && <5
+    other-modules: Paths_datadir_test
+    hs-source-dirs:      src
+    default-language:    Haskell2010
+
+test-suite datadir-test
+    type:               exitcode-stdio-1.0
+    main-is:            DataDirTest.hs
+    hs-source-dirs:     test
+    build-depends:      base >=4.7 && <5,
+                        datadir-test,
+                        directory
+    default-language:   Haskell2010
diff --git a/cabal-testsuite/PackageTests/DataDirSetupTest/src/MyLib.hs b/cabal-testsuite/PackageTests/DataDirSetupTest/src/MyLib.hs
@@ -0,0 +1,6 @@
+module MyLib (getDataFileName) where
+
+import qualified Paths_datadir_test as Paths
+
+getDataFileName :: FilePath -> IO FilePath
+getDataFileName = Paths.getDataFileName
diff --git a/cabal-testsuite/PackageTests/DataDirSetupTest/test/DataDirTest.hs b/cabal-testsuite/PackageTests/DataDirSetupTest/test/DataDirTest.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Main where
+
+import Control.Monad (when)
+import System.Directory (createDirectory, doesFileExist, getCurrentDirectory, setCurrentDirectory)
+import System.Environment (getEnv)
+import System.Exit (exitFailure, exitSuccess)
+import System.IO (hPutStrLn, stderr)
+import MyLib (getDataFileName)
+import Control.Exception
+
+main :: IO ()
+main = do
+    -- Print the datadir environment variable
+    dataDirEnv <- getEnv "datadir_test_datadir"
+    putStrLn $ "datadir_test_datadir: " ++ dataDirEnv
+
+    -- Get path to our test data file
+    dataFilePath <- getDataFileName "testdata/sample.txt"
+    putStrLn $ "Data file path: " ++ dataFilePath
+
+    -- Check that we can access the file
+    fileExists <- doesFileExist dataFilePath
+    putStrLn $ "File exists: " ++ show fileExists
+
+    -- Create a subdirectory and change into it
+    currentDir <- getCurrentDirectory
+    putStrLn $ "Current directory: " ++ currentDir
+    createDirectory "subdir" `catch` \(_ :: SomeException) -> pure ()
+    setCurrentDirectory "subdir"
+    newDir <- getCurrentDirectory
+    putStrLn $ "New directory: " ++ newDir
+
+    -- Try to access the data file again after changing directory
+    dataFilePathAfterCd <- getDataFileName "testdata/sample.txt"
+    putStrLn $ "Data file path after cd: " ++ dataFilePathAfterCd
+
+    fileExistsAfterCd <- doesFileExist dataFilePathAfterCd
+    putStrLn $ "File exists after cd: " ++ show fileExistsAfterCd
+
+    -- Exit with error if we can't find the file
+    when (not fileExistsAfterCd) $ do
+        hPutStrLn stderr "ERROR: Could not find data file after changing directory!"
+        hPutStrLn stderr $ "datadir_test_datadir was set to: " ++ dataDirEnv
+        exitFailure
+
+    putStrLn "SUCCESS: Data file found correctly even after changing directory!"
+    exitSuccess
diff --git a/cabal-testsuite/PackageTests/DataDirSetupTest/testdata/sample.txt b/cabal-testsuite/PackageTests/DataDirSetupTest/testdata/sample.txt
@@ -0,0 +1 @@
+This is test data for the datadir test.
diff --git a/changelog.d/pr-10830.md b/changelog.d/pr-10830.md
@@ -0,0 +1,10 @@
+---
+synopsis: Set <pkgname>_datadir to an absolute path when running tests
+packages: [Cabal]
+prs: 10828
+issues: [10717]
+---
+
+Fix a regression where `<pkgname>_datadir` was set to a relative path. This
+caused issues when running testsuites which changed the working directory and
+accessed datafiles.

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,2 @@`
	`1`	`+import Distribution.Simple`
	`2`	`+main = defaultMain`