aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/Distribution/Helper.hs1
-rw-r--r--src/CabalHelper/Runtime/Main.hs16
-rw-r--r--tests/GhcSession.hs65
3 files changed, 50 insertions, 32 deletions
diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs
index f98955c..53b2f23 100644
--- a/lib/Distribution/Helper.hs
+++ b/lib/Distribution/Helper.hs
@@ -77,6 +77,7 @@ module Distribution.Helper (
, ChComponentName(..)
, ChPkgDb(..)
, ChEntrypoint(..)
+ , NeedsBuildOutput(..)
-- * General information
, buildPlatform
diff --git a/src/CabalHelper/Runtime/Main.hs b/src/CabalHelper/Runtime/Main.hs
index 0173fe9..e2829b3 100644
--- a/src/CabalHelper/Runtime/Main.hs
+++ b/src/CabalHelper/Runtime/Main.hs
@@ -70,8 +70,11 @@ import Distribution.Simple.LocalBuildInfo
, withComponentsLBI
, withLibLBI
, withExeLBI
+
+#if CH_MIN_VERSION_Cabal(2,0,0)
, allLibModules
, componentBuildDir
+#endif
)
import Distribution.Simple.GHC
( componentGhcOptions
@@ -396,8 +399,10 @@ main = do
#if CH_MIN_VERSION_Cabal(2,0,0)
includeDirMap <- recursiveDepInfo lbi v distdir
eps <- componentsMap lbi v distdir $ \c clbi _bi -> do
- let (_,_,seps) = recursiveIncludeDirs includeDirMap (componentUnitId clbi)
- return seps
+ case needsBuildOutput includeDirMap (componentUnitId clbi) of
+ ProduceBuildOutput -> return $ componentEntrypoints c
+ NoBuildOutput -> return seps
+ where (_,_,seps) = recursiveIncludeDirs includeDirMap (componentUnitId clbi)
#else
eps <- componentsMap lbi v distdir $ \c _clbi _bi ->
return $ componentEntrypoints c
@@ -544,6 +549,8 @@ removeInplaceDeps _v lbi pd clbi includeDirs = let
, componentIncludes = incs }
in (hasIdeps',c')
+ needsBuild = needsBuildOutput includeDirs (componentUnitId clbi)
+
cleanRecursiveOpts :: Component
-> BuildInfo -> ComponentLocalBuildInfo -> GhcOptions
cleanRecursiveOpts comp libbi libclbi =
@@ -563,15 +570,16 @@ removeInplaceDeps _v lbi pd clbi includeDirs = let
(hasIdeps,clbi') = removeInplace clbi
libopts =
+ -- AZ:TODO: we already have the clbi, use it rather
case (getLibraryClbi pd lbi,getExeClbi pd lbi) of
- (Just (lib, libclbi),_) | hasIdeps ->
+ (Just (lib, libclbi),_) | hasIdeps && (needsBuild == NoBuildOutput) ->
let
libbi = libBuildInfo lib
opts = cleanRecursiveOpts (CLib lib) libbi libclbi
in
-- ghcOptInputModules = toNubListR $ allLibModules lib clbi,
opts { ghcOptInputModules = ghcOptInputModules opts <> (toNubListR $ allLibModules lib libclbi) }
- (_,Just (exe,execlbi)) | hasIdeps ->
+ (_,Just (exe,execlbi)) | hasIdeps && (needsBuild == NoBuildOutput) ->
let
exebi = buildInfo exe
in
diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs
index e8d3977..ab07e85 100644
--- a/tests/GhcSession.hs
+++ b/tests/GhcSession.hs
@@ -32,12 +32,12 @@ main = do
topdir <- getCurrentDirectory
res <- mapM (setup topdir test) $ case args of
[] -> [
- -- ("tests/exelib" , parseVer "1.10",False)
- -- , ("tests/exeintlib", parseVer "2.0", False)
- -- , ("tests/fliblib" , parseVer "2.0", False)
- ("tests/bkpregex" , parseVer "2.0", True)
+ -- ("tests/exelib" , parseVer "1.10")
+ -- , ("tests/exeintlib", parseVer "2.0")
+ -- , ("tests/fliblib" , parseVer "2.0")
+ ("tests/bkpregex" , parseVer "2.0")
]
- xs -> map (,parseVer "0",False) xs
+ xs -> map (,parseVer "0") xs
if any (==False) $ concat res
then exitFailure
@@ -52,8 +52,8 @@ cabalInstallBuiltinCabalVersion =
parseVer . trim <$> readProcess "cabal"
["act-as-setup", "--", "--numeric-version"] ""
-setup :: FilePath -> (FilePath -> IO [Bool]) -> (FilePath, Version,Bool) -> IO [Bool]
-setup topdir act (srcdir, min_cabal_ver,invokeCabalBuild) = do
+setup :: FilePath -> (FilePath -> IO [Bool]) -> (FilePath, Version) -> IO [Bool]
+setup topdir act (srcdir, min_cabal_ver) = do
ci_ver <- cabalInstallVersion
c_ver <- cabalInstallBuiltinCabalVersion
let mreason
@@ -81,16 +81,15 @@ setup topdir act (srcdir, min_cabal_ver,invokeCabalBuild) = do
setCurrentDirectory dir
run "cabal" [ "configure" ]
- when invokeCabalBuild $ do
- run "cabal" [ "build" ]
act dir
- where
- run x xs = do
- print $ x:xs
- o <- readProcess x xs ""
- putStrLn o
- return ()
+
+run :: String -> [String] -> IO ()
+run x xs = do
+ print $ x:xs
+ o <- readProcess x xs ""
+ putStrLn o
+ return ()
test :: FilePath -> IO [Bool]
test dir = do
@@ -101,6 +100,9 @@ test dir = do
putStrLn $ "\n" ++ show cn ++ ":::: " ++ show nb
+ when (nb == ProduceBuildOutput) $ do
+ run "cabal" [ "build" ]
+
exists <- doesDirectoryExist packageDir
let opts' = if exists
then ("-package-db " ++ packageDir) : "-Werror" : opts
@@ -111,16 +113,16 @@ test dir = do
let sopts = intercalate " " $ map formatArg $ "\nghc" : opts'
putStrLn $ "\n" ++ show cn ++ ": " ++ sopts
hFlush stdout
- compileModule ep opts'
+ compileModule nb ep opts'
where
formatArg x
| "-" `isPrefixOf` x = "\n "++x
| otherwise = x
-compileModule :: ChEntrypoint -> [String] -> IO Bool
-compileModule ep opts = do
+compileModule :: NeedsBuildOutput -> ChEntrypoint -> [String] -> IO Bool
+compileModule nb ep opts = do
- putStrLn $ "compiling:" ++ show ep
+ putStrLn $ "compiling:" ++ show ep ++ " (" ++ show nb ++ ")"
E.handle (\(ec :: ExitCode) -> print ec >> return False) $ do
@@ -134,11 +136,15 @@ compileModule ep opts = do
handleSourceError (\e -> GHC.printException e >> return False) $ do
+ let target = case nb of
+ ProduceBuildOutput -> HscNothing -- AZ: what should this be?
+ NoBuildOutput -> HscInterpreted
+
dflags0 <- getSessionDynFlags
let dflags1 = dflags0 {
ghcMode = CompManager
, ghcLink = LinkInMemory
- , hscTarget = HscInterpreted
+ , hscTarget = target
, optLevel = 0
}
@@ -150,19 +156,22 @@ compileModule ep opts = do
ChLibEntrypoint ms ms' ss -> map unChModuleName $ ms ++ ms' ++ ss
ChExeEntrypoint m ms -> [m] ++ map unChModuleName ms
ChSetupEntrypoint -> ["Setup.hs"]
- let ts' = map (\t -> t { targetAllowObjCode = False }) ts
+ let ts' = case nb of
+ NoBuildOutput -> map (\t -> t { targetAllowObjCode = False }) ts
+ ProduceBuildOutput -> ts
setTargets ts'
_ <- load LoadAllTargets
#if __GLASGOW_HASKELL__ >= 706
- setContext $ case ep of
- ChLibEntrypoint ms ms' ss ->
- map (IIModule . mkModuleName . unChModuleName) $ ms ++ ms' ++ ss
- ChExeEntrypoint _ ms ->
- map (IIModule . mkModuleName . unChModuleName) $ ChModuleName "Main" : ms
- ChSetupEntrypoint ->
- map (IIModule . mkModuleName) ["Main"]
+ when (nb == NoBuildOutput) $ do
+ setContext $ case ep of
+ ChLibEntrypoint ms ms' ss ->
+ map (IIModule . mkModuleName . unChModuleName) $ ms ++ ms' ++ ss
+ ChExeEntrypoint _ ms ->
+ map (IIModule . mkModuleName . unChModuleName) $ ChModuleName "Main" : ms
+ ChSetupEntrypoint ->
+ map (IIModule . mkModuleName) ["Main"]
#endif
#if __GLASGOW_HASKELL__ <= 706
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 04:56:36 +0000