Merge branch 'hie-backports-8.8' of https://gitlab.haskell.org/DanielG/ghc into wip/ghc-8.8-merges

17 files changed, 792 insertions, 230 deletions

diff --git a/compiler/backpack/DriverBkp.hs b/compiler/backpack/DriverBkp.hs
index e10d6d1de1..c770eddd6e 100644
--- a/compiler/backpack/DriverBkp.hs
+++ b/compiler/backpack/DriverBkp.hs
@@ -730,7 +730,7 @@ summariseDecl _pn hsc_src lmodname@(L loc modname) Nothing
                          [] -- No exclusions
          case r of
             Nothing -> throwOneError (mkPlainErrMsg dflags loc (text "module" <+> ppr modname <+> text "was not found"))
-            Just (Left err) -> throwOneError err
+            Just (Left err) -> throwErrors err
             Just (Right summary) -> return summary
 
 -- | Up until now, GHC has assumed a single compilation target per source file.
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 5fe2362973..8ffeb5e908 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -52,7 +52,7 @@ import DynFlags
 import Config
 import Panic
 import Util
-import StringBuffer     ( hGetStringBuffer )
+import StringBuffer     ( hGetStringBuffer, hPutStringBuffer )
 import BasicTypes       ( SuccessFlag(..) )
 import Maybes           ( expectJust )
 import SrcLoc
@@ -64,6 +64,8 @@ import Hooks
 import qualified GHC.LanguageExtensions as LangExt
 import FileCleanup
 import Ar
+import Bag              ( unitBag )
+import FastString       ( mkFastString )
 
 import Exception
 import System.Directory
@@ -87,17 +89,28 @@ import Data.Time        ( UTCTime )
 -- of slurping in the OPTIONS pragmas
 
 preprocess :: HscEnv
-           -> (FilePath, Maybe Phase) -- ^ filename and starting phase
-           -> IO (DynFlags, FilePath)
-preprocess hsc_env (filename, mb_phase) =
-  ASSERT2(isJust mb_phase || isHaskellSrcFilename filename, text filename)
-  runPipeline anyHsc hsc_env (filename, fmap RealPhase mb_phase)
+           -> FilePath -- ^ input filename
+           -> Maybe InputFileBuffer
+           -- ^ optional buffer to use instead of reading the input file
+           -> Maybe Phase -- ^ starting phase
+           -> IO (Either ErrorMessages (DynFlags, FilePath))
+preprocess hsc_env input_fn mb_input_buf mb_phase =
+  handleSourceError (\err -> return (Left (srcErrorMessages err))) $
+  ghandle handler $
+  fmap Right $
+  ASSERT2(isJust mb_phase || isHaskellSrcFilename input_fn, text input_fn)
+  runPipeline anyHsc hsc_env (input_fn, mb_input_buf, fmap RealPhase mb_phase)
         Nothing
         -- We keep the processed file for the whole session to save on
         -- duplicated work in ghci.
         (Temporary TFL_GhcSession)
         Nothing{-no ModLocation-}
         []{-no foreign objects-}
+  where
+    srcspan = srcLocSpan $ mkSrcLoc (mkFastString input_fn) 1 1
+    handler (ProgramError msg) = return $ Left $ unitBag $
+        mkPlainErrMsg (hsc_dflags hsc_env) srcspan $ text msg
+    handler ex = throwGhcExceptionIO ex
 
 -- ---------------------------------------------------------------------------
 
@@ -186,6 +199,7 @@ compileOne' m_tc_result mHscMessage
             -- handled properly
             _ <- runPipeline StopLn hsc_env
                               (output_fn,
+                               Nothing,
                                Just (HscOut src_flavour
                                             mod_name HscUpdateSig))
                               (Just basename)
@@ -223,6 +237,7 @@ compileOne' m_tc_result mHscMessage
             -- We're in --make mode: finish the compilation pipeline.
             _ <- runPipeline StopLn hsc_env
                               (output_fn,
+                               Nothing,
                                Just (HscOut src_flavour mod_name (HscRecomp cgguts summary)))
                               (Just basename)
                               Persistent
@@ -313,7 +328,7 @@ compileForeign hsc_env lang stub_c = do
               LangAsm    -> As True -- allow CPP
               RawObject  -> panic "compileForeign: should be unreachable"
         (_, stub_o) <- runPipeline StopLn hsc_env
-                       (stub_c, Just (RealPhase phase))
+                       (stub_c, Nothing, Just (RealPhase phase))
                        Nothing (Temporary TFL_GhcSession)
                        Nothing{-no ModLocation-}
                        []
@@ -335,7 +350,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do
   let src = text "int" <+> ppr (mkModule (thisPackage dflags) mod_name) <+> text "= 0;"
   writeFile empty_stub (showSDoc dflags (pprCode CStyle src))
   _ <- runPipeline StopLn hsc_env
-                  (empty_stub, Nothing)
+                  (empty_stub, Nothing, Nothing)
                   (Just basename)
                   Persistent
                   (Just location)
@@ -525,9 +540,10 @@ compileFile hsc_env stop_phase (src, mb_phase) = do
         stop_phase' = case stop_phase of
                         As _ | split -> SplitAs
                         _            -> stop_phase
-
    ( _, out_file) <- runPipeline stop_phase' hsc_env
-                            (src, fmap RealPhase mb_phase) Nothing output
+                            (src, Nothing, fmap RealPhase mb_phase)
+                            Nothing
+                            output
                             Nothing{-no ModLocation-} []
    return out_file
 
@@ -560,13 +576,15 @@ doLink dflags stop_phase o_files
 runPipeline
   :: Phase                      -- ^ When to stop
   -> HscEnv                     -- ^ Compilation environment
-  -> (FilePath,Maybe PhasePlus) -- ^ Input filename (and maybe -x suffix)
+  -> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
+                                -- ^ Pipeline input file name, optional
+                                -- buffer and maybe -x suffix
   -> Maybe FilePath             -- ^ original basename (if different from ^^^)
   -> PipelineOutput             -- ^ Output filename
   -> Maybe ModLocation          -- ^ A ModLocation, if this is a Haskell module
   -> [FilePath]                 -- ^ foreign objects
   -> IO (DynFlags, FilePath)    -- ^ (final flags, output filename)
-runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
+runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase)
              mb_basename output maybe_loc foreign_os
 
     = do let
@@ -618,8 +636,22 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
                                       ++ input_fn))
              HscOut {} -> return ()
 
+         -- Write input buffer to temp file if requested
+         input_fn' <- case (start_phase, mb_input_buf) of
+             (RealPhase real_start_phase, Just input_buf) -> do
+                 let suffix = phaseInputExt real_start_phase
+                 fn <- newTempName dflags TFL_CurrentModule suffix
+                 hdl <- openBinaryFile fn WriteMode
+                 -- Add a LINE pragma so reported source locations will
+                 -- mention the real input file, not this temp file.
+                 hPutStrLn hdl $ "{-# LINE 1 \""++ input_fn ++ "\"#-}"
+                 hPutStringBuffer hdl input_buf
+                 hClose hdl
+                 return fn
+             (_, _) -> return input_fn
+
          debugTraceMsg dflags 4 (text "Running the pipeline")
-         r <- runPipeline' start_phase hsc_env env input_fn
+         r <- runPipeline' start_phase hsc_env env input_fn'
                            maybe_loc foreign_os
 
          -- If we are compiling a Haskell module, and doing
@@ -633,7 +665,7 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
                    (text "Running the pipeline again for -dynamic-too")
                let dflags' = dynamicTooMkDynamicDynFlags dflags
                hsc_env' <- newHscEnv dflags'
-               _ <- runPipeline' start_phase hsc_env' env input_fn
+               _ <- runPipeline' start_phase hsc_env' env input_fn'
                                  maybe_loc foreign_os
                return ()
          return r
@@ -1007,8 +1039,11 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
         (hspp_buf,mod_name,imps,src_imps) <- liftIO $ do
           do
             buf <- hGetStringBuffer input_fn
-            (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff)
-            return (Just buf, mod_name, imps, src_imps)
+            eimps <- getImports dflags buf input_fn (basename <.> suff)
+            case eimps of
+              Left errs -> throwErrors errs
+              Right (src_imps,imps,L _ mod_name) -> return
+                  (Just buf, mod_name, imps, src_imps)
 
   -- Take -o into account if present
   -- Very like -ohi, but we must *only* do this if we aren't linking
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index aa9f01d25a..87396b4b69 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE BangPatterns, CPP, NondecreasingIndentation, ScopedTypeVariables #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
 
 -- -----------------------------------------------------------------------------
 --
@@ -10,9 +10,11 @@
 --
 -- -----------------------------------------------------------------------------
 module GhcMake(
-        depanal,
+        depanal, depanalPartial,
         load, load', LoadHowMuch(..),
 
+        downsweep,
+
         topSortModuleGraph,
 
         ms_home_srcimps, ms_home_imps,
@@ -46,7 +48,7 @@ import TcIface          ( typecheckIface )
 import TcRnMonad        ( initIfaceCheck )
 import HscMain
 
-import Bag              ( listToBag )
+import Bag              ( unitBag, listToBag, unionManyBags, isEmptyBag )
 import BasicTypes
 import Digraph
 import Exception        ( tryIO, gbracket, gfinally )
@@ -64,7 +66,6 @@ import TcBackpack
 import Packages
 import UniqSet
 import Util
-import qualified GHC.LanguageExtensions as LangExt
 import NameEnv
 import FileCleanup
 
@@ -80,6 +81,7 @@ import Control.Concurrent.MVar
 import Control.Concurrent.QSem
 import Control.Exception
 import Control.Monad
+import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE )
 import Data.IORef
 import Data.List
 import qualified Data.List as List
@@ -119,6 +121,32 @@ depanal :: GhcMonad m =>
         -> Bool          -- ^ allow duplicate roots
         -> m ModuleGraph
 depanal excluded_mods allow_dup_roots = do
+    hsc_env <- getSession
+    (errs, mod_graph) <- depanalPartial excluded_mods allow_dup_roots
+    if isEmptyBag errs
+      then do
+        warnMissingHomeModules hsc_env mod_graph
+        setSession hsc_env { hsc_mod_graph = mod_graph }
+        return mod_graph
+      else throwErrors errs
+
+
+-- | Perform dependency analysis like 'depanal' but return a partial module
+-- graph even in the face of problems with some modules.
+--
+-- Modules which have parse errors in the module header, failing
+-- preprocessors or other issues preventing them from being summarised will
+-- simply be absent from the returned module graph.
+--
+-- Unlike 'depanal' this function will not update 'hsc_mod_graph' with the
+-- new module graph.
+depanalPartial
+    :: GhcMonad m
+    => [ModuleName]  -- ^ excluded modules
+    -> Bool          -- ^ allow duplicate roots
+    -> m (ErrorMessages, ModuleGraph)
+    -- ^ possibly empty 'Bag' of errors and a module graph.
+depanalPartial excluded_mods allow_dup_roots = do
   hsc_env <- getSession
   let
          dflags  = hsc_dflags hsc_env
@@ -138,14 +166,10 @@ depanal excluded_mods allow_dup_roots = do
 
     mod_summariesE <- liftIO $ downsweep hsc_env (mgModSummaries old_graph)
                                      excluded_mods allow_dup_roots
-    mod_summaries <- reportImportErrors mod_summariesE
-
-    let mod_graph = mkModuleGraph mod_summaries
-
-    warnMissingHomeModules hsc_env mod_graph
-
-    setSession hsc_env { hsc_mod_graph = mod_graph }
-    return mod_graph
+    let
+           (errs, mod_summaries) = partitionEithers mod_summariesE
+           mod_graph = mkModuleGraph mod_summaries
+    return (unionManyBags errs, mod_graph)
 
 -- Note [Missing home modules]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1909,14 +1933,11 @@ warnUnnecessarySourceImports sccs = do
                  <+> quotes (ppr mod))
 
 
-reportImportErrors :: MonadIO m => [Either ErrMsg b] -> m [b]
+reportImportErrors :: MonadIO m => [Either ErrorMessages b] -> m [b]
 reportImportErrors xs | null errs = return oks
-                      | otherwise = throwManyErrors errs
+                      | otherwise = throwErrors $ unionManyBags errs
   where (errs, oks) = partitionEithers xs
 
-throwManyErrors :: MonadIO m => [ErrMsg] -> m ab
-throwManyErrors errs = liftIO $ throwIO $ mkSrcErr $ listToBag errs
-
 
 -----------------------------------------------------------------------------
 --
@@ -1940,7 +1961,7 @@ downsweep :: HscEnv
           -> Bool               -- True <=> allow multiple targets to have
                                 --          the same module name; this is
                                 --          very useful for ghc -M
-          -> IO [Either ErrMsg ModSummary]
+          -> IO [Either ErrorMessages ModSummary]
                 -- The elts of [ModSummary] all have distinct
                 -- (Modules, IsBoot) identifiers, unless the Bool is true
                 -- in which case there can be repeats
@@ -1970,13 +1991,13 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
         old_summary_map :: NodeMap ModSummary
         old_summary_map = mkNodeMap old_summaries
 
-        getRootSummary :: Target -> IO (Either ErrMsg ModSummary)
+        getRootSummary :: Target -> IO (Either ErrorMessages ModSummary)
         getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)
            = do exists <- liftIO $ doesFileExist file
-                if exists
-                    then Right `fmap` summariseFile hsc_env old_summaries file mb_phase
+                if exists || isJust maybe_buf
+                    then summariseFile hsc_env old_summaries file mb_phase
                                        obj_allowed maybe_buf
-                    else return $ Left $ mkPlainErrMsg dflags noSrcSpan $
+                    else return $ Left $ unitBag $ mkPlainErrMsg dflags noSrcSpan $
                            text "can't find file:" <+> text file
         getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
            = do maybe_summary <- summariseModule hsc_env old_summary_map NotBoot
@@ -1992,7 +2013,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
         -- name, so we have to check that there aren't multiple root files
         -- defining the same module (otherwise the duplicates will be silently
         -- ignored, leading to confusing behaviour).
-        checkDuplicates :: NodeMap [Either ErrMsg ModSummary] -> IO ()
+        checkDuplicates :: NodeMap [Either ErrorMessages ModSummary] -> IO ()
         checkDuplicates root_map
            | allow_dup_roots = return ()
            | null dup_roots  = return ()
@@ -2003,11 +2024,11 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
 
         loop :: [(Located ModuleName,IsBoot)]
                         -- Work list: process these modules
-             -> NodeMap [Either ErrMsg ModSummary]
+             -> NodeMap [Either ErrorMessages ModSummary]
                         -- Visited set; the range is a list because
                         -- the roots can have the same module names
                         -- if allow_dup_roots is True
-             -> IO (NodeMap [Either ErrMsg ModSummary])
+             -> IO (NodeMap [Either ErrorMessages ModSummary])
                         -- The result is the completed NodeMap
         loop [] done = return done
         loop ((wanted_mod, is_boot) : ss) done
@@ -2036,8 +2057,8 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
 -- and .o file locations to be temporary files.
 -- See Note [-fno-code mode]
 enableCodeGenForTH :: HscTarget
-  -> NodeMap [Either ErrMsg ModSummary]
-  -> IO (NodeMap [Either ErrMsg ModSummary])
+  -> NodeMap [Either ErrorMessages ModSummary]
+  -> IO (NodeMap [Either ErrorMessages ModSummary])
 enableCodeGenForTH target nodemap =
   traverse (traverse (traverse enable_code_gen)) nodemap
   where
@@ -2102,7 +2123,7 @@ enableCodeGenForTH target nodemap =
                 new_marked_mods = Set.insert ms_mod marked_mods
             in foldl' go new_marked_mods deps
 
-mkRootMap :: [ModSummary] -> NodeMap [Either ErrMsg ModSummary]
+mkRootMap :: [ModSummary] -> NodeMap [Either ErrorMessages ModSummary]
 mkRootMap summaries = Map.insertListWith (flip (++))
                                          [ (msKey s, [Right s]) | s <- summaries ]
                                          Map.empty
@@ -2162,13 +2183,13 @@ summariseFile
         -> Maybe Phase                  -- start phase
         -> Bool                         -- object code allowed?
         -> Maybe (StringBuffer,UTCTime)
-        -> IO ModSummary
+        -> IO (Either ErrorMessages ModSummary)
 
-summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
+summariseFile hsc_env old_summaries src_fn mb_phase obj_allowed maybe_buf
         -- we can use a cached summary if one is available and the
         -- source file hasn't changed,  But we have to look up the summary
         -- by source file, rather than module name as we do in summarise.
-   | Just old_summary <- findSummaryBySourceFile old_summaries file
+   | Just old_summary <- findSummaryBySourceFile old_summaries src_fn
    = do
         let location = ms_location old_summary
             dflags = hsc_dflags hsc_env
@@ -2180,82 +2201,44 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
                 -- behaviour.
 
                 -- return the cached summary if the source didn't change
-        if ms_hs_date old_summary == src_timestamp &&
-           not (gopt Opt_ForceRecomp (hsc_dflags hsc_env))
-           then do -- update the object-file timestamp
-                  obj_timestamp <-
-                    if isObjectTarget (hscTarget (hsc_dflags hsc_env))
-                        || obj_allowed -- bug #1205
-                        then liftIO $ getObjTimestamp location NotBoot
-                        else return Nothing
-                  hi_timestamp <- maybeGetIfaceDate dflags location
-                  let hie_location = ml_hie_file location
-                  hie_timestamp <- modificationTimeIfExists hie_location
-
-                  -- We have to repopulate the Finder's cache because it
-                  -- was flushed before the downsweep.
-                  _ <- liftIO $ addHomeModuleToFinder hsc_env
-                    (moduleName (ms_mod old_summary)) (ms_location old_summary)
-
-                  return old_summary{ ms_obj_date = obj_timestamp
-                                    , ms_iface_date = hi_timestamp
-                                    , ms_hie_date = hie_timestamp }
-           else
-                new_summary src_timestamp
+        checkSummaryTimestamp
+            hsc_env dflags obj_allowed NotBoot (new_summary src_fn)
+            old_summary location src_timestamp
 
    | otherwise
    = do src_timestamp <- get_src_timestamp
-        new_summary src_timestamp
+        new_summary src_fn src_timestamp
   where
     get_src_timestamp = case maybe_buf of
                            Just (_,t) -> return t
-                           Nothing    -> liftIO $ getModificationUTCTime file
+                           Nothing    -> liftIO $ getModificationUTCTime src_fn
                         -- getModificationUTCTime may fail
 
-    new_summary src_timestamp = do
-        let dflags = hsc_dflags hsc_env
+    new_summary src_fn src_timestamp = runExceptT $ do
+        preimps@PreprocessedImports {..}
+            <- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf
 
-        let hsc_src = if isHaskellSigFilename file then HsigFile else HsSrcFile
-
-        (dflags', hspp_fn, buf)
-            <- preprocessFile hsc_env file mb_phase maybe_buf
-
-        (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
 
         -- Make a ModLocation for this file
-        location <- liftIO $ mkHomeModLocation dflags mod_name file
+        location <- liftIO $ mkHomeModLocation (hsc_dflags hsc_env) pi_mod_name src_fn
 
         -- Tell the Finder cache where it is, so that subsequent calls
         -- to findModule will find it, even if it's not on any search path
-        mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location
-
-        -- when the user asks to load a source file by name, we only
-        -- use an object file if -fobject-code is on.  See #1205.
-        obj_timestamp <-
-            if isObjectTarget (hscTarget (hsc_dflags hsc_env))
-               || obj_allowed -- bug #1205
-                then liftIO $ modificationTimeIfExists (ml_obj_file location)
-                else return Nothing
-
-        hi_timestamp <- maybeGetIfaceDate dflags location
-        hie_timestamp <- modificationTimeIfExists (ml_hie_file location)
-
-        extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name
-        required_by_imports <- implicitRequirements hsc_env the_imps
-
-        return (ModSummary { ms_mod = mod,
-                             ms_hsc_src = hsc_src,
-                             ms_location = location,
-                             ms_hspp_file = hspp_fn,
-                             ms_hspp_opts = dflags',
-                             ms_hspp_buf  = Just buf,
-                             ms_parsed_mod = Nothing,
-                             ms_srcimps = srcimps,
-                             ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports,
-                             ms_hs_date = src_timestamp,
-                             ms_iface_date = hi_timestamp,
-                             ms_hie_date = hie_timestamp,
-                             ms_obj_date = obj_timestamp })
+        mod <- liftIO $ addHomeModuleToFinder hsc_env pi_mod_name location
+
+        liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
+            { nms_src_fn = src_fn
+            , nms_src_timestamp = src_timestamp
+            , nms_is_boot = NotBoot
+            , nms_hsc_src =
+                if isHaskellSigFilename src_fn
+                   then HsigFile
+                   else HsSrcFile
+            , nms_location = location
+            , nms_mod = mod
+            , nms_obj_allowed = obj_allowed
+            , nms_preimps = preimps
+            }
 
 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
 findSummaryBySourceFile summaries file
@@ -2264,6 +2247,44 @@ findSummaryBySourceFile summaries file
         [] -> Nothing
         (x:_) -> Just x
 
+checkSummaryTimestamp
+    :: HscEnv -> DynFlags -> Bool -> IsBoot
+    -> (UTCTime -> IO (Either e ModSummary))
+    -> ModSummary -> ModLocation -> UTCTime
+    -> IO (Either e ModSummary)
+checkSummaryTimestamp
+  hsc_env dflags obj_allowed is_boot new_summary
+  old_summary location src_timestamp
+  | ms_hs_date old_summary == src_timestamp &&
+      not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) = do
+           -- update the object-file timestamp
+           obj_timestamp <-
+             if isObjectTarget (hscTarget (hsc_dflags hsc_env))
+                 || obj_allowed -- bug #1205
+                 then liftIO $ getObjTimestamp location is_boot
+                 else return Nothing
+
+           -- We have to repopulate the Finder's cache for file targets
+           -- because the file might not even be on the regular serach path
+           -- and it was likely flushed in depanal. This is not technically
+           -- needed when we're called from sumariseModule but it shouldn't
+           -- hurt.
+           _ <- addHomeModuleToFinder hsc_env
+                  (moduleName (ms_mod old_summary)) location
+
+           hi_timestamp <- maybeGetIfaceDate dflags location
+           hie_timestamp <- modificationTimeIfExists (ml_hie_file location)
+
+           return $ Right old_summary
+               { ms_obj_date = obj_timestamp
+               , ms_iface_date = hi_timestamp
+               , ms_hie_date = hie_timestamp
+               }
+
+   | otherwise =
+           -- source changed: re-summarise.
+           new_summary src_timestamp
+
 -- Summarise a module, and pick up source and timestamp.
 summariseModule
           :: HscEnv
@@ -2273,7 +2294,7 @@ summariseModule
           -> Bool               -- object code allowed?
           -> Maybe (StringBuffer, UTCTime)
           -> [ModuleName]               -- Modules to exclude
-          -> IO (Maybe (Either ErrMsg ModSummary))      -- Its new summary
+          -> IO (Maybe (Either ErrorMessages ModSummary))      -- Its new summary
 
 summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                 obj_allowed maybe_buf excl_mods
@@ -2290,11 +2311,13 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                 -- return the cached summary if it hasn't changed.  If the
                 -- file has disappeared, we need to call the Finder again.
         case maybe_buf of
-           Just (_,t) -> check_timestamp old_summary location src_fn t
+           Just (_,t) ->
+               Just <$> check_timestamp old_summary location src_fn t
            Nothing    -> do
                 m <- tryIO (getModificationUTCTime src_fn)
                 case m of
-                   Right t -> check_timestamp old_summary location src_fn t
+                   Right t ->
+                       Just <$> check_timestamp old_summary location src_fn t
                    Left e | isDoesNotExistError e -> find_it
                           | otherwise             -> ioError e
 
@@ -2302,23 +2325,11 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
   where
     dflags = hsc_dflags hsc_env
 
-    check_timestamp old_summary location src_fn src_timestamp
-        | ms_hs_date old_summary == src_timestamp &&
-          not (gopt Opt_ForceRecomp dflags) = do
-                -- update the object-file timestamp
-                obj_timestamp <-
-                    if isObjectTarget (hscTarget (hsc_dflags hsc_env))
-                       || obj_allowed -- bug #1205
-                       then getObjTimestamp location is_boot
-                       else return Nothing
-                hi_timestamp <- maybeGetIfaceDate dflags location
-                hie_timestamp <- modificationTimeIfExists (ml_hie_file location)
-                return (Just (Right old_summary{ ms_obj_date = obj_timestamp
-                                               , ms_iface_date = hi_timestamp
-                                               , ms_hie_date = hie_timestamp }))
-        | otherwise =
-                -- source changed: re-summarise.
-                new_summary location (ms_mod old_summary) src_fn src_timestamp
+    check_timestamp old_summary location src_fn =
+        checkSummaryTimestamp
+          hsc_env dflags obj_allowed is_boot
+          (new_summary location (ms_mod old_summary) src_fn)
+          old_summary location
 
     find_it = do
         found <- findImportedModule hsc_env wanted_mod Nothing
@@ -2326,7 +2337,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
              Found location mod
                 | isJust (ml_hs_file location) ->
                         -- Home package
-                         just_found location mod
+                         Just <$> just_found location mod
 
              _ -> return Nothing
                         -- Not found
@@ -2344,16 +2355,13 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                 -- It might have been deleted since the Finder last found it
         maybe_t <- modificationTimeIfExists src_fn
         case maybe_t of
-          Nothing -> return $ Just $ Left $ noHsFileErr dflags loc src_fn
+          Nothing -> return $ Left $ noHsFileErr dflags loc src_fn
           Just t  -> new_summary location' mod src_fn t
 
-
     new_summary location mod src_fn src_timestamp
-      = do
-        -- Preprocess the source file and get its imports
-        -- The dflags' contains the OPTIONS pragmas
-        (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
-        (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
+      = runExceptT $ do
+        preimps@PreprocessedImports {..}
+            <- getPreprocessedImports hsc_env src_fn Nothing maybe_buf
 
         -- NB: Despite the fact that is_boot is a top-level parameter, we
         -- don't actually know coming into this function what the HscSource
@@ -2367,97 +2375,123 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                 _ | isHaskellSigFilename src_fn -> HsigFile
                   | otherwise -> HsSrcFile
 
-        when (mod_name /= wanted_mod) $
-                throwOneError $ mkPlainErrMsg dflags' mod_loc $
+        when (pi_mod_name /= wanted_mod) $
+                throwE $ unitBag $ mkPlainErrMsg pi_local_dflags pi_mod_name_loc $
                               text "File name does not match module name:"
-                              $$ text "Saw:" <+> quotes (ppr mod_name)
+                              $$ text "Saw:" <+> quotes (ppr pi_mod_name)
                               $$ text "Expected:" <+> quotes (ppr wanted_mod)
 
-        when (hsc_src == HsigFile && isNothing (lookup mod_name (thisUnitIdInsts dflags))) $
+        when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (thisUnitIdInsts dflags))) $
             let suggested_instantiated_with =
                     hcat (punctuate comma $
                         [ ppr k <> text "=" <> ppr v
-                        | (k,v) <- ((mod_name, mkHoleModule mod_name)
+                        | (k,v) <- ((pi_mod_name, mkHoleModule pi_mod_name)
                                 : thisUnitIdInsts dflags)
                         ])
-            in throwOneError $ mkPlainErrMsg dflags' mod_loc $
-                text "Unexpected signature:" <+> quotes (ppr mod_name)
+            in throwE $ unitBag $ mkPlainErrMsg pi_local_dflags pi_mod_name_loc $
+                text "Unexpected signature:" <+> quotes (ppr pi_mod_name)
                 $$ if gopt Opt_BuildingCabalPackage dflags
-                    then parens (text "Try adding" <+> quotes (ppr mod_name)
+                    then parens (text "Try adding" <+> quotes (ppr pi_mod_name)
                             <+> text "to the"
                             <+> quotes (text "signatures")
                             <+> text "field in your Cabal file.")
                     else parens (text "Try passing -instantiated-with=\"" <>
                                  suggested_instantiated_with <> text "\"" $$
-                                text "replacing <" <> ppr mod_name <> text "> as necessary.")
-
-                -- Find the object timestamp, and return the summary
-        obj_timestamp <-
-           if isObjectTarget (hscTarget (hsc_dflags hsc_env))
-              || obj_allowed -- bug #1205
-              then getObjTimestamp location is_boot
-              else return Nothing
-
-        hi_timestamp <- maybeGetIfaceDate dflags location
-        hie_timestamp <- modificationTimeIfExists (ml_hie_file location)
-
-        extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name
-        required_by_imports <- implicitRequirements hsc_env the_imps
-
-        return (Just (Right (ModSummary { ms_mod       = mod,
-                              ms_hsc_src   = hsc_src,
-                              ms_location  = location,
-                              ms_hspp_file = hspp_fn,
-                              ms_hspp_opts = dflags',
-                              ms_hspp_buf  = Just buf,
-                              ms_parsed_mod = Nothing,
-                              ms_srcimps      = srcimps,
-                              ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports,
-                              ms_hs_date   = src_timestamp,
-                              ms_iface_date = hi_timestamp,
-                              ms_hie_date = hie_timestamp,
-                              ms_obj_date  = obj_timestamp })))
-
+                                text "replacing <" <> ppr pi_mod_name <> text "> as necessary.")
+
+        liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
+            { nms_src_fn = src_fn
+            , nms_src_timestamp = src_timestamp
+            , nms_is_boot = is_boot
+            , nms_hsc_src = hsc_src
+            , nms_location = location
+            , nms_mod = mod
+            , nms_obj_allowed = obj_allowed
+            , nms_preimps = preimps
+            }
+
+-- | Convenience named arguments for 'makeNewModSummary' only used to make
+-- code more readable, not exported.
+data MakeNewModSummary
+  = MakeNewModSummary
+      { nms_src_fn :: FilePath
+      , nms_src_timestamp :: UTCTime
+      , nms_is_boot :: IsBoot
+      , nms_hsc_src :: HscSource
+      , nms_location :: ModLocation
+      , nms_mod :: Module
+      , nms_obj_allowed :: Bool
+      , nms_preimps :: PreprocessedImports
+      }
+
+makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary
+makeNewModSummary hsc_env MakeNewModSummary{..} = do
+  let PreprocessedImports{..} = nms_preimps
+  let dflags = hsc_dflags hsc_env
+
+  -- when the user asks to load a source file by name, we only
+  -- use an object file if -fobject-code is on.  See #1205.
+  obj_timestamp <- liftIO $
+      if isObjectTarget (hscTarget dflags)
+         || nms_obj_allowed -- bug #1205
+          then getObjTimestamp nms_location nms_is_boot
+          else return Nothing
+
+  hi_timestamp <- maybeGetIfaceDate dflags nms_location
+  hie_timestamp <- modificationTimeIfExists (ml_hie_file nms_location)
+
+  extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name
+  required_by_imports <- implicitRequirements hsc_env pi_theimps
+
+  return $ ModSummary
+      { ms_mod = nms_mod
+      , ms_hsc_src = nms_hsc_src
+      , ms_location = nms_location
+      , ms_hspp_file = pi_hspp_fn
+      , ms_hspp_opts = pi_local_dflags
+      , ms_hspp_buf  = Just pi_hspp_buf
+      , ms_parsed_mod = Nothing
+      , ms_srcimps = pi_srcimps
+      , ms_textual_imps =
+          pi_theimps ++ extra_sig_imports ++ required_by_imports
+      , ms_hs_date = nms_src_timestamp
+      , ms_iface_date = hi_timestamp
+      , ms_hie_date = hie_timestamp
+      , ms_obj_date = obj_timestamp
+      }
 
 getObjTimestamp :: ModLocation -> IsBoot -> IO (Maybe UTCTime)
 getObjTimestamp location is_boot
   = if is_boot == IsBoot then return Nothing
                          else modificationTimeIfExists (ml_obj_file location)
 
-
-preprocessFile :: HscEnv
-               -> FilePath
-               -> Maybe Phase -- ^ Starting phase
-               -> Maybe (StringBuffer,UTCTime)
-               -> IO (DynFlags, FilePath, StringBuffer)
-preprocessFile hsc_env src_fn mb_phase Nothing
-  = do
-        (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
-        buf <- hGetStringBuffer hspp_fn
-        return (dflags', hspp_fn, buf)
-
-preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
-  = do
-        let dflags = hsc_dflags hsc_env
-        let local_opts = getOptions dflags buf src_fn
-
-        (dflags', leftovers, warns)
-            <- parseDynamicFilePragma dflags local_opts
-        checkProcessArgsResult dflags leftovers
-        handleFlagWarnings dflags' warns
-
-        let needs_preprocessing
-                | Just (Unlit _) <- mb_phase    = True
-                | Nothing <- mb_phase, Unlit _ <- startPhase src_fn  = True
-                  -- note: local_opts is only required if there's no Unlit phase
-                | xopt LangExt.Cpp dflags'      = True
-                | gopt Opt_Pp  dflags'          = True
-                | otherwise                     = False
-
-        when needs_preprocessing $
-           throwGhcExceptionIO (ProgramError "buffer needs preprocesing; interactive check disabled")
-
-        return (dflags', src_fn, buf)
+data PreprocessedImports
+  = PreprocessedImports
+      { pi_local_dflags :: DynFlags
+      , pi_srcimps  :: [(Maybe FastString, Located ModuleName)]
+      , pi_theimps  :: [(Maybe FastString, Located ModuleName)]
+      , pi_hspp_fn  :: FilePath
+      , pi_hspp_buf :: StringBuffer
+      , pi_mod_name_loc :: SrcSpan
+      , pi_mod_name :: ModuleName
+      }
+
+-- Preprocess the source file and get its imports
+-- The pi_local_dflags contains the OPTIONS pragmas
+getPreprocessedImports
+    :: HscEnv
+    -> FilePath
+    -> Maybe Phase
+    -> Maybe (StringBuffer, UTCTime)
+    -- ^ optional source code buffer and modification time
+    -> ExceptT ErrorMessages IO PreprocessedImports
+getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
+  (pi_local_dflags, pi_hspp_fn)
+      <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase
+  pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn
+  (pi_srcimps, pi_theimps, L pi_mod_name_loc pi_mod_name)
+      <- ExceptT $ getImports pi_local_dflags pi_hspp_buf pi_hspp_fn src_fn
+  return PreprocessedImports {..}
 
 
 -----------------------------------------------------------------------------
@@ -2469,13 +2503,13 @@ noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> ErrMsg
 noModError dflags loc wanted_mod err
   = mkPlainErrMsg dflags loc $ cannotFindModule dflags wanted_mod err
 
-noHsFileErr :: DynFlags -> SrcSpan -> String -> ErrMsg
+noHsFileErr :: DynFlags -> SrcSpan -> String -> ErrorMessages
 noHsFileErr dflags loc path
-  = mkPlainErrMsg dflags loc $ text "Can't find" <+> text path
+  = unitBag $ mkPlainErrMsg dflags loc $ text "Can't find" <+> text path
 
-moduleNotFoundErr :: DynFlags -> ModuleName -> ErrMsg
+moduleNotFoundErr :: DynFlags -> ModuleName -> ErrorMessages
 moduleNotFoundErr dflags mod
-  = mkPlainErrMsg dflags noSrcSpan $
+  = unitBag $ mkPlainErrMsg dflags noSrcSpan $
         text "module" <+> quotes (ppr mod) <+> text "cannot be found locally"
 
 multiRootsErr :: DynFlags -> [ModSummary] -> IO ()
diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs
index 3fd510bb86..b5079c184a 100644
--- a/compiler/main/HeaderInfo.hs
+++ b/compiler/main/HeaderInfo.hs
@@ -59,17 +59,19 @@ getImports :: DynFlags
                            --   reporting parse error locations.
            -> FilePath     -- ^ The original source filename (used for locations
                            --   in the function result)
-           -> IO ([(Maybe FastString, Located ModuleName)],
-                  [(Maybe FastString, Located ModuleName)],
-                  Located ModuleName)
+           -> IO (Either
+               ErrorMessages
+               ([(Maybe FastString, Located ModuleName)],
+                [(Maybe FastString, Located ModuleName)],
+                Located ModuleName))
               -- ^ The source imports, normal imports, and the module name.
 getImports dflags buf filename source_filename = do
   let loc  = mkRealSrcLoc (mkFastString filename) 1 1
   case unP parseHeader (mkPState dflags buf loc) of
     PFailed _ span err -> do
         -- assuming we're not logging warnings here as per below
-      parseError dflags span err
-    POk pst rdr_module -> do
+        return $ Left $ unitBag $ mkPlainErrMsg dflags span err
+    POk pst rdr_module -> fmap Right $ do
       let _ms@(_warns, errs) = getMessages pst dflags
       -- don't log warnings: they'll be reported when we parse the file
       -- for real.  See #2500.
@@ -136,9 +138,6 @@ mkPrelImports this_mod loc implicit_prelude import_decls
                                 ideclAs        = Nothing,
                                 ideclHiding    = Nothing  }
 
-parseError :: DynFlags -> SrcSpan -> MsgDoc -> IO a
-parseError dflags span err = throwOneError $ mkPlainErrMsg dflags span err
-
 --------------------------------------------------------------
 -- Get options
 --------------------------------------------------------------
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 674afc9f47..1c83d93b24 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -233,10 +233,6 @@ logWarningsReportErrors (warns,errs) = do
     logWarnings warns
     when (not $ isEmptyBag errs) $ throwErrors errs
 
--- | Throw some errors.
-throwErrors :: ErrorMessages -> Hsc a
-throwErrors = liftIO . throwIO . mkSrcErr
-
 -- | Deal with errors and warnings returned by a compilation step
 --
 -- In order to reduce dependencies to other parts of the compiler, functions
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index d17fa5fcef..ce97e3ae02 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -13,7 +13,7 @@ module HscTypes (
         -- * compilation state
         HscEnv(..), hscEPS,
         FinderCache, FindResult(..), InstalledFindResult(..),
-        Target(..), TargetId(..), pprTarget, pprTargetId,
+        Target(..), TargetId(..), InputFileBuffer, pprTarget, pprTargetId,
         HscStatus(..),
         IServ(..),
 
@@ -133,7 +133,7 @@ module HscTypes (
 
         -- * Compilation errors and warnings
         SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
-        throwOneError, handleSourceError,
+        throwErrors, throwOneError, handleSourceError,
         handleFlagWarnings, printOrThrowWarnings,
 
         -- * COMPLETE signature
@@ -278,6 +278,10 @@ srcErrorMessages (SourceError msgs) = msgs
 mkApiErr :: DynFlags -> SDoc -> GhcApiError
 mkApiErr dflags msg = GhcApiError (showSDoc dflags msg)
 
+-- | Throw some errors.
+throwErrors :: MonadIO io => ErrorMessages -> io a
+throwErrors = liftIO . throwIO . mkSrcErr
+
 throwOneError :: MonadIO m => ErrMsg -> m ab
 throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err
 
@@ -499,8 +503,17 @@ data Target
   = Target {
       targetId           :: TargetId, -- ^ module or filename
       targetAllowObjCode :: Bool,     -- ^ object code allowed?
-      targetContents     :: Maybe (StringBuffer,UTCTime)
-                                        -- ^ in-memory text buffer?
+      targetContents     :: Maybe (InputFileBuffer, UTCTime)
+      -- ^ Optional in-memory buffer containing the source code GHC should
+      -- use for this target instead of reading it from disk.
+      --
+      -- Since GHC version 8.10 modules which require preprocessors such as
+      -- Literate Haskell or CPP to run are also supported.
+      --
+      -- If a corresponding source file does not exist on disk this will
+      -- result in a 'SourceError' exception if @targetId = TargetModule _@
+      -- is used. However together with @targetId = TargetFile _@ GHC will
+      -- not complain about the file missing.
     }
 
 data TargetId
@@ -513,6 +526,8 @@ data TargetId
         -- should be determined from the suffix of the filename.
   deriving Eq
 
+type InputFileBuffer = StringBuffer
+
 pprTarget :: Target -> SDoc
 pprTarget (Target id obj _) =
     (if obj then char '*' else empty) <> pprTargetId id
diff --git a/compiler/utils/StringBuffer.hs b/compiler/utils/StringBuffer.hs
index 64578bffde..a9fab79e83 100644
--- a/compiler/utils/StringBuffer.hs
+++ b/compiler/utils/StringBuffer.hs
@@ -19,6 +19,7 @@ module StringBuffer
          -- * Creation\/destruction
         hGetStringBuffer,
         hGetStringBufferBlock,
+        hPutStringBuffer,
         appendStringBuffers,
         stringToStringBuffer,
 
@@ -121,6 +122,11 @@ hGetStringBufferBlock handle wanted
                    then ioError (userError $ "short read of file: "++show(r,size,size_i,handle))
                    else newUTF8StringBuffer buf ptr size
 
+hPutStringBuffer :: Handle -> StringBuffer -> IO ()
+hPutStringBuffer hdl (StringBuffer buf len cur)
+    = do withForeignPtr (plusForeignPtr buf cur) $ \ptr ->
+             hPutBuf hdl ptr len
+
 -- | Skip the byte-order mark if there is one (see #1744 and #6016),
 -- and return the new position of the handle in bytes.
 --
diff --git a/testsuite/tests/driver/T8602/T8602.stderr b/testsuite/tests/driver/T8602/T8602.stderr
index eb28842f54..4b0c4a5373 100644
--- a/testsuite/tests/driver/T8602/T8602.stderr
+++ b/testsuite/tests/driver/T8602/T8602.stderr
@@ -1,2 +1,4 @@
 A B C
-`t8602.sh' failed in phase `Haskell pre-processor'. (Exit code: 1)
+
+A.hs:1:1: error:
+    `t8602.sh' failed in phase `Haskell pre-processor'. (Exit code: 1)
diff --git a/testsuite/tests/ghc-api/downsweep/OldModLocation.hs b/testsuite/tests/ghc-api/downsweep/OldModLocation.hs
new file mode 100644
index 0000000000..a96bd42d24
--- /dev/null
+++ b/testsuite/tests/ghc-api/downsweep/OldModLocation.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE ViewPatterns #-}
+
+import GHC
+import GhcMake
+import DynFlags
+import Finder
+
+import Control.Monad.IO.Class (liftIO)
+import Data.List
+import Data.Either
+
+import System.Environment
+import System.Directory
+import System.IO
+
+main :: IO ()
+main = do
+  libdir:args <- getArgs
+
+  runGhc (Just libdir) $
+    defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
+
+    dflags0 <- getSessionDynFlags
+    (dflags1, _, _) <- parseDynamicFlags dflags0 $ map noLoc $
+        [ "-i", "-i.", "-imydir"
+        -- , "-v3"
+        ] ++ args
+    _ <- setSessionDynFlags dflags1
+
+    liftIO $ mapM_ writeMod
+      [ [ "module A where"
+        , "import B"
+        ]
+      , [ "module B where"
+        ]
+      ]
+
+    tgt <- guessTarget "A" Nothing
+    setTargets [tgt]
+    hsc_env <- getSession
+
+    liftIO $ do
+
+    _emss <- downsweep hsc_env [] [] False
+
+    flushFinderCaches hsc_env
+    createDirectoryIfMissing False "mydir"
+    renameFile "B.hs" "mydir/B.hs"
+
+    emss <- downsweep hsc_env [] [] False
+
+    -- If 'checkSummaryTimestamp' were to call 'addHomeModuleToFinder' with
+    -- (ms_location old_summary) like summariseFile used to instead of
+    -- using the 'location' parameter we'd end up using the old location of
+    -- the "B" module in this test. Make sure that doesn't happen.
+
+    hPrint stderr $ sort (map (ml_hs_file . ms_location) (rights emss))
+
+writeMod :: [String] -> IO ()
+writeMod src@(head -> stripPrefix "module " -> Just (takeWhile (/=' ') -> mod))
+  = writeFile (mod++".hs") $ unlines src
diff --git a/testsuite/tests/ghc-api/downsweep/OldModLocation.stderr b/testsuite/tests/ghc-api/downsweep/OldModLocation.stderr
new file mode 100644
index 0000000000..1bb974a936
--- /dev/null
+++ b/testsuite/tests/ghc-api/downsweep/OldModLocation.stderr
@@ -0,0 +1 @@
+[Just "A.hs",Just "mydir/B.hs"]
diff --git a/testsuite/tests/ghc-api/downsweep/PartialDownsweep.darwin.stderr b/testsuite/tests/ghc-api/downsweep/PartialDownsweep.darwin.stderr
new file mode 100644
index 0000000000..c9cd0f216d
--- /dev/null
+++ b/testsuite/tests/ghc-api/downsweep/PartialDownsweep.darwin.stderr
@@ -0,0 +1,16 @@
+== Parse error in export list
+== Parse error in export list with bypass module
+== Parse error in import list
+== CPP preprocessor error
+
+B.hs:2:2:  #elif without #if
+     #elif <- cpp error here
+ ^
+1 error generated.
+== CPP preprocessor error with bypass
+
+B.hs:2:2:  #elif without #if
+     #elif <- cpp error here
+ ^
+1 error generated.
+== Import error
diff --git a/testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs b/testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs
new file mode 100644
index 0000000000..335963be4e
--- /dev/null
+++ b/testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs
@@ -0,0 +1,179 @@
+{-# LANGUAGE ScopedTypeVariables, ViewPatterns #-}
+
+-- | This test checks if 'downsweep can return partial results when vaious
+-- kinds of parse errors occur in modules.
+
+import GHC
+import GhcMake
+import DynFlags
+import Outputable
+import Exception (ExceptionMonad, ghandle)
+import Bag
+
+import Control.Monad
+import Control.Monad.IO.Class (liftIO)
+import Control.Exception
+import Data.IORef
+import Data.List
+import Data.Either
+
+import System.Environment
+import System.Exit
+import System.IO
+import System.IO.Unsafe (unsafePerformIO)
+
+any_failed :: IORef Bool
+any_failed = unsafePerformIO $ newIORef False
+{-# NOINLINE any_failed #-}
+
+it :: ExceptionMonad m => [Char] -> m Bool -> m ()
+it msg act =
+    ghandle (\(_ex :: AssertionFailed) -> dofail) $
+    ghandle (\(_ex :: ExitCode) -> dofail) $ do
+    res <- act
+    case res of
+      False -> dofail
+      True -> return ()
+  where
+   dofail = do
+     liftIO $ hPutStrLn stderr $ "FAILED: " ++ msg
+     liftIO $ writeIORef any_failed True
+
+main :: IO ()
+main = do
+  libdir:args <- getArgs
+
+  runGhc (Just libdir) $ do
+    dflags0 <- getSessionDynFlags
+    (dflags1, _, _) <- parseDynamicFlags dflags0 $ map noLoc $
+        [ "-fno-diagnostics-show-caret"
+        -- , "-v3"
+        ] ++ args
+    _ <- setSessionDynFlags dflags1
+
+    go "Parse error in export list"
+        [ [ "module A where"
+          , "import B"
+          ]
+        , [ "module B !parse_error where"
+          --  ^ this used to cause getImports to throw an exception instead
+          --  of having downsweep return an error for just this module
+          , "import C"
+          ]
+        , [ "module C where"
+          ]
+        ]
+       (\mss -> return $
+         sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A"]
+       )
+
+    go "Parse error in export list with bypass module"
+        [ [ "module A where"
+          , "import B"
+          , "import C"
+          ]
+        , [ "module B !parse_error where"
+          , "import D"
+          ]
+        , [ "module C where"
+          , "import D"
+          ]
+        , [ "module D where"
+          ]
+        ]
+       (\mss -> return $
+           sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A", "C", "D"]
+       )
+    go "Parse error in import list"
+        [ [ "module A where"
+          , "import B"
+          ]
+        , [ "module B where"
+          , "!parse_error"
+          --  ^ this is silently ignored, getImports assumes the import
+          -- list is just empty. This smells like a parser bug to me but
+          -- I'm still documenting this behaviour here.
+          , "import C"
+          ]
+        , [ "module C where"
+          ]
+        ]
+       (\mss -> return $
+         sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A", "B"]
+       )
+
+    go "CPP preprocessor error"
+        [ [ "module A where"
+          , "import B"
+          ]
+        , [ "{-# LANGUAGE CPP #-}"
+          , "#elif <- cpp error here"
+          , "module B where"
+          , "import C"
+          ]
+        , [ "module C where"
+          ]
+        ]
+       (\mss -> return $
+         sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A"]
+       )
+
+    go "CPP preprocessor error with bypass"
+        [ [ "module A where"
+          , "import B"
+          , "import C"
+          ]
+        , [ "{-# LANGUAGE CPP #-}"
+          , "#elif <- cpp error here"
+          , "module B where"
+          , "import C"
+          ]
+        , [ "module C where"
+          ]
+        ]
+       (\mss -> return $
+         sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A", "C"]
+       )
+
+    go "Import error"
+        [ [ "module A where"
+          , "import B"
+          , "import DoesNotExist_FooBarBaz"
+          ]
+        , [ "module B where"
+          ]
+        ]
+       (\mss -> return $
+           sort (map (moduleNameString . moduleName . ms_mod) mss) == ["A", "B"]
+       )
+
+  errored <- readIORef any_failed
+  when errored $ exitFailure
+  return ()
+
+
+go :: String -> [[String]] -> ([ModSummary] -> Ghc Bool) -> Ghc ()
+go label mods cnd =
+  defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
+    liftIO $ hPutStrLn stderr $ "== " ++ label
+
+    liftIO $ mapM_ writeMod mods
+
+    tgt <- guessTarget "A" Nothing
+
+    setTargets [tgt]
+
+    hsc_env <- getSession
+    emss <- liftIO $ downsweep hsc_env [] [] False
+    -- liftIO $ hPutStrLn stderr $ showSDocUnsafe $ ppr $ rights emss
+    -- liftIO $ hPrint stderr $ bagToList $ unionManyBags $ lefts emss
+
+    it label $ cnd (rights emss)
+
+
+writeMod :: [String] -> IO ()
+writeMod src =
+    writeFile (mod++".hs") $ unlines src
+  where
+    Just modline = find ("module" `isPrefixOf`) src
+    Just (takeWhile (/=' ') -> mod) = stripPrefix "module " modline
diff --git a/testsuite/tests/ghc-api/downsweep/PartialDownsweep.stderr b/testsuite/tests/ghc-api/downsweep/PartialDownsweep.stderr
new file mode 100644
index 0000000000..14c1b6c19a
--- /dev/null
+++ b/testsuite/tests/ghc-api/downsweep/PartialDownsweep.stderr
@@ -0,0 +1,16 @@
+== Parse error in export list
+== Parse error in export list with bypass module
+== Parse error in import list
+== CPP preprocessor error
+
+B.hs:2:0: error:
+     error: #elif without #if
+     #elif <- cpp error here
+     
+== CPP preprocessor error with bypass
+
+B.hs:2:0: error:
+     error: #elif without #if
+     #elif <- cpp error here
+     
+== Import error
diff --git a/testsuite/tests/ghc-api/downsweep/all.T b/testsuite/tests/ghc-api/downsweep/all.T
new file mode 100644
index 0000000000..8ca54b0bc6
--- /dev/null
+++ b/testsuite/tests/ghc-api/downsweep/all.T
@@ -0,0 +1,12 @@
+test('PartialDownsweep',
+     [ extra_run_opts('"' + config.libdir + '"')
+     , when(opsys('darwin'), skip) # use_specs doesn't exist on this branch yet
+     ],
+     compile_and_run,
+     ['-package ghc'])
+
+test('OldModLocation',
+     [ extra_run_opts('"' + config.libdir + '"')
+     ],
+     compile_and_run,
+     ['-package ghc'])
diff --git a/testsuite/tests/ghc-api/target-contents/TargetContents.hs b/testsuite/tests/ghc-api/target-contents/TargetContents.hs
new file mode 100644
index 0000000000..eaa30697f8
--- /dev/null
+++ b/testsuite/tests/ghc-api/target-contents/TargetContents.hs
@@ -0,0 +1,149 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Main where
+
+import DynFlags
+import GHC
+
+import Control.Monad
+import Control.Monad.IO.Class (liftIO)
+import Data.List
+import Data.Maybe
+import Data.Time.Calendar
+import Data.Time.Clock
+import Exception
+import HeaderInfo
+import HscTypes
+import Outputable
+import StringBuffer
+import System.Directory
+import System.Environment
+import System.Process
+import System.IO
+import Text.Printf
+
+main :: IO ()
+main = do
+  libdir:args <- getArgs
+  createDirectoryIfMissing False "outdir"
+  runGhc (Just libdir) $ do
+    dflags0 <- getSessionDynFlags
+    (dflags1, xs, warn) <- parseDynamicFlags dflags0 $ map noLoc $
+        [ "-outputdir", "./outdir"
+        , "-fno-diagnostics-show-caret"
+        ] ++ args
+    _ <- setSessionDynFlags dflags1
+
+    -- This test fails on purpose to check if the error message mentions
+    -- the source file and not the intermediary preprocessor input file
+    -- even when no preprocessor is in use. Just a sanity check.
+    go "Error" ["A"]
+    --  ^        ^-- targets
+    --  ^-- test name
+      [("A"           -- this module's name
+       , ""           -- pragmas
+       , []           -- imports/non exported decls
+       , [("x", "z")] -- exported decls
+       , OnDisk       -- write this module to disk?
+       )
+      ]
+
+    forM_ [OnDisk, InMemory] $ \sync ->
+      -- This one fails unless CPP actually preprocessed the source
+      go ("CPP_" ++ ppSync sync) ["A"]
+        [( "A"
+         , "{-# LANGUAGE CPP #-}"
+         , ["#define y 1"]
+         , [("x", "y")]
+         , sync
+         )
+        ]
+
+    -- These check if on-disk modules can import in-memory targets and
+    -- vice-verca.
+    forM_ (words "DD MM DM MD") $ \sync@[a_sync, b_sync] -> do
+      dep <- return $ \y ->
+         [( "A"
+         , "{-# LANGUAGE CPP #-}"
+         , ["import B"]
+         , [("x", "y")]
+         , readSync a_sync
+         ),
+         ( "B"
+         , "{-# LANGUAGE CPP #-}"
+         , []
+         , [("y", y)]
+         , readSync b_sync
+         )
+        ]
+      go ("Dep_" ++ sync ++ "_AB")       ["A", "B"] (dep "()")
+
+      -- This checks if error messages are correctly referring to the real
+      -- source file and not the temp preprocessor input file.
+      go ("Dep_Error_" ++ sync ++ "_AB") ["A", "B"] (dep "z")
+
+      -- Try with only one target, this is expected to fail with a module
+      -- not found error where module B is not OnDisk.
+      go ("Dep_Error_" ++ sync ++ "_A")  ["A"]      (dep "z")
+
+    return ()
+
+data Sync
+    = OnDisk   -- | Write generated module to disk
+    | InMemory -- | Only fill in targetContents.
+
+ppSync OnDisk   = "D"
+ppSync InMemory = "M"
+
+readSync 'D' = OnDisk
+readSync 'M' = InMemory
+
+go label targets mods = do
+    liftIO $ createDirectoryIfMissing False "./outdir"
+    setTargets []; _ <- load LoadAllTargets
+
+    liftIO $ hPutStrLn stderr $ "== " ++ label
+    t <- liftIO getCurrentTime
+    setTargets =<< catMaybes <$> mapM (mkTarget t) mods
+    ex <- gtry $ load LoadAllTargets
+    case ex of
+      Left ex -> liftIO $ hPutStrLn stderr $ show (ex :: SourceError)
+      Right _ -> return ()
+
+    mapM_ (liftIO . cleanup) mods
+    liftIO $ removeDirectoryRecursive "./outdir"
+
+  where
+    mkTarget t mod@(name,_,_,_,sync) = do
+      src <- liftIO $ genMod mod
+      return $ if not (name `elem` targets)
+         then Nothing
+         else Just $ Target
+           { targetId = TargetFile (name++".hs") Nothing
+           , targetAllowObjCode = False
+           , targetContents =
+               case sync of
+                 OnDisk -> Nothing
+                 InMemory ->
+                   Just ( stringToStringBuffer src
+                        , t
+                        )
+           }
+
+genMod :: (String, String, [String], [(String, String)], Sync) -> IO String
+genMod (mod, pragmas, internal, binders, sync) = do
+    case sync of
+      OnDisk   -> writeFile (mod++".hs") src
+      InMemory -> return ()
+    return src
+  where
+    exports = intercalate ", " $ map fst binders
+    decls = map (\(b,v) -> b ++ " = " ++ v) binders
+    src = unlines $
+      [ pragmas
+      , "module " ++ mod ++ " ("++ exports ++") where"
+      ] ++ internal ++ decls
+
+cleanup :: (String, String, [String], [(String, String)], Sync) -> IO ()
+cleanup (mod,_,_,_,OnDisk) = removeFile (mod++".hs")
+cleanup _ = return ()
diff --git a/testsuite/tests/ghc-api/target-contents/TargetContents.stderr b/testsuite/tests/ghc-api/target-contents/TargetContents.stderr
new file mode 100644
index 0000000000..2743f5135e
--- /dev/null
+++ b/testsuite/tests/ghc-api/target-contents/TargetContents.stderr
@@ -0,0 +1,37 @@
+== Error
+
+A.hs:3:5: error: Variable not in scope: z
+== CPP_D
+== CPP_M
+== Dep_DD_AB
+== Dep_Error_DD_AB
+
+B.hs:3:5: error: Variable not in scope: z
+== Dep_Error_DD_A
+
+B.hs:3:5: error: Variable not in scope: z
+== Dep_MM_AB
+== Dep_Error_MM_AB
+
+B.hs:3:5: error: Variable not in scope: z
+== Dep_Error_MM_A
+
+A.hs:3:1: error:
+    Could not find module ‘B’
+    Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+== Dep_DM_AB
+== Dep_Error_DM_AB
+
+B.hs:3:5: error: Variable not in scope: z
+== Dep_Error_DM_A
+
+A.hs:3:1: error:
+    Could not find module ‘B’
+    Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+== Dep_MD_AB
+== Dep_Error_MD_AB
+
+B.hs:3:5: error: Variable not in scope: z
+== Dep_Error_MD_A
+
+B.hs:3:5: error: Variable not in scope: z
diff --git a/testsuite/tests/ghc-api/target-contents/all.T b/testsuite/tests/ghc-api/target-contents/all.T
new file mode 100644
index 0000000000..94cbfce9f0
--- /dev/null
+++ b/testsuite/tests/ghc-api/target-contents/all.T
@@ -0,0 +1,4 @@
+test('TargetContents',
+     [extra_run_opts('"' + config.libdir + '"')]
+     , compile_and_run,
+     ['-package ghc'])