Skip to content
Snippets Groups Projects
Commit 9aaf1fac authored by sheaf's avatar sheaf Committed by Mergify
Browse files

Testsuite: pass -i argument to runghc invocations

This commit modifies the generation of runghc commands to pass an
additional -i argument to account for the change in working directory.

This ensures that, in the testsuite, runghc is able to see other modules.
For example, an invocation of runghc to run a Custom Setup script will
now properly see the modules imported, e.g. if one has a directory
structure like

  test.cabal
  Setup.hs
  SetupDep.hs

and Setup.hs imports SetupDep.hs.

(cherry picked from commit b2b9c2f6)
parent 4193f06f
No related tags found
No related merge requests found
module Main where
import SetupDep ( depMain )
main :: IO ()
main = depMain
module SetupDep where
import Distribution.Simple
depMain :: IO ()
depMain = defaultMain
packages: .
cabal-version: 2.2
name: setup-dep
version: 0.1.0.0
synopsis: Test for a Setup.hs with a dependency
license: BSD-3-Clause
author: NA
maintainer: NA
category: Testing
build-type: Custom
custom-setup
setup-depends: Cabal, base
library
build-depends: base
default-language: Haskell2010
# Setup configure
Configuring setup-dep-0.1.0.0...
# Setup build
Preprocessing library for setup-dep-0.1.0.0...
Building library for setup-dep-0.1.0.0...
import Test.Cabal.Prelude
main = setupTest $ do
setup "configure" []
setup "build" []
......@@ -77,23 +77,32 @@ runghc senv mb_cwd env_overrides script_path args = do
-- script with 'runghc'.
runnerCommand :: ScriptEnv -> Maybe FilePath -> [(String, Maybe String)]
-> FilePath -> [String] -> IO (FilePath, [String])
runnerCommand senv _mb_cwd _env_overrides script_path args = do
runnerCommand senv mb_cwd _env_overrides script_path args = do
(prog, _) <- requireProgram verbosity runghcProgram (runnerProgramDb senv)
return (programPath prog,
runghc_args ++ ["--"] ++ map ("--ghc-arg="++) ghc_args ++ [script_path] ++ args)
where
verbosity = runnerVerbosity senv
runghc_args = []
ghc_args = runnerGhcArgs senv
ghc_args = runnerGhcArgs senv mb_cwd
-- | Compute the GHC flags to invoke 'runghc' with under a 'ScriptEnv'.
runnerGhcArgs :: ScriptEnv -> [String]
runnerGhcArgs senv =
runnerGhcArgs :: ScriptEnv -> Maybe FilePath -> [String]
runnerGhcArgs senv mb_cwd =
renderGhcOptions (runnerCompiler senv) (runnerPlatform senv) ghc_options
where
ghc_options = M.mempty { ghcOptPackageDBs = runnerPackageDbStack senv
, ghcOptPackages = toNubListR (runnerPackages senv)
, ghcOptHideAllPackages = Flag True
-- Avoid picking stray module files that look
-- like our imports
, ghcOptSourcePathClear = Flag True }
-- like our imports...
, ghcOptSourcePathClear = Flag True
-- ... yet retain the current directory as an included
-- directory, e.g. so that we can compile a Setup.hs
-- script which imports a locally defined module.
-- See the PackageTests/SetupDep test.
, ghcOptSourcePath = toNubListR $
case mb_cwd of
Nothing -> []
Just wd -> [wd]
}
......@@ -218,7 +218,7 @@ runMain ref m = do
startServer :: Chan ServerLogMsg -> ScriptEnv -> IO Server
startServer chan senv = do
(prog, _) <- requireProgram verbosity ghcProgram (runnerProgramDb senv)
let ghc_args = runnerGhcArgs senv ++ ["--interactive", "-v0", "-ignore-dot-ghci"]
let ghc_args = runnerGhcArgs senv Nothing ++ ["--interactive", "-v0", "-ignore-dot-ghci"]
proc_spec = (proc (programPath prog) ghc_args) {
create_group = True,
-- Closing fds is VERY important to avoid
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment