From e3d26087d4608e478ce68d36f02938d635c4cf26 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Sun, 21 Jun 2020 14:16:27 +0100 Subject: [PATCH] Fix ghci being launched before other sources were built This looks like an accident from a6e427ac9e86ec63572fde702ada0a7fbed7dbb3 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. --- Cabal/Distribution/Simple/GHC.hs | 9 ++-- .../AutoconfBadPaths/cabal.test.hs | 2 +- .../Backpack/Includes3/setup-internal.test.hs | 2 +- .../PackageTests/ForeignLibs/setup.test.hs | 5 +- .../PackageTests/ReplCSources/Lib.hs | 5 ++ .../ReplCSources/cabal-csrc-repl.cabal | 8 +++ .../PackageTests/ReplCSources/cabal.out | 2 + .../PackageTests/ReplCSources/cabal.project | 1 + .../PackageTests/ReplCSources/cabal.test.hs | 9 ++++ .../PackageTests/ReplCSources/foo.c | 1 + cabal-testsuite/src/Test/Cabal/Prelude.hs | 50 +++++++++++-------- cabal-testsuite/src/Test/Cabal/Run.hs | 35 ++++++++----- cabal-testsuite/src/Test/Cabal/Script.hs | 2 +- 13 files changed, 88 insertions(+), 43 deletions(-) create mode 100644 cabal-testsuite/PackageTests/ReplCSources/Lib.hs create mode 100644 cabal-testsuite/PackageTests/ReplCSources/cabal-csrc-repl.cabal create mode 100644 cabal-testsuite/PackageTests/ReplCSources/cabal.out create mode 100644 cabal-testsuite/PackageTests/ReplCSources/cabal.project create mode 100644 cabal-testsuite/PackageTests/ReplCSources/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/ReplCSources/foo.c diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 93ac6043934..69d3065a7b1 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -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 diff --git a/cabal-testsuite/PackageTests/AutoconfBadPaths/cabal.test.hs b/cabal-testsuite/PackageTests/AutoconfBadPaths/cabal.test.hs index 53ad6216cdd..730950b9d4e 100644 --- a/cabal-testsuite/PackageTests/AutoconfBadPaths/cabal.test.hs +++ b/cabal-testsuite/PackageTests/AutoconfBadPaths/cabal.test.hs @@ -49,5 +49,5 @@ main = cabalTest $ do (Just (testCurrentDir env)) (testEnvironment env) (programPath configured_prog) - args + args Nothing recordLog r diff --git a/cabal-testsuite/PackageTests/Backpack/Includes3/setup-internal.test.hs b/cabal-testsuite/PackageTests/Backpack/Includes3/setup-internal.test.hs index b75823a5b23..3f46a804583 100644 --- a/cabal-testsuite/PackageTests/Backpack/Includes3/setup-internal.test.hs +++ b/cabal-testsuite/PackageTests/Backpack/Includes3/setup-internal.test.hs @@ -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)]" diff --git a/cabal-testsuite/PackageTests/ForeignLibs/setup.test.hs b/cabal-testsuite/PackageTests/ForeignLibs/setup.test.hs index dd1b5c44989..24032abf49e 100644 --- a/cabal-testsuite/PackageTests/ForeignLibs/setup.test.hs +++ b/cabal-testsuite/PackageTests/ForeignLibs/setup.test.hs @@ -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 () diff --git a/cabal-testsuite/PackageTests/ReplCSources/Lib.hs b/cabal-testsuite/PackageTests/ReplCSources/Lib.hs new file mode 100644 index 00000000000..0ea9d872060 --- /dev/null +++ b/cabal-testsuite/PackageTests/ReplCSources/Lib.hs @@ -0,0 +1,5 @@ +module Lib where + +foreign import ccall "foo" foo :: Int + +bar = foo diff --git a/cabal-testsuite/PackageTests/ReplCSources/cabal-csrc-repl.cabal b/cabal-testsuite/PackageTests/ReplCSources/cabal-csrc-repl.cabal new file mode 100644 index 00000000000..8df5fee5fb4 --- /dev/null +++ b/cabal-testsuite/PackageTests/ReplCSources/cabal-csrc-repl.cabal @@ -0,0 +1,8 @@ +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 diff --git a/cabal-testsuite/PackageTests/ReplCSources/cabal.out b/cabal-testsuite/PackageTests/ReplCSources/cabal.out new file mode 100644 index 00000000000..f7fe5f202cf --- /dev/null +++ b/cabal-testsuite/PackageTests/ReplCSources/cabal.out @@ -0,0 +1,2 @@ +# cabal clean +# cabal repl diff --git a/cabal-testsuite/PackageTests/ReplCSources/cabal.project b/cabal-testsuite/PackageTests/ReplCSources/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/ReplCSources/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/ReplCSources/cabal.test.hs b/cabal-testsuite/PackageTests/ReplCSources/cabal.test.hs new file mode 100644 index 00000000000..ca7502d5a04 --- /dev/null +++ b/cabal-testsuite/PackageTests/ReplCSources/cabal.test.hs @@ -0,0 +1,9 @@ +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 diff --git a/cabal-testsuite/PackageTests/ReplCSources/foo.c b/cabal-testsuite/PackageTests/ReplCSources/foo.c new file mode 100644 index 00000000000..bf7759e11ea --- /dev/null +++ b/cabal-testsuite/PackageTests/ReplCSources/foo.c @@ -0,0 +1 @@ +int foo() { return 42; } diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 68340059bdc..2c95c4e4f70 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -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 diff --git a/cabal-testsuite/src/Test/Cabal/Run.hs b/cabal-testsuite/src/Test/Cabal/Run.hs index 2823bf1695a..141be2575fa 100644 --- a/cabal-testsuite/src/Test/Cabal/Run.hs +++ b/cabal-testsuite/src/Test/Cabal/Run.hs @@ -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 { diff --git a/cabal-testsuite/src/Test/Cabal/Script.hs b/cabal-testsuite/src/Test/Cabal/Script.hs index 7cbf68afc53..d509e6efe4a 100644 --- a/cabal-testsuite/src/Test/Cabal/Script.hs +++ b/cabal-testsuite/src/Test/Cabal/Script.hs @@ -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'.