aboutsummaryrefslogtreecommitdiff
path: root/tests/GhcSession.hs
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2017-12-14 11:32:14 +0200
committerDaniel Gröber <dxld@darkboxed.org>2018-01-18 14:10:26 +0100
commitc76893a035c37c949cca9c09f10ccea59402cf55 (patch)
treed3971b5d14927bc462ca29d1929b0c2b70688ab0 /tests/GhcSession.hs
parentf40e568f2be06b9254b8b5a956319c6eafd13997 (diff)
Progress on when to build and when not
Diffstat (limited to 'tests/GhcSession.hs')
-rw-r--r--tests/GhcSession.hs65
1 files changed, 37 insertions, 28 deletions
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