aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/CabalHelper/Runtime/Main.hs55
-rw-r--r--src/CabalHelper/Shared/InterfaceTypes.hs15
-rw-r--r--tests/GhcSession.hs32
3 files changed, 72 insertions, 30 deletions
diff --git a/src/CabalHelper/Runtime/Main.hs b/src/CabalHelper/Runtime/Main.hs
index 6e013a1..737b590 100644
--- a/src/CabalHelper/Runtime/Main.hs
+++ b/src/CabalHelper/Runtime/Main.hs
@@ -153,6 +153,9 @@ import Distribution.Backpack (OpenUnitId(..))
import Distribution.ModuleName
( ModuleName
)
+import Distribution.Types.ComponentId
+ ( unComponentId
+ )
import Distribution.Types.ModuleRenaming
( ModuleRenaming(..)
)
@@ -162,6 +165,7 @@ import Distribution.Types.MungedPackageId
import Distribution.Types.UnitId
( UnitId
, unDefUnitId
+ , unUnitId
)
import Distribution.Types.UnitId
( DefUnitId
@@ -379,9 +383,14 @@ main = do
"entrypoints":[] -> do
#if CH_MIN_VERSION_Cabal(2,0,0)
includeDirMap <- recursiveDepInfo lbi v distdir
+ appendFile "/tmp/cbli.txt" "\n--------------------------------------"
eps <- componentsMap lbi v distdir $ \c clbi _bi -> do
+ appendFile "/tmp/cbli.txt" ("\n" ++ show clbi)
let (_,_,seps) = recursiveIncludeDirs includeDirMap (componentUnitId clbi)
+ appendFile "/tmp/cbli.txt" ("\n" ++ show (componentEntrypoints c) )
+ appendFile "/tmp/cbli.txt" "\n-------"
return seps
+ appendFile "/tmp/cbli.txt" "\n--------------------------------------"
#else
eps <- componentsMap lbi v distdir $ \c _clbi _bi ->
return $ componentEntrypoints c
@@ -413,6 +422,9 @@ main = do
flagName' = unFlagName . flagName
+
+logm str = appendFile "/tmp/cbli.txt" str
+
-- getLibrary :: PackageDescription -> Library
-- getLibrary pd = unsafePerformIO $ do
-- lr <- newIORef (error "libraryMap: empty IORef")
@@ -458,7 +470,11 @@ componentsMap lbi _v _distdir f = do
l' <- readIORef lr
r <- f c clbi bi
- writeIORef lr $ (componentNameToCh name, r):l'
+#if CH_MIN_VERSION_Cabal(2,0,0)
+ writeIORef lr $ (componentNameToCh (ChUnitId $ unUnitId $ componentUnitId clbi) name, r):l'
+#else
+ writeIORef lr $ (componentNameToCh ChNoUnitId name, r):l'
+#endif
reverse <$> readIORef lr
@@ -586,10 +602,10 @@ recursiveIncludeDirs includeDirs unit = go ([],[],Nothing) [unit]
combineEp Nothing e = Just e
combineEp (Just ChSetupEntrypoint) e = Just e
-combineEp (Just (ChLibEntrypoint es1 os1)) (ChLibEntrypoint es2 os2) = Just (ChLibEntrypoint (es2++es1) (os2++os1))
-combineEp (Just (ChLibEntrypoint es1 os1)) (ChExeEntrypoint mi os2) = Just (ChExeEntrypoint mi (os2++es1++os1))
-combineEp (Just (ChExeEntrypoint _ os1)) (ChLibEntrypoint es2 os2) = Just (ChLibEntrypoint es2 (os2++os1))
-combineEp (Just (ChExeEntrypoint _ os1)) (ChExeEntrypoint mi os2) = Just (ChExeEntrypoint mi (os2++os1))
+combineEp (Just (ChLibEntrypoint es1 os1 ss1)) (ChLibEntrypoint es2 os2 ss2) = Just (ChLibEntrypoint (nub $ es2++es1) (nub $ os2++os1) (nub $ ss2++ss1))
+combineEp (Just (ChLibEntrypoint es1 os1 ss1)) (ChExeEntrypoint mi os2) = Just (ChExeEntrypoint mi (nub $ os2++es1++os1++ss1))
+combineEp (Just (ChExeEntrypoint _ os1)) (ChLibEntrypoint es2 os2 ss2) = Just (ChLibEntrypoint es2 (nub $ os2++os1) ss2)
+combineEp (Just (ChExeEntrypoint _ os1)) (ChExeEntrypoint mi os2) = Just (ChExeEntrypoint mi (nub $ os2++os1))
#endif
initialBuildStepsForAllComponents distdir pd lbi v =
@@ -616,15 +632,15 @@ toDataVersion = id
--fromDataVersion = id
#endif
-componentNameToCh CLibName = ChLibName
+componentNameToCh _uid CLibName = ChLibName
#if CH_MIN_VERSION_Cabal(1,25,0)
-- CPP >= 1.25
-componentNameToCh (CSubLibName n) = ChSubLibName $ unUnqualComponentName' n
-componentNameToCh (CFLibName n) = ChFLibName $ unUnqualComponentName' n
+componentNameToCh uid (CSubLibName n) = ChSubLibName (unUnqualComponentName' n) uid
+componentNameToCh uid (CFLibName n) = ChFLibName (unUnqualComponentName' n) uid
#endif
-componentNameToCh (CExeName n) = ChExeName $ unUnqualComponentName' n
-componentNameToCh (CTestName n) = ChTestName $ unUnqualComponentName' n
-componentNameToCh (CBenchName n) = ChBenchName $ unUnqualComponentName' n
+componentNameToCh uid (CExeName n) = ChExeName (unUnqualComponentName' n) uid
+componentNameToCh uid (CTestName n) = ChTestName (unUnqualComponentName' n) uid
+componentNameToCh uid (CBenchName n) = ChBenchName (unUnqualComponentName' n) uid
#if CH_MIN_VERSION_Cabal(1,25,0)
-- CPP >= 1.25
@@ -674,28 +690,35 @@ componentEntrypoints (CLib Library {..})
(map gmModuleName exposedModules)
(map gmModuleName $ otherModules libBuildInfo)
#if CH_MIN_VERSION_Cabal(2,0,0)
+ (map gmModuleName signatures)
+#else
+ [] -- no signatures prior to Cabal 2.0
+#endif
+#if CH_MIN_VERSION_Cabal(2,0,0)
componentEntrypoints (CFLib (ForeignLib{..}))
= ChLibEntrypoint
[]
(map gmModuleName $ otherModules foreignLibBuildInfo)
+ []
#endif
componentEntrypoints (CExe Executable {..})
= ChExeEntrypoint modulePath (map gmModuleName $ otherModules buildInfo)
componentEntrypoints (CTest TestSuite { testInterface = TestSuiteExeV10 _ fp, ..})
= ChExeEntrypoint fp (map gmModuleName $ otherModules testBuildInfo)
componentEntrypoints (CTest TestSuite { testInterface = TestSuiteLibV09 _ mn, ..})
- = ChLibEntrypoint [gmModuleName mn] (map gmModuleName $ otherModules testBuildInfo)
+ = ChLibEntrypoint [gmModuleName mn] (map gmModuleName $ otherModules testBuildInfo) []
componentEntrypoints (CTest TestSuite {})
- = ChLibEntrypoint [] []
+ = ChLibEntrypoint [] [] []
componentEntrypoints (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _ fp, ..})
= ChExeEntrypoint fp (map gmModuleName $ otherModules benchmarkBuildInfo)
componentEntrypoints (CBench Benchmark {})
- = ChLibEntrypoint [] []
+ = ChLibEntrypoint [] [] []
#if CH_MIN_VERSION_Cabal(2,0,0)
isInplaceCompInc :: ComponentLocalBuildInfo -> (OpenUnitId, ModuleRenaming) -> Bool
-isInplaceCompInc clbi (DefiniteUnitId uid, _mr) = unDefUnitId uid `elem` componentInternalDeps clbi
-isInplaceCompInc clbi (IndefFullUnitId _ _, _mmr) = False -- TODO: keep this for now, what in future?
+isInplaceCompInc clbi (DefiniteUnitId uid, _mr) = unDefUnitId uid `elem` componentInternalDeps clbi
+-- isInplaceCompInc clbi (IndefFullUnitId uid _, _mmr) = False
+isInplaceCompInc clbi (IndefFullUnitId uid _, _mmr) = unComponentId uid `elem` map unUnitId (componentInternalDeps clbi)
#endif
#if CH_MIN_VERSION_Cabal(2,0,0)
diff --git a/src/CabalHelper/Shared/InterfaceTypes.hs b/src/CabalHelper/Shared/InterfaceTypes.hs
index 5f4972f..bf61bb7 100644
--- a/src/CabalHelper/Shared/InterfaceTypes.hs
+++ b/src/CabalHelper/Shared/InterfaceTypes.hs
@@ -47,11 +47,15 @@ data ChResponse
data ChComponentName = ChSetupHsName
| ChLibName
- | ChSubLibName String
- | ChFLibName String
- | ChExeName String
- | ChTestName String
- | ChBenchName String
+ | ChSubLibName String ChUnitId
+ | ChFLibName String ChUnitId
+ | ChExeName String ChUnitId
+ | ChTestName String ChUnitId
+ | ChBenchName String ChUnitId
+ deriving (Eq, Ord, Read, Show, Generic)
+
+data ChUnitId = ChNoUnitId
+ | ChUnitId String
deriving (Eq, Ord, Read, Show, Generic)
newtype ChModuleName = ChModuleName String
@@ -64,6 +68,7 @@ data ChEntrypoint = ChSetupEntrypoint -- ^ Almost like 'ChExeEntrypoint' but
-- to find these files.
| ChLibEntrypoint { chExposedModules :: [ChModuleName]
, chOtherModules :: [ChModuleName]
+ , chSignatures :: [ChModuleName] -- backpack only
}
| ChExeEntrypoint { chMainIs :: FilePath
, chOtherModules :: [ChModuleName]
diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs
index 8228356..127dd8e 100644
--- a/tests/GhcSession.hs
+++ b/tests/GhcSession.hs
@@ -17,6 +17,7 @@ import System.Environment (getArgs)
import System.Exit
import System.FilePath ((</>))
import System.Directory
+import System.IO
import System.IO.Temp
import System.Process (readProcess)
@@ -30,10 +31,11 @@ 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/fliblib" , parseVer "2.0")
- , ("tests/bkpregex" , parseVer "2.0")
+ [] -> [
+ -- ("tests/exelib" , parseVer "1.10")
+ -- , ("tests/exeintlib", parseVer "2.0")
+ -- , ("tests/fliblib" , parseVer "2.0")
+ ("tests/bkpregex" , parseVer "2.0")
]
xs -> map (,parseVer "0") xs
@@ -87,11 +89,23 @@ setup topdir act (srcdir, min_cabal_ver) = do
test :: FilePath -> IO [Bool]
test dir = do
let qe = mkQueryEnv dir (dir </> "dist")
+
+ cs <- runQuery qe $ components $ (,) <$> entrypoints
+ putStrLn "\n--------------------------------eps-----------------------------"
+ forM cs $ \(ep, cn) -> do
+ putStrLn $ "\n" ++ show (ep,cn)
+ putStrLn "\n--------------------------------eps end-----------------------------"
+
cs <- runQuery qe $ components $ (,,) <$> entrypoints <.> ghcOptions
+ putStrLn "\n--------------------------------components-----------------------------"
+ forM cs $ \(ep, opts, cn) -> do
+ putStrLn $ "\n" ++ show cn ++ ": " ++ show opts
+ putStrLn "\n--------------------------------components end-------------------------"
forM cs $ \(ep, opts, cn) -> do
let opts' = "-Werror" : opts
let sopts = intercalate " " $ map formatArg $ "ghc" : opts'
putStrLn $ "\n" ++ show cn ++ ": " ++ sopts
+ hFlush stdout
compileModule ep opts'
where
formatArg x
@@ -126,9 +140,9 @@ compileModule ep opts = do
ts <- mapM (\t -> guessTarget t Nothing) $
case ep of
- ChLibEntrypoint ms ms' -> map unChModuleName $ ms ++ ms'
- ChExeEntrypoint m ms -> [m] ++ map unChModuleName ms
- ChSetupEntrypoint -> ["Setup.hs"]
+ 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
setTargets ts'
@@ -136,8 +150,8 @@ compileModule ep opts = do
#if __GLASGOW_HASKELL__ >= 706
setContext $ case ep of
- ChLibEntrypoint ms ms' ->
- map (IIModule . mkModuleName . unChModuleName) $ ms ++ ms'
+ ChLibEntrypoint ms ms' ss ->
+ map (IIModule . mkModuleName . unChModuleName) $ ms ++ ms' ++ ss
ChExeEntrypoint _ ms ->
map (IIModule . mkModuleName . unChModuleName) $ ChModuleName "Main" : ms
ChSetupEntrypoint ->
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 05:48:17 +0000