Commit e3d26087 authored by Luke Lau's avatar Luke Lau

Fix ghci being launched before other sources were built

This looks like an accident from a6e427ac
It causes cases like this to fail:

$ cat foo.c
int foo() { return 42; }
$ cat Lib.hs
module Lib where

foreign import ccall "foo" foo :: Int

bar = foo
$ cat cabal-csrc-repl.cabal
cabal-version:      2.4
name:               cabal-csrc-repl
version:            0.1.0.0
library
    exposed-modules:  Lib
    build-depends:    base ^>=4.14.0.0
    C-sources:        foo.c
    default-language: Haskell2010
$ cabal v2-repl
Resolving dependencies...
Build profile: -w ghc-8.10.1 -O1
In order, the following will be built (use -v for more details):
 - cabal-csrc-repl-0.1.0.0 (lib) (first run)
Configuring library for cabal-csrc-repl-0.1.0.0..
Preprocessing library for cabal-csrc-repl-0.1.0.0..
GHCi, version 8.10.1: https://www.haskell.org/ghc/  :? for help
[1 of 1] Compiling Lib              ( Lib.hs, interpreted )
Ok, one module loaded.
*Lib> foo
ghc: ^^ Could not load '_foo', dependency unresolved. See top entry above.
parent b256029a
......@@ -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