aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--cabal-helper.cabal74
-rw-r--r--src/CabalHelper/Runtime/Main.hs63
-rw-r--r--tests/GhcSession.hs16
3 files changed, 66 insertions, 87 deletions
diff --git a/cabal-helper.cabal b/cabal-helper.cabal
index 468d10b..80002b3 100644
--- a/cabal-helper.cabal
+++ b/cabal-helper.cabal
@@ -125,44 +125,44 @@ executable cabal-helper-wrapper
, utf8-string < 1.1 && >= 1.0.1.1
, ghc-prim
--- test-suite compile-test
--- default-language: Haskell2010
--- default-extensions: NondecreasingIndentation
--- type: exitcode-stdio-1.0
--- main-is: CompileTest.hs
--- hs-source-dirs: tests, src
--- other-modules:
--- CabalHelper.Compiletime.Compat.Environment
--- CabalHelper.Compiletime.Compat.Version
--- CabalHelper.Compiletime.Compile
--- CabalHelper.Compiletime.Data
--- CabalHelper.Compiletime.Log
--- CabalHelper.Compiletime.Types
--- CabalHelper.Shared.Common
--- CabalHelper.Shared.Sandbox
--- Paths_cabal_helper
--- ghc-options: -Wall
--- build-tools: cabal
+test-suite compile-test
+ default-language: Haskell2010
+ default-extensions: NondecreasingIndentation
+ type: exitcode-stdio-1.0
+ main-is: CompileTest.hs
+ hs-source-dirs: tests, src
+ other-modules:
+ CabalHelper.Compiletime.Compat.Environment
+ CabalHelper.Compiletime.Compat.Version
+ CabalHelper.Compiletime.Compile
+ CabalHelper.Compiletime.Data
+ CabalHelper.Compiletime.Log
+ CabalHelper.Compiletime.Types
+ CabalHelper.Shared.Common
+ CabalHelper.Shared.Sandbox
+ Paths_cabal_helper
+ ghc-options: -Wall
+ build-tools: cabal
--- -- Same as cabal-helper-wrapper
--- build-depends: base < 5 && >= 4.5
--- if os(windows)
--- build-depends: base >= 4.7
--- build-depends: Cabal < 2.1 && >= 2.0 || < 1.26 && >= 1.14
--- , bytestring < 0.11 && >= 0.9.2.1
--- , directory < 1.4 && >= 1.1.0.2
--- , exceptions < 0.9 && >= 0.8.3
--- , filepath < 1.5 && >= 1.3.0.0
--- , mtl < 2.3 && >= 2.0
--- , process < 1.7 && >= 1.1.0.1
--- , template-haskell < 2.13 && >= 2.7.0.0
--- , temporary < 1.3 && >= 1.2.0.4
--- , transformers < 0.6 && >= 0.3.0.0
--- if !os(windows)
--- build-depends: unix < 2.8 && >= 2.5.1.1
--- build-depends: unix-compat < 0.5 && >= 0.4.3.1
--- , utf8-string < 1.1 && >= 1.0.1.1
--- , ghc-prim
+ -- Same as cabal-helper-wrapper
+ build-depends: base < 5 && >= 4.5
+ if os(windows)
+ build-depends: base >= 4.7
+ build-depends: Cabal < 2.1 && >= 2.0 || < 1.26 && >= 1.14
+ , bytestring < 0.11 && >= 0.9.2.1
+ , directory < 1.4 && >= 1.1.0.2
+ , exceptions < 0.9 && >= 0.8.3
+ , filepath < 1.5 && >= 1.3.0.0
+ , mtl < 2.3 && >= 2.0
+ , process < 1.7 && >= 1.1.0.1
+ , template-haskell < 2.13 && >= 2.7.0.0
+ , temporary < 1.3 && >= 1.2.0.4
+ , transformers < 0.6 && >= 0.3.0.0
+ if !os(windows)
+ build-depends: unix < 2.8 && >= 2.5.1.1
+ build-depends: unix-compat < 0.5 && >= 0.4.3.1
+ , utf8-string < 1.1 && >= 1.0.1.1
+ , ghc-prim
test-suite ghc-session
default-language: Haskell2010
diff --git a/src/CabalHelper/Runtime/Main.hs b/src/CabalHelper/Runtime/Main.hs
index 99170fe..e8d6954 100644
--- a/src/CabalHelper/Runtime/Main.hs
+++ b/src/CabalHelper/Runtime/Main.hs
@@ -450,12 +450,6 @@ componentsMap lbi _v _distdir f = do
reverse <$> readIORef lr
--- componentOptions' :: (LocalBuildInfo, Verbosity, FilePath)
--- -> Bool
--- -> [String]
--- -> (LocalBuildInfo -> Verbosity -> GhcOptions -> IO a)
--- -> (GhcOptions -> GhcOptions)
--- -> IO [(ChComponentName, a)]
componentOptions' (lbi, v, distdir) inplaceFlag flags rf f = do
let pd = localPkgDescr lbi
includeDirs <- componentsMap lbi v distdir $ \_c clbi bi -> do
@@ -463,7 +457,6 @@ componentOptions' (lbi, v, distdir) inplaceFlag flags rf f = do
, (componentInternalDeps clbi, hsSourceDirs bi,componentIncludes clbi))
let includeDirMap = Map.fromList $ map snd includeDirs
- -- putStrLn $ "componentGhcOptions':includeDirMap=" ++ show includeDirMap
componentsMap lbi v distdir $ \c clbi bi -> do
let
outdir = componentOutDir lbi c
@@ -474,15 +467,8 @@ componentOptions' (lbi, v, distdir) inplaceFlag flags rf f = do
opts = componentGhcOptions normal lbi bi clbi' outdir
opts' = f opts
- -- putStrLn $ "componentGhcOptions':opts'=" ++ show opts'
- -- putStrLn $ "************************componentGhcOptions':adopts=" ++ show (ghcOptSourcePath adopts)
rf lbi v $ nubPackageFlags $ opts' `mappend` adopts
-componentOptions :: (LocalBuildInfo, Verbosity, FilePath)
- -> Bool
- -> [String]
- -> (GhcOptions -> GhcOptions)
- -> IO [(ChComponentName, [String])]
componentOptions (lbi, v, distdir) inplaceFlag flags f =
componentOptions' (lbi, v, distdir) inplaceFlag flags renderGhcOptions' f
@@ -508,45 +494,44 @@ removeInplaceDeps _v lbi pd clbi includeDirs = let
let
(ideps, deps) = partition (isInplaceDep lbi c) (componentPackageDeps c)
(_, incs) = partition (isInplaceCompInc c) (componentIncludes c)
- hasIdeps = not $ null ideps
+ hasIdeps' = not $ null ideps
c' = c { componentPackageDeps = deps
, componentInternalDeps = []
, componentIncludes = incs }
- in (hasIdeps,c')
+ in (hasIdeps',c')
+
+ cleanRecursiveOpts comp libbi libclbi =
+ let
+ -- libbi = libBuildInfo lib
+ liboutdir = componentOutDir lbi comp
+ (_,libclbi') = removeInplace libclbi
+ (extraIncludes,extraDeps') = recursiveIncludeDirs includeDirs (componentUnitId libclbi)
+ (_,extraDeps) = partition (isInplaceCompInc libclbi) extraDeps'
+ opts = (componentGhcOptions normal lbi libbi libclbi' liboutdir) {
+ ghcOptPackageDBs = []
+ }
+ in
+ opts { ghcOptSourcePath = ghcOptSourcePath opts <> toNubListR extraIncludes
+ , ghcOptPackages = ghcOptPackages opts <> toNubListR extraDeps }
+
(hasIdeps,clbi') = removeInplace clbi
libopts =
case (getLibraryClbi pd lbi,getExeClbi pd lbi) of
(Just (lib, libclbi),_) | hasIdeps ->
let
libbi = libBuildInfo lib
- liboutdir = componentOutDir lbi (CLib lib)
- (_,libclbi') = removeInplace libclbi
- (extraIncludes,extraDeps') = recursiveIncludeDirs includeDirs (componentUnitId libclbi)
- (_,extraDeps) = partition (isInplaceCompInc libclbi) extraDeps'
- opts = (componentGhcOptions normal lbi libbi libclbi' liboutdir) {
- ghcOptPackageDBs = []
- }
in
- opts { ghcOptSourcePath = ghcOptSourcePath opts <> toNubListR extraIncludes
- , ghcOptPackages = ghcOptPackages opts <> toNubListR extraDeps }
+ cleanRecursiveOpts (CLib lib) libbi libclbi
(_,Just (exe,execlbi)) | hasIdeps ->
let
exebi = buildInfo exe
- exeoutdir = componentOutDir lbi (CExe exe)
- (_,execlbi') = removeInplace execlbi
- (extraIncludes,extraDeps') = recursiveIncludeDirs includeDirs (componentUnitId execlbi)
- (_,extraDeps) = partition (isInplaceCompInc execlbi) extraDeps'
- opts = (componentGhcOptions normal lbi exebi execlbi' exeoutdir) {
- ghcOptPackageDBs = []
- }
in
- opts { ghcOptSourcePath = ghcOptSourcePath opts <> toNubListR extraIncludes
- , ghcOptPackages = ghcOptPackages opts <> toNubListR extraDeps }
+ cleanRecursiveOpts (CExe exe) exebi execlbi
_ -> mempty
in (clbi', libopts)
- -- in error $ "removeInplaceDeps:(clbi')=" ++ show (clbi' )
--- TODO: Is this valid? It assumes a tree, will never return for a graph
+
+#if CH_MIN_VERSION_Cabal(2,0,0)
recursiveIncludeDirs :: Map.Map UnitId ([UnitId],[FilePath], [(OpenUnitId, ModuleRenaming)])
-> UnitId -> ([FilePath],[(OpenUnitId, ModuleRenaming)])
recursiveIncludeDirs includeDirs unit = go ([],[]) [unit]
@@ -555,6 +540,7 @@ recursiveIncludeDirs includeDirs unit = go ([],[]) [unit]
go (acp,acd) (u:us) = case Map.lookup u includeDirs of
Nothing -> go (acp,acd) us
Just (us',fps,pds) -> go (acp++fps,acd++pds) (us++us')
+#endif
initialBuildStepsForAllComponents distdir pd lbi v =
initialBuildSteps distdir pd lbi v
@@ -624,6 +610,10 @@ componentEntrypoints (CLib Library {..})
= ChLibEntrypoint
(map gmModuleName exposedModules)
(map gmModuleName $ otherModules libBuildInfo)
+#if CH_MIN_VERSION_Cabal(2,0,0)
+componentEntrypoints (CFLib (ForeignLib{..}))
+ = error $ "componentEntrypoints:Need to process ForeignLib Component"
+#endif
componentEntrypoints (CExe Executable {..})
= ChExeEntrypoint modulePath (map gmModuleName $ otherModules buildInfo)
componentEntrypoints (CTest TestSuite { testInterface = TestSuiteExeV10 _ fp, ..})
@@ -646,7 +636,6 @@ isInplaceCompInc clbi (IndefFullUnitId _ _, _mmr) = False -- TODO: keep this for
#if CH_MIN_VERSION_Cabal(2,0,0)
isInplaceDep :: LocalBuildInfo -> ComponentLocalBuildInfo -> (UnitId, MungedPackageId) -> Bool
isInplaceDep lbi clbi (uid, _mpid) = uid `elem` componentInternalDeps clbi
--- isInplaceDep lbi clbi (uid, _mpid) = True
#else
isInplaceDep :: LocalBuildInfo -> (InstalledPackageId, PackageId) -> Bool
# if CH_MIN_VERSION_Cabal(1,23,0)
diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs
index f627cae..42193b9 100644
--- a/tests/GhcSession.hs
+++ b/tests/GhcSession.hs
@@ -27,9 +27,8 @@ main = do
args <- getArgs
topdir <- getCurrentDirectory
res <- mapM (setup topdir test) $ case args of
- [] -> [
- -- ("tests/exelib" , parseVer "1.10")
- ("tests/exeintlib", parseVer "2.0")
+ [] -> [ ("tests/exelib" , parseVer "1.10")
+ , ("tests/exeintlib", parseVer "2.0")
]
xs -> map (,parseVer "0") xs
@@ -50,7 +49,6 @@ setup :: FilePath -> (FilePath -> IO [Bool]) -> (FilePath, Version) -> IO [Bool]
setup topdir act (srcdir, min_cabal_ver) = do
ci_ver <- cabalInstallVersion
c_ver <- cabalInstallBuiltinCabalVersion
- putStrLn $ "(ci_ver,c_ver)=" ++ show (ci_ver,c_ver) -- AZ-DEBUG
let mreason
| (ci_ver < parseVer "1.24") =
Just $ "cabal-install-" ++ showVersion ci_ver ++ " is too old"
@@ -65,9 +63,7 @@ setup topdir act (srcdir, min_cabal_ver) = do
putStrLn $ "Skipping test '" ++ srcdir ++ "' because " ++ reason ++ "."
return []
Nothing -> do
- -- withSystemTempDirectory "cabal-helper.ghc-session.test" $ \dir -> do
- let dir = "/tmp/xxx"
- do
+ withSystemTempDirectory "cabal-helper.ghc-session.test" $ \dir -> do
setCurrentDirectory $ topdir </> srcdir
run "cabal" [ "sdist", "--output-dir", dir ]
@@ -80,9 +76,7 @@ setup topdir act (srcdir, min_cabal_ver) = do
run x xs = do
print $ x:xs
o <- readProcess x xs ""
- putStrLn "=======================output============" -- AZ-DEBUG
putStrLn o
- putStrLn "=======================output-done=======" -- AZ-DEBUG
return ()
test :: FilePath -> IO [Bool]
@@ -91,9 +85,7 @@ test dir = do
cs <- runQuery qe $ components $ (,,) <$> entrypoints <.> ghcOptions
forM cs $ \(ep, opts, cn) -> do
let sopts = intercalate " " $ map formatArg $ "ghc" : opts
- putStrLn "======================= cn ============" -- AZ-DEBUG
putStrLn $ "\n" ++ show cn ++ ": " ++ sopts
- putStrLn "======================= cn done =======" -- AZ-DEBUG
compileModule ep opts
where
formatArg x
@@ -103,8 +95,6 @@ test dir = do
compileModule :: ChEntrypoint -> [String] -> IO Bool
compileModule ep opts = do
- putStrLn $ "compileModule:ep=" ++ show ep
-
E.handle (\(ec :: ExitCode) -> print ec >> return False) $ do
defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-24 18:01:40 +0000