diff options
| -rw-r--r-- | tests/GhcSession.hs | 60 |
1 files changed, 30 insertions, 30 deletions
diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs index 772869b..8ed76be 100644 --- a/tests/GhcSession.hs +++ b/tests/GhcSession.hs @@ -101,50 +101,50 @@ compileModule ep opts = do E.handle (\(ec :: ExitCode) -> print ec >> return False) $ do #if __GLASGOW_HASKELL__ <= 704 - defaultErrorHandler defaultLogAction $ do + defaultErrorHandler defaultLogAction $ do #else - defaultErrorHandler defaultFatalMessager defaultFlushOut $ do + defaultErrorHandler defaultFatalMessager defaultFlushOut $ do #endif - runGhc (Just libdir) $ do + runGhc (Just libdir) $ do - dflags0 <- getSessionDynFlags - let dflags1 = dflags0 { - ghcMode = CompManager - , ghcLink = LinkInMemory - , hscTarget = HscInterpreted - , optLevel = 0 - } + dflags0 <- getSessionDynFlags + let dflags1 = dflags0 { + ghcMode = CompManager + , ghcLink = LinkInMemory + , hscTarget = HscInterpreted + , optLevel = 0 + } - (dflags2, _, _) <- parseDynamicFlags dflags1 (map noLoc opts) - _ <- setSessionDynFlags dflags2 + (dflags2, _, _) <- parseDynamicFlags dflags1 (map noLoc opts) + _ <- setSessionDynFlags dflags2 - 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"] - let ts' = map (\t -> t { targetAllowObjCode = False }) ts + 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"] + let ts' = map (\t -> t { targetAllowObjCode = False }) ts - setTargets ts' - _ <- load LoadAllTargets + setTargets ts' + _ <- load LoadAllTargets #if __GLASGOW_HASKELL__ >= 706 - setContext $ case ep of - ChLibEntrypoint ms ms' -> - map (IIModule . mkModuleName . unChModuleName) $ ms ++ ms' - ChExeEntrypoint _ ms -> - map (IIModule . mkModuleName . unChModuleName) $ ChModuleName "Main" : ms - ChSetupEntrypoint -> - map (IIModule . mkModuleName) ["Main"] + setContext $ case ep of + ChLibEntrypoint ms ms' -> + map (IIModule . mkModuleName . unChModuleName) $ ms ++ ms' + ChExeEntrypoint _ ms -> + map (IIModule . mkModuleName . unChModuleName) $ ChModuleName "Main" : ms + ChSetupEntrypoint -> + map (IIModule . mkModuleName) ["Main"] #endif #if __GLASGOW_HASKELL__ <= 706 - GhcMonad.liftIO $ print ExitSuccess + GhcMonad.liftIO $ print ExitSuccess #else - liftIO $ print ExitSuccess + liftIO $ print ExitSuccess #endif - return True + return True unChModuleName :: ChModuleName -> String unChModuleName (ChModuleName mn) = mn |