Commit 2d788539 authored by Oleg Grenrus's avatar Oleg Grenrus Committed by GitHub

Merge pull request #6923 from bubba/fix-repl-build-deps

Fix ghci being launched before other sources are built
parents 23ee91a6 e3d26087
......@@ -510,7 +510,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
when (forceStatic || withStaticLib lbi)
whenGHCiLib = when (withGHCiLib lbi)
forRepl = maybe False (const True) mReplFlags
ifReplLib = when forRepl
whenReplLib = when forRepl
replFlags = fromMaybe mempty mReplFlags
comp = compiler lbi
ghcVersion = compilerVersion comp
......@@ -672,10 +672,6 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
unless forRepl $ whenProfLib (runGhcProgIfNeeded profCxxOpts)
| filename <- cxxSources libBi]
ifReplLib $ do
when (null (allLibModules lib clbi)) $ warn verbosity "No exposed modules"
ifReplLib (runGhcProg replOpts)
-- build any C sources
unless (not has_code || null (cSources libBi)) $ do
info verbosity "Building C Sources..."
......@@ -772,6 +768,9 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
-- TODO: problem here is we need the .c files built first, so we can load them
-- with ghci, but .c files can depend on .h files generated by ghc by ffi
-- exports.
whenReplLib $ do
when (null (allLibModules lib clbi)) $ warn verbosity "No exposed modules"
runGhcProg replOpts
-- link:
when has_code . unless forRepl $ do
......
......@@ -49,5 +49,5 @@ main = cabalTest $ do
(Just (testCurrentDir env))
(testEnvironment env)
(programPath configured_prog)
args
args Nothing
recordLog r
......@@ -3,7 +3,7 @@ main = setupAndCabalTest $ do
skipUnless =<< ghcVersionIs (>= mkVersion [8,1])
withPackageDb $ do
setup_install []
_ <- runM "touch" ["repo/indef-0.1.0.0/Foo.hs"]
_ <- runM "touch" ["repo/indef-0.1.0.0/Foo.hs"] Nothing
setup "build" []
runExe' "exe" [] >>= assertOutputContains "fromList [(0,2),(2,4)]"
......@@ -39,6 +39,7 @@ main = setupAndCabalTest . recordMode DoNotRecord $ do
, "UseLib.c"
, "-l", "myforeignlib"
, "-L", flibdir installDirs ]
Nothing
-- Run the C program
let ldPath = case hostPlatform lbi of
......@@ -48,7 +49,7 @@ main = setupAndCabalTest . recordMode DoNotRecord $ do
oldLdPath <- liftIO $ getEnv' ldPath
withEnv [ (ldPath, Just $ flibdir installDirs ++ [searchPathSeparator] ++ oldLdPath) ] $ do
cwd <- fmap testCurrentDir getTestEnv
result <- runM (cwd </> "uselib") []
result <- runM (cwd </> "uselib") [] Nothing
assertOutputContains "5678" result
assertOutputContains "189" result
......@@ -70,7 +71,7 @@ main = setupAndCabalTest . recordMode DoNotRecord $ do
objInfo <- runM (programPath objdump) [
"-x"
, libdir </> libraryName
]
] Nothing
assertBool "SONAME of 'libversionedlib.so.5.4.3' incorrect" $
elem "libversionedlib.so.5" $ words $ resultOutput objInfo
_ -> return ()
......
module Lib where
foreign import ccall "foo" foo :: Int
bar = foo
cabal-version: 2.4
name: cabal-csrc-repl
version: 0.1.0.0
library
exposed-modules: Lib
build-depends: base
C-sources: foo.c
default-language: Haskell2010
import Test.Cabal.Prelude
main = cabalTest $ do
cabal' "clean" []
res <- cabalWithStdin "repl" ["-v2"] "foo"
-- Make sure we don't get this ghci error
-- *Lib> ghc: ^^ Could not load '_foo', dependency unresolved. See top entry above.
assertOutputDoesNotContain "Could not load" res
assertOutputContains "Building C Sources..." res
......@@ -70,23 +70,24 @@ import System.Posix.Resource
------------------------------------------------------------------------
-- * Utilities
runM :: FilePath -> [String] -> TestM Result
runM path args = do
runM :: FilePath -> [String] -> Maybe String -> TestM Result
runM path args input = do
env <- getTestEnv
r <- liftIO $ run (testVerbosity env)
(Just (testCurrentDir env))
(testEnvironment env)
path
args
input
recordLog r
requireSuccess r
runProgramM :: Program -> [String] -> TestM Result
runProgramM prog args = do
runProgramM :: Program -> [String] -> Maybe String -> TestM Result
runProgramM prog args input = do
configured_prog <- requireProgramM prog
-- TODO: Consider also using other information from
-- ConfiguredProgram, e.g., env and args
runM (programPath configured_prog) args
runM (programPath configured_prog) args input
getLocalBuildInfoM :: TestM LocalBuildInfo
getLocalBuildInfoM = do
......@@ -172,11 +173,11 @@ setup'' prefix cmd args = do
pdesc <- liftIO $ readGenericPackageDescription (testVerbosity env) pdfile
if testCabalInstallAsSetup env
then if buildType (packageDescription pdesc) == Simple
then runProgramM cabalProgram ("act-as-setup" : "--" : NE.toList full_args)
then runProgramM cabalProgram ("act-as-setup" : "--" : NE.toList full_args) Nothing
else fail "Using act-as-setup for not 'build-type: Simple' package"
else do
if buildType (packageDescription pdesc) == Simple
then runM (testSetupPath env) (NE.toList full_args)
then runM (testSetupPath env) (NE.toList full_args) Nothing
-- Run the Custom script!
else do
r <- liftIO $ runghc (testScriptEnv env)
......@@ -257,11 +258,17 @@ cabal cmd args = void (cabal' cmd args)
cabal' :: String -> [String] -> TestM Result
cabal' = cabalG' []
cabalWithStdin :: String -> [String] -> String -> TestM Result
cabalWithStdin cmd args input = cabalGArgs [] cmd args (Just input)
cabalG :: [String] -> String -> [String] -> TestM ()
cabalG global_args cmd args = void (cabalG' global_args cmd args)
cabalG' :: [String] -> String -> [String] -> TestM Result
cabalG' global_args cmd args = do
cabalG' global_args cmd args = cabalGArgs global_args cmd args Nothing
cabalGArgs :: [String] -> String -> [String] -> Maybe String -> TestM Result
cabalGArgs global_args cmd args input = do
env <- getTestEnv
-- Freeze writes out cabal.config to source directory, this is not
-- overwritable
......@@ -293,10 +300,10 @@ cabalG' global_args cmd args = do
++ args
defaultRecordMode RecordMarked $ do
recordHeader ["cabal", cmd]
cabal_raw' cabal_args
cabal_raw' cabal_args input
cabal_raw' :: [String] -> TestM Result
cabal_raw' cabal_args = runProgramM cabalProgram cabal_args
cabal_raw' :: [String] -> Maybe String -> TestM Result
cabal_raw' cabal_args input = runProgramM cabalProgram cabal_args input
withProjectFile :: FilePath -> TestM a -> TestM a
withProjectFile fp m =
......@@ -330,7 +337,7 @@ runPlanExe' pkg_name cname args = do
(CExeName (mkUnqualComponentName cname))
defaultRecordMode RecordAll $ do
recordHeader [pkg_name, cname]
runM (dist_dir </> "build" </> cname </> cname) args
runM (dist_dir </> "build" </> cname </> cname) args Nothing
------------------------------------------------------------------------
-- * Running ghc-pkg
......@@ -367,7 +374,7 @@ ghcPkg' cmd args = do
(programVersion ghcConfProg))
db_stack
recordHeader ["ghc-pkg", cmd]
runProgramM ghcPkgProgram (cmd : extraArgs ++ args)
runProgramM ghcPkgProgram (cmd : extraArgs ++ args) Nothing
ghcPkgPackageDBParams :: Version -> PackageDBStack -> [String]
ghcPkgPackageDBParams version dbs = concatMap convert dbs where
......@@ -395,7 +402,7 @@ runExe' exe_name args = do
env <- getTestEnv
defaultRecordMode RecordAll $ do
recordHeader [exe_name]
runM (testDistDir env </> "build" </> exe_name </> exe_name) args
runM (testDistDir env </> "build" </> exe_name </> exe_name) args Nothing
-- | Run an executable that was installed by cabal. The @exe_name@
-- is precisely the name of the executable.
......@@ -410,11 +417,11 @@ runInstalledExe' exe_name args = do
env <- getTestEnv
defaultRecordMode RecordAll $ do
recordHeader [exe_name]
runM (testPrefixDir env </> "bin" </> exe_name) args
runM (testPrefixDir env </> "bin" </> exe_name) args Nothing
-- | Run a shell command in the current directory.
shell :: String -> [String] -> TestM Result
shell exe args = runM exe args
shell exe args = runM exe args Nothing
------------------------------------------------------------------------
-- * Repository manipulation
......@@ -455,7 +462,7 @@ hackageRepoTool cmd args = void $ hackageRepoTool' cmd args
hackageRepoTool' :: String -> [String] -> TestM Result
hackageRepoTool' cmd args = do
recordHeader ["hackage-repo-tool", cmd]
runProgramM hackageRepoToolProgram (cmd : args)
runProgramM hackageRepoToolProgram (cmd : args) Nothing
tar :: [String] -> TestM ()
tar args = void $ tar' args
......@@ -463,7 +470,7 @@ tar args = void $ tar' args
tar' :: [String] -> TestM Result
tar' args = do
recordHeader ["tar"]
runProgramM tarProgram args
runProgramM tarProgram args Nothing
-- | Creates a tarball of a directory, such that if you
-- archive the directory "/foo/bar/baz" to "mine.tgz", @tar tf@ reports
......@@ -733,6 +740,7 @@ hasProfiledLibraries = do
liftIO $ writeFile prof_test_hs "module Prof where"
r <- liftIO $ run (testVerbosity env) (Just (testCurrentDir env))
(testEnvironment env) ghc_path ["-prof", "-c", prof_test_hs]
Nothing
return (resultExitCode r == ExitSuccess)
-- | Check if the GHC that is used for compiling package tests has
......@@ -836,7 +844,7 @@ git cmd args = void $ git' cmd args
git' :: String -> [String] -> TestM Result
git' cmd args = do
recordHeader ["git", cmd]
runProgramM gitProgram (cmd : args)
runProgramM gitProgram (cmd : args) Nothing
gcc :: [String] -> TestM ()
gcc args = void $ gcc' args
......@@ -844,7 +852,7 @@ gcc args = void $ gcc' args
gcc' :: [String] -> TestM Result
gcc' args = do
recordHeader ["gcc"]
runProgramM gccProgram args
runProgramM gccProgram args Nothing
ghc :: [String] -> TestM ()
ghc args = void $ ghc' args
......@@ -852,7 +860,7 @@ ghc args = void $ ghc' args
ghc' :: [String] -> TestM Result
ghc' args = do
recordHeader ["ghc"]
runProgramM ghcProgram args
runProgramM ghcProgram args Nothing
-- | If a test needs to modify or write out source files, it's
-- necessary to make a hermetic copy of the source files to operate
......
......@@ -5,12 +5,12 @@ module Test.Cabal.Run (
Result(..)
) where
import Distribution.Compat.CreatePipe (createPipe)
import qualified Distribution.Compat.CreatePipe as Compat
import Distribution.Simple.Program.Run
import Distribution.Verbosity
import Control.Concurrent.Async
import System.Process (runProcess, waitForProcess, showCommandForUser)
import System.Process
import System.IO
import System.Exit
import System.Directory
......@@ -25,8 +25,8 @@ data Result = Result
-- | Run a command, streaming its output to stdout, and return a 'Result'
-- with this information.
run :: Verbosity -> Maybe FilePath -> [(String, Maybe String)] -> FilePath -> [String] -> IO Result
run _verbosity mb_cwd env_overrides path0 args = do
run :: Verbosity -> Maybe FilePath -> [(String, Maybe String)] -> FilePath -> [String] -> Maybe String -> IO Result
run _verbosity mb_cwd env_overrides path0 args input = do
-- In our test runner, we allow a path to be relative to the
-- current directory using the same heuristic as shells:
-- 'foo' refers to an executable in the PATH, but './foo'
......@@ -38,15 +38,15 @@ run _verbosity mb_cwd env_overrides path0 args = do
-- subprocess will execute in. Thus, IF we have a relative
-- path which is not a bare executable name, we have to tack on
-- the CWD to make it resolve correctly
cwd <- getCurrentDirectory
cwdir <- getCurrentDirectory
let path | length (splitPath path0) /= 1 && isRelative path0
= cwd </> path0
= cwdir </> path0
| otherwise
= path0
mb_env <- getEffectiveEnvironment env_overrides
putStrLn $ "+ " ++ showCommandForUser path args
(readh, writeh) <- createPipe
(readh, writeh) <- Compat.createPipe
hSetBuffering readh LineBuffering
hSetBuffering writeh LineBuffering
let drain = do
......@@ -56,13 +56,24 @@ run _verbosity mb_cwd env_overrides path0 args = do
return r
withAsync drain $ \sync -> do
-- NB: do NOT extend this to take stdin; then we will
-- start deadlocking on AppVeyor. See https://github.com/haskell/process/issues/76
pid <- runProcess path args mb_cwd mb_env Nothing {- no stdin -}
(Just writeh) (Just writeh)
let prc = (proc path args)
{ cwd = mb_cwd
, env = mb_env
, std_in = case input of { Just _ -> CreatePipe; Nothing -> Inherit }
, std_out = UseHandle writeh
, std_err = UseHandle writeh
}
(stdin_h, _, _, procHandle) <- createProcess prc
case input of
Just x ->
case stdin_h of
Just h -> hPutStr h x >> hClose h
Nothing -> error "No stdin handle when input was specified!"
Nothing -> return ()
-- wait for the program to terminate
exitcode <- waitForProcess pid
exitcode <- waitForProcess procHandle
out <- wait sync
return Result {
......
......@@ -70,7 +70,7 @@ runghc :: ScriptEnv -> Maybe FilePath -> [(String, Maybe String)]
-> FilePath -> [String] -> IO Result
runghc senv mb_cwd env_overrides script_path args = do
(real_path, real_args) <- runnerCommand senv mb_cwd env_overrides script_path args
run (runnerVerbosity senv) mb_cwd env_overrides real_path real_args
run (runnerVerbosity senv) mb_cwd env_overrides real_path real_args Nothing
-- | Compute the command line which should be used to run a Haskell
-- script with 'runghc'.
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment