diff options
author | Roland Senn <rsx@bluewin.ch> | 2019-12-17 18:42:05 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-02-18 20:14:42 -0500 |
commit | b4a8ce525fce56eca18358820c0ec35fec8982de (patch) | |
tree | 849fcd89485abac806250061d37d0fbe8f5f7658 | |
parent | ee1e5342f612c8b06ac910cd698558ade7a1a887 (diff) | |
download | haskell-b4a8ce525fce56eca18358820c0ec35fec8982de.tar.gz |
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.
-rw-r--r-- | compiler/main/GHC.hs | 2 | ||||
-rw-r--r-- | compiler/main/GhcMake.hs | 52 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T17549.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T17549.stdout | 1 | ||||
-rwxr-xr-x | testsuite/tests/ghci/scripts/all.T | 2 |
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']) |