diff --git a/Cabal/src/Distribution/Simple/Bench.hs b/Cabal/src/Distribution/Simple/Bench.hs index 78f169f255a..c4b4dbd2f6c 100644 --- 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 index 0ebd51e48ef..647480d3594 100644 --- 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 index ee2b88e76af..5c534c01d04 100644 --- 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 index 5b7a6daa718..57107eef648 100644 --- 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 index 88671a9f53c..1dd9db32c99 100644 --- 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 new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ 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 new file mode 100644 index 00000000000..f1e923b5ca8 --- /dev/null +++ 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 new file mode 100644 index 00000000000..eadbc3aeac3 --- /dev/null +++ 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 new file mode 100644 index 00000000000..e779c5cb62b --- /dev/null +++ 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 new file mode 100644 index 00000000000..b17ed9835fe --- /dev/null +++ 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 new file mode 100644 index 00000000000..5aa2db01bdb --- /dev/null +++ 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 new file mode 100644 index 00000000000..1c5d14b7f0b --- /dev/null +++ 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 new file mode 100644 index 00000000000..464ea37bec0 --- /dev/null +++ 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 new file mode 100644 index 00000000000..9e78761441a --- /dev/null +++ b/changelog.d/pr-10830.md @@ -0,0 +1,10 @@ +--- +synopsis: Set _datadir to an absolute path when running tests +packages: [Cabal] +prs: 10828 +issues: [10717] +--- + +Fix a regression where `_datadir` was set to a relative path. This +caused issues when running testsuites which changed the working directory and +accessed datafiles.