If a :reload finds syntax errors in the module graph, remove the loaded modules. (Fixes #17549)

The processing in `compiler/main/GhcMake.hs` computes the ModuleGraph. If it finds errors
in the module header or in the import specifications, then the new module graph is
incomplete and should not be used.
The code before #17549 just reported the errors and left the old ModuleGraph in place.
The new code of this MR replaces the old ModuleGraph with an empty one.

5 files changed, 40 insertions, 20 deletions

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 49017611ce..1bbf4a4929 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -45,7 +45,7 @@ module GHC (
         guessTarget,
 
         -- * Loading\/compiling the program
-        depanal,
+        depanal, depanalE,
         load, LoadHowMuch(..), InteractiveImport(..),
         SuccessFlag(..), succeeded, failed,
         defaultWarnErrLogger, WarnErrLogger,
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 2a597a205d..8bb2550d76 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -12,7 +12,7 @@
 --
 -- -----------------------------------------------------------------------------
 module GhcMake(
-        depanal, depanalPartial,
+        depanal, depanalE, depanalPartial,
         load, load', LoadHowMuch(..),
 
         downsweep,
@@ -57,7 +57,7 @@ import Exception        ( tryIO, gbracket, gfinally )
 import FastString
 import Maybes           ( expectJust )
 import Name
-import MonadUtils       ( allM, MonadIO )
+import MonadUtils       ( allM )
 import Outputable
 import Panic
 import SrcLoc
@@ -118,20 +118,37 @@ label_self thread_name = do
 -- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module.  Thus if you want
 -- changes to the 'DynFlags' to take effect you need to call this function
 -- again.
+-- In case of errors, just throw them.
 --
 depanal :: GhcMonad m =>
            [ModuleName]  -- ^ excluded modules
         -> Bool          -- ^ allow duplicate roots
         -> m ModuleGraph
 depanal excluded_mods allow_dup_roots = do
+    (errs, mod_graph) <- depanalE excluded_mods allow_dup_roots
+    if isEmptyBag errs
+      then pure mod_graph
+      else throwErrors errs
+
+-- | Perform dependency analysis like in 'depanal'.
+-- In case of errors, the errors and an empty module graph are returned.
+depanalE :: GhcMonad m =>     -- New for #17459
+            [ModuleName]      -- ^ excluded modules
+            -> Bool           -- ^ allow duplicate roots
+            -> m (ErrorMessages, ModuleGraph)
+depanalE 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
+        pure (errs, mod_graph)
+      else do
+        -- We don't have a complete module dependency graph,
+        -- The graph may be disconnected and is unusable.
+        setSession hsc_env { hsc_mod_graph = emptyMG }
+        pure (errs, emptyMG)
 
 
 -- | Perform dependency analysis like 'depanal' but return a partial module
@@ -262,16 +279,19 @@ data LoadHowMuch
 -- Calls the 'defaultWarnErrLogger' after each compiling each module, whether
 -- successful or not.
 --
--- Throw a 'SourceError' if errors are encountered before the actual
--- compilation starts (e.g., during dependency analysis).  All other errors
--- are reported using the 'defaultWarnErrLogger'.
+-- If errors are encountered during dependency analysis, the module `depanalE`
+-- returns together with the errors an empty ModuleGraph.
+-- After processing this empty ModuleGraph, the errors of depanalE are thrown.
+-- All other errors are reported using the 'defaultWarnErrLogger'.
 --
 load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
 load how_much = do
-    mod_graph <- depanal [] False
+    (errs, mod_graph) <- depanalE [] False                        -- #17459
     success <- load' how_much (Just batchMsg) mod_graph
     warnUnusedPackages
-    pure success
+    if isEmptyBag errs
+      then pure success
+      else throwErrors errs
 
 -- Note [Unused packages]
 --
@@ -2032,12 +2052,6 @@ warnUnnecessarySourceImports sccs = do
                  <+> quotes (ppr mod))
 
 
-reportImportErrors :: MonadIO m => [Either ErrorMessages b] -> m [b]
-reportImportErrors xs | null errs = return oks
-                      | otherwise = throwErrors $ unionManyBags errs
-  where (errs, oks) = partitionEithers xs
-
-
 -----------------------------------------------------------------------------
 --
 -- | Downsweep (dependency analysis)
@@ -2067,8 +2081,8 @@ downsweep :: HscEnv
 downsweep hsc_env old_summaries excl_mods allow_dup_roots
    = do
        rootSummaries <- mapM getRootSummary roots
-       rootSummariesOk <- reportImportErrors rootSummaries
-       let root_map = mkRootMap rootSummariesOk
+       let (errs, rootSummariesOk) = partitionEithers rootSummaries -- #17549
+           root_map = mkRootMap rootSummariesOk
        checkDuplicates root_map
        map0 <- loop (concatMap calcDeps rootSummariesOk) root_map
        -- if we have been passed -fno-code, we enable code generation
@@ -2084,7 +2098,9 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
              (defaultObjectTarget dflags)
              map0
            else return map0
-       return $ concat $ nodeMapElts map1
+       if null errs
+         then pure $ concat $ nodeMapElts map1
+         else pure $ map Left errs
      where
         calcDeps = msDeps
 
diff --git a/testsuite/tests/ghci/scripts/T17549.stderr b/testsuite/tests/ghci/scripts/T17549.stderr
new file mode 100644
index 0000000000..0abf6916ec
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T17549.stderr
@@ -0,0 +1,3 @@
+
+T17549.hs:1:7:
+    parse error (possibly incorrect indentation or mismatched brackets)
diff --git a/testsuite/tests/ghci/scripts/T17549.stdout b/testsuite/tests/ghci/scripts/T17549.stdout
new file mode 100644
index 0000000000..d00491fd7e
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T17549.stdout
@@ -0,0 +1 @@
+1
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 28c12e151b..e4c028ace1 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -311,4 +311,4 @@ test('T17345', normal, ghci_script, ['T17345.script'])
 test('T17384', normal, ghci_script, ['T17384.script'])
 test('T17403', normal, ghci_script, ['T17403.script'])
 test('T17431', normal, ghci_script, ['T17431.script'])
-test('T17549', expect_broken(17549), ghci_script, ['T17549.script'])
+test('T17549', normal, ghci_script, ['T17549.script'])