summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlfredo Di Napoli <alfredo@well-typed.com>2021-04-13 10:26:42 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-05-05 05:43:14 -0400
commit101d25fce311237b82580745c321f70e62755719 (patch)
treeed415411f552d65b3fa42a407199f555bf2a302b
parent958c6fbdc7ba76313f6f6d110f5a0ee2474d26b6 (diff)
downloadhaskell-101d25fce311237b82580745c321f70e62755719.tar.gz
Add some DriverMessage type constructors
This commit expands the DriverMessage type with new type constructors, making the number of diagnostics GHC can emit richer. In particular: * Add DriverMissingHomeModules message * Add DriverUnusedPackage message * Add DriverUnnecessarySourceImports message This commit adds the `DriverUnnecessarySourceImports` message and fixes a small bug in its reporting: inside `warnUnnecessarySourceImports` we were checking for `Opt_WarnUnusedSourceImports` to be set, but we were emitting the diagnostic with `WarningWithoutFlag`. This also adjusts the T10637 test to reflect that. * Add DriverDuplicatedModuleDeclaration message * Add DriverModuleNotFound message * Add DriverFileModuleNameMismatch message * Add DriverUnexpectedSignature message * Add DriverFileNotFound message * Add DriverStaticPointersNotSupported message * Add DriverBackpackModuleNotFound message
-rw-r--r--compiler/GHC.hs7
-rw-r--r--compiler/GHC/Driver/Backpack.hs5
-rw-r--r--compiler/GHC/Driver/Errors/Ppr.hs120
-rw-r--r--compiler/GHC/Driver/Errors/Types.hs139
-rw-r--r--compiler/GHC/Driver/Make.hs93
-rw-r--r--compiler/GHC/Iface/Errors.hs7
-rw-r--r--compiler/GHC/Utils/Error.hs3
-rw-r--r--testsuite/tests/warnings/should_compile/T10637/T10637.stderr2
8 files changed, 270 insertions, 106 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 2a75c2b840..9f64e5b02c 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -310,7 +310,6 @@ import GHC.Driver.Errors
import GHC.Driver.Errors.Types
import GHC.Driver.CmdLine
import GHC.Driver.Session
-import qualified GHC.Driver.Session as Session
import GHC.Driver.Backend
import GHC.Driver.Config
import GHC.Driver.Main
@@ -913,10 +912,8 @@ checkNewInteractiveDynFlags logger dflags0 = do
-- the REPL. See #12356.
if xopt LangExt.StaticPointers dflags0
then do liftIO $ printOrThrowDiagnostics logger dflags0 $ singleMessage
- $ mkPlainMsgEnvelope dflags0 interactiveSrcSpan
- $ GhcDriverMessage $ DriverUnknownMessage
- $ mkPlainDiagnostic Session.WarningWithoutFlag
- $ text "StaticPointers is not supported in GHCi interactive expressions."
+ $ fmap GhcDriverMessage
+ $ mkPlainMsgEnvelope dflags0 interactiveSrcSpan DriverStaticPointersNotSupported
return $ xopt_unset dflags0 LangExt.StaticPointers
else return dflags0
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 30289129c4..e0e5b183ab 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -809,9 +809,8 @@ summariseDecl _pn hsc_src lmodname@(L loc modname) Nothing
Nothing -- GHC API buffer support not supported
[] -- No exclusions
case r of
- Nothing -> throwOneError $ mkPlainErrorMsgEnvelope loc $
- GhcDriverMessage $ DriverUnknownMessage $ mkPlainError $
- (text "module" <+> ppr modname <+> text "was not found")
+ Nothing -> throwOneError $ fmap GhcDriverMessage
+ $ mkPlainErrorMsgEnvelope loc (DriverBackpackModuleNotFound modname)
Just (Left err) -> throwErrors (fmap GhcDriverMessage err)
Just (Right summary) -> return summary
diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs
index 06ebe0be96..74c3d4bf21 100644
--- a/compiler/GHC/Driver/Errors/Ppr.hs
+++ b/compiler/GHC/Driver/Errors/Ppr.hs
@@ -5,11 +5,26 @@ module GHC.Driver.Errors.Ppr where
import GHC.Prelude
-import GHC.Types.Error
import GHC.Driver.Errors.Types
-import GHC.Parser.Errors.Ppr
-import GHC.Tc.Errors.Ppr ()
+import GHC.Driver.Flags
+import GHC.Driver.Session
import GHC.HsToCore.Errors.Ppr ()
+import GHC.Parser.Errors.Ppr (pprPsError)
+import GHC.Tc.Errors.Ppr ()
+import GHC.Types.Error
+import GHC.Unit.Types
+import GHC.Utils.Outputable
+import GHC.Unit.Module
+
+--
+-- Suggestions
+--
+
+-- | Suggests a list of 'InstantiationSuggestion' for the '.hsig' file to the user.
+suggestInstantiatedWith :: ModuleName -> GenInstantiations UnitId -> [InstantiationSuggestion]
+suggestInstantiatedWith pi_mod_name insts =
+ [ InstantiationSuggestion k v | (k,v) <- ((pi_mod_name, mkHoleModule pi_mod_name) : insts) ]
+
instance Diagnostic GhcMessage where
diagnosticMessage = \case
@@ -37,9 +52,98 @@ instance Diagnostic GhcMessage where
-> diagnosticReason m
instance Diagnostic DriverMessage where
- diagnosticMessage (DriverUnknownMessage m) = diagnosticMessage m
- diagnosticMessage (DriverPsHeaderMessage desc hints)
- = mkSimpleDecorated $ pprPsError desc hints
+ diagnosticMessage = \case
+ DriverUnknownMessage m
+ -> diagnosticMessage m
+ DriverPsHeaderMessage desc hints
+ -> mkSimpleDecorated $ pprPsError desc hints
+ DriverMissingHomeModules missing buildingCabalPackage
+ -> let msg | buildingCabalPackage == YesBuildingCabalPackage
+ = hang
+ (text "These modules are needed for compilation but not listed in your .cabal file's other-modules: ")
+ 4
+ (sep (map ppr missing))
+ | otherwise
+ =
+ hang
+ (text "Modules are not listed in command line but needed for compilation: ")
+ 4
+ (sep (map ppr missing))
+ in mkSimpleDecorated msg
+ DriverUnusedPackages unusedArgs
+ -> let msg = vcat [ text "The following packages were specified" <+>
+ text "via -package or -package-id flags,"
+ , text "but were not needed for compilation:"
+ , nest 2 (vcat (map (withDash . pprUnusedArg) unusedArgs))
+ ]
+ in mkSimpleDecorated msg
+ where
+ withDash :: SDoc -> SDoc
+ withDash = (<+>) (text "-")
+
+ pprUnusedArg :: PackageArg -> SDoc
+ pprUnusedArg (PackageArg str) = text str
+ pprUnusedArg (UnitIdArg uid) = ppr uid
+ DriverUnnecessarySourceImports mod
+ -> mkSimpleDecorated (text "{-# SOURCE #-} unnecessary in import of " <+> quotes (ppr mod))
+ DriverDuplicatedModuleDeclaration mod files
+ -> mkSimpleDecorated $
+ text "module" <+> quotes (ppr mod) <+>
+ text "is defined in multiple files:" <+>
+ sep (map text files)
+ DriverModuleNotFound mod
+ -> mkSimpleDecorated (text "module" <+> quotes (ppr mod) <+> text "cannot be found locally")
+ DriverFileModuleNameMismatch actual expected
+ -> mkSimpleDecorated $
+ text "File name does not match module name:"
+ $$ text "Saw :" <+> quotes (ppr actual)
+ $$ text "Expected:" <+> quotes (ppr expected)
- diagnosticReason (DriverUnknownMessage m) = diagnosticReason m
- diagnosticReason (DriverPsHeaderMessage {}) = ErrorWithoutFlag
+ DriverUnexpectedSignature pi_mod_name buildingCabalPackage suggestions
+ -> let suggested_instantiated_with =
+ hcat (punctuate comma $
+ [ ppr k <> text "=" <> ppr v
+ | InstantiationSuggestion k v <- suggestions
+ ])
+ msg = text "Unexpected signature:" <+> quotes (ppr pi_mod_name)
+ $$ if buildingCabalPackage == YesBuildingCabalPackage
+ 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 pi_mod_name <> text "> as necessary.")
+ in mkSimpleDecorated msg
+ DriverFileNotFound hsFilePath
+ -> mkSimpleDecorated (text "Can't find" <+> text hsFilePath)
+ DriverStaticPointersNotSupported
+ -> mkSimpleDecorated (text "StaticPointers is not supported in GHCi interactive expressions.")
+ DriverBackpackModuleNotFound modname
+ -> mkSimpleDecorated (text "module" <+> ppr modname <+> text "was not found")
+
+ diagnosticReason = \case
+ DriverUnknownMessage m
+ -> diagnosticReason m
+ DriverPsHeaderMessage {}
+ -> ErrorWithoutFlag
+ DriverMissingHomeModules{}
+ -> WarningWithFlag Opt_WarnMissingHomeModules
+ DriverUnusedPackages{}
+ -> WarningWithFlag Opt_WarnUnusedPackages
+ DriverUnnecessarySourceImports{}
+ -> WarningWithFlag Opt_WarnUnusedImports
+ DriverDuplicatedModuleDeclaration{}
+ -> ErrorWithoutFlag
+ DriverModuleNotFound{}
+ -> ErrorWithoutFlag
+ DriverFileModuleNameMismatch{}
+ -> ErrorWithoutFlag
+ DriverUnexpectedSignature{}
+ -> ErrorWithoutFlag
+ DriverFileNotFound{}
+ -> ErrorWithoutFlag
+ DriverStaticPointersNotSupported
+ -> WarningWithoutFlag
+ DriverBackpackModuleNotFound{}
+ -> ErrorWithoutFlag
diff --git a/compiler/GHC/Driver/Errors/Types.hs b/compiler/GHC/Driver/Errors/Types.hs
index 017852fcbb..6f1684d789 100644
--- a/compiler/GHC/Driver/Errors/Types.hs
+++ b/compiler/GHC/Driver/Errors/Types.hs
@@ -3,6 +3,8 @@
module GHC.Driver.Errors.Types (
GhcMessage(..)
, DriverMessage(..), DriverMessages
+ , BuildingCabalPackage(..)
+ , InstantiationSuggestion(..)
, WarningMessages
, ErrorMessages
, WarnMsg
@@ -12,18 +14,22 @@ module GHC.Driver.Errors.Types (
, hoistTcRnMessage
, hoistDsMessage
, foldPsMessages
+ , checkBuildingCabalPackage
) where
import GHC.Prelude
+import Data.Bifunctor
import Data.Typeable
+
+import GHC.Driver.Session
import GHC.Types.Error
+import GHC.Unit.Module
import GHC.Parser.Errors ( PsErrorDesc, PsHint )
import GHC.Parser.Errors.Types ( PsMessage )
import GHC.Tc.Errors.Types ( TcRnMessage )
import GHC.HsToCore.Errors.Types ( DsMessage )
-import Data.Bifunctor
-- | A collection of warning messages.
-- /INVARIANT/: Each 'GhcMessage' in the collection should have 'SevWarning' severity.
@@ -105,16 +111,129 @@ hoistTcRnMessage = fmap (first (fmap GhcTcRnMessage))
hoistDsMessage :: Monad m => m (Messages DsMessage, a) -> m (Messages GhcMessage, a)
hoistDsMessage = fmap (first (fmap GhcDsMessage))
+-- | A collection of driver messages
+type DriverMessages = Messages DriverMessage
+
-- | A message from the driver.
-data DriverMessage
- = DriverUnknownMessage !DiagnosticMessage
- -- ^ Simply rewraps a generic 'DiagnosticMessage'. More
- -- constructors will be added in the future (#18516).
- | DriverPsHeaderMessage !PsErrorDesc ![PsHint]
- -- ^ A parse error in parsing a Haskell file header during dependency
+data DriverMessage where
+ -- | Simply wraps a generic 'DiagnosticMessage'.
+ DriverUnknownMessage :: (Diagnostic a, Typeable a) => a -> DriverMessage
+
+ -- | A parse error in parsing a Haskell file header during dependency
-- analysis
+ DriverPsHeaderMessage :: !PsErrorDesc -> ![PsHint] -> DriverMessage
--- | A collection of driver messages
-type DriverMessages = Messages DriverMessage
+ {-| DriverMissingHomeModules is a warning (controlled with -Wmissing-home-modules) that
+ arises when running GHC in --make mode when some modules needed for compilation
+ are not included on the command line. For example, if A imports B, `ghc --make
+ A.hs` will cause this warning, while `ghc --make A.hs B.hs` will not.
+
+ Useful for cabal to ensure GHC won't pick up modules listed neither in
+ 'exposed-modules' nor in 'other-modules'.
+
+ Test case: warnings/should_compile/MissingMod
+
+ -}
+ DriverMissingHomeModules :: [ModuleName] -> !BuildingCabalPackage -> DriverMessage
+
+ {-| DriverUnusedPackages occurs when when package is requested on command line,
+ but was never needed during compilation. Activated by -Wunused-packages.
+
+ Test cases: warnings/should_compile/UnusedPackages
+ -}
+ DriverUnusedPackages :: [PackageArg] -> DriverMessage
+
+ {-| DriverUnnecessarySourceImports (controlled with -Wunused-imports) occurs if there
+ are {-# SOURCE #-} imports which are not necessary. See 'warnUnnecessarySourceImports'
+ in 'GHC.Driver.Make'.
+
+ Test cases: warnings/should_compile/T10637
+ -}
+ DriverUnnecessarySourceImports :: !ModuleName -> DriverMessage
+
+ {-| DriverDuplicatedModuleDeclaration occurs if a module 'A' is declared in
+ multiple files.
+
+ Test cases: None.
+ -}
+ DriverDuplicatedModuleDeclaration :: !Module -> [FilePath] -> DriverMessage
+
+ {-| DriverModuleNotFound occurs if a module 'A' can't be found.
+
+ Test cases: None.
+ -}
+ DriverModuleNotFound :: !ModuleName -> DriverMessage
+
+ {-| DriverFileModuleNameMismatch occurs if a module 'A' is defined in a file with a different name.
+ The first field is the name written in the source code; the second argument is the name extracted
+ from the filename.
+
+ Test cases: module/mod178, /driver/bug1677
+ -}
+ DriverFileModuleNameMismatch :: !ModuleName -> !ModuleName -> DriverMessage
+
+ {-| DriverUnexpectedSignature occurs when GHC encounters a module 'A' that imports a signature
+ file which is neither in the 'signatures' section of a '.cabal' file nor in any package in
+ the home modules.
+
+ Example:
+
+ -- MyStr.hsig is defined, but not added to 'signatures' in the '.cabal' file.
+ signature MyStr where
+ data Str
+
+ -- A.hs, which tries to import the signature.
+ module A where
+ import MyStr
+
+
+ Test cases: driver/T12955
+ -}
+ DriverUnexpectedSignature :: !ModuleName -> !BuildingCabalPackage -> [InstantiationSuggestion] -> DriverMessage
+
+ {-| DriverFileNotFound occurs when the input file (e.g. given on the command line) can't be found.
+
+ Test cases: None.
+ -}
+ DriverFileNotFound :: !FilePath -> DriverMessage
+
+ {-| DriverStaticPointersNotSupported occurs when the 'StaticPointers' extension is used
+ in an interactive GHCi context.
+
+ Test cases: ghci/scripts/StaticPtr
+ -}
+ DriverStaticPointersNotSupported :: DriverMessage
+
+ {-| DriverBackpackModuleNotFound occurs when Backpack can't find a particular module
+ during its dependency analysis.
+
+ Test cases: -
+ -}
+ DriverBackpackModuleNotFound :: !ModuleName -> DriverMessage
+
+-- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated
+-- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
+-- to instantiate a particular signature, where the first argument is
+-- the signature name and the second is the module where the signature
+-- was defined.
+-- Example:
+--
+-- src/MyStr.hsig:2:11: error:
+-- Unexpected signature: ‘MyStr’
+-- (Try passing -instantiated-with="MyStr=<MyStr>"
+-- replacing <MyStr> as necessary.)
+data InstantiationSuggestion = InstantiationSuggestion !ModuleName !Module
+
+-- | Pass to a 'DriverMessage' the information whether or not the
+-- '-fbuilding-cabal-package' flag is set.
+data BuildingCabalPackage
+ = YesBuildingCabalPackage
+ | NoBuildingCabalPackage
+ deriving Eq
--- | A message about Safe Haskell.
+-- | Checks if we are building a cabal package by consulting the 'DynFlags'.
+checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage
+checkBuildingCabalPackage dflags =
+ if gopt Opt_BuildingCabalPackage dflags
+ then YesBuildingCabalPackage
+ else NoBuildingCabalPackage
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 767d0b884b..51110e4134 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -61,6 +61,7 @@ import GHC.Driver.Backend
import GHC.Driver.Monad
import GHC.Driver.Env
import GHC.Driver.Errors
+import GHC.Driver.Errors.Ppr
import GHC.Driver.Errors.Types
import GHC.Driver.Main
@@ -271,7 +272,7 @@ instantiationNodes unit_state = InstantiationNode <$> iuids_to_check
warnMissingHomeModules :: GhcMonad m => HscEnv -> ModuleGraph -> m ()
warnMissingHomeModules hsc_env mod_graph =
when (not (null missing)) $
- logDiagnostics warn
+ logDiagnostics (GhcDriverMessage <$> warn)
where
dflags = hsc_dflags hsc_env
targets = map targetId (hsc_targets hsc_env)
@@ -306,22 +307,8 @@ warnMissingHomeModules hsc_env mod_graph =
missing = map (moduleName . ms_mod) $
filter (not . is_known_module) (mgModSummaries mod_graph)
- msg
- | gopt Opt_BuildingCabalPackage dflags
- = hang
- (text "These modules are needed for compilation but not listed in your .cabal file's other-modules: ")
- 4
- (sep (map ppr missing))
- | otherwise
- =
- hang
- (text "Modules are not listed in command line but needed for compilation: ")
- 4
- (sep (map ppr missing))
- warn = singleMessage $
- mkPlainMsgEnvelope (hsc_dflags hsc_env) noSrcSpan $
- GhcDriverMessage $ DriverUnknownMessage $
- mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingHomeModules) msg
+ warn = singleMessage $ mkPlainMsgEnvelope (hsc_dflags hsc_env) noSrcSpan
+ $ DriverMissingHomeModules missing (checkBuildingCabalPackage dflags)
-- | Describes which modules of the module graph need to be loaded.
data LoadHowMuch
@@ -386,27 +373,15 @@ warnUnusedPackages = do
= filter (\arg -> not $ any (matching state arg) loadedPackages)
requestedArgs
- let warn = singleMessage $
- mkPlainMsgEnvelope dflags noSrcSpan $
- GhcDriverMessage $ DriverUnknownMessage $
- mkPlainDiagnostic (WarningWithFlag Opt_WarnUnusedPackages) msg
- msg = vcat [ text "The following packages were specified" <+>
- text "via -package or -package-id flags,"
- , text "but were not needed for compilation:"
- , nest 2 (vcat (map (withDash . pprUnusedArg) unusedArgs)) ]
+ let warn = singleMessage $ mkPlainMsgEnvelope dflags noSrcSpan (DriverUnusedPackages unusedArgs)
when (not (null unusedArgs)) $
- logDiagnostics warn
+ logDiagnostics (GhcDriverMessage <$> warn)
where
packageArg (ExposePackage _ arg _) = Just arg
packageArg _ = Nothing
- pprUnusedArg (PackageArg str) = text str
- pprUnusedArg (UnitIdArg uid) = ppr uid
-
- withDash = (<+>) (text "-")
-
matchingStr :: String -> UnitInfo -> Bool
matchingStr str p
= str == unitPackageIdString p
@@ -2226,10 +2201,7 @@ warnUnnecessarySourceImports sccs = do
warn :: DynFlags -> Located ModuleName -> MsgEnvelope GhcMessage
warn dflags (L loc mod) =
- mkPlainMsgEnvelope dflags loc $
- GhcDriverMessage $ DriverUnknownMessage $
- mkPlainDiagnostic WarningWithoutFlag $
- text "{-# SOURCE #-} unnecessary in import of " <+> quotes (ppr mod)
+ GhcDriverMessage <$> mkPlainMsgEnvelope dflags loc (DriverUnnecessarySourceImports mod)
-----------------------------------------------------------------------------
@@ -2300,10 +2272,8 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
if exists || isJust maybe_buf
then summariseFile hsc_env old_summaries file mb_phase
obj_allowed maybe_buf
- else return $ Left $ singleMessage $
- mkPlainErrorMsgEnvelope noSrcSpan $
- DriverUnknownMessage $ mkPlainError $
- text "can't find file:" <+> text file
+ else return $ Left $ singleMessage
+ $ mkPlainErrorMsgEnvelope noSrcSpan (DriverFileNotFound file)
getRootSummary Target { targetId = TargetModule modl
, targetAllowObjCode = obj_allowed
, targetContents = maybe_buf
@@ -2737,32 +2707,13 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
| otherwise = HsSrcFile
when (pi_mod_name /= wanted_mod) $
- throwE $ singleMessage $
- mkPlainErrorMsgEnvelope pi_mod_name_loc $
- DriverUnknownMessage $ mkPlainError $
- text "File name does not match module name:"
- $$ text "Saw :" <+> quotes (ppr pi_mod_name)
- $$ text "Expected:" <+> quotes (ppr wanted_mod)
+ throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
+ $ DriverFileModuleNameMismatch pi_mod_name wanted_mod
when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (homeUnitInstantiations home_unit))) $
- let suggested_instantiated_with =
- hcat (punctuate comma $
- [ ppr k <> text "=" <> ppr v
- | (k,v) <- ((pi_mod_name, mkHoleModule pi_mod_name)
- : homeUnitInstantiations home_unit)
- ])
- in throwE $ singleMessage $
- mkPlainErrorMsgEnvelope pi_mod_name_loc $
- DriverUnknownMessage $ mkPlainError $
- text "Unexpected signature:" <+> quotes (ppr pi_mod_name)
- $$ if gopt Opt_BuildingCabalPackage dflags
- 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 pi_mod_name <> text "> as necessary.")
+ let suggestions = suggestInstantiatedWith pi_mod_name (homeUnitInstantiations home_unit)
+ in throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
+ $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) suggestions
liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
{ nms_src_fn = src_fn
@@ -2918,25 +2869,17 @@ noModError hsc_env loc wanted_mod err
noHsFileErr :: SrcSpan -> String -> DriverMessages
noHsFileErr loc path
- = singleMessage $ mkPlainErrorMsgEnvelope loc $
- DriverUnknownMessage $ mkPlainError $
- text "Can't find" <+> text path
+ = singleMessage $ mkPlainErrorMsgEnvelope loc (DriverFileNotFound path)
moduleNotFoundErr :: ModuleName -> DriverMessages
moduleNotFoundErr mod
- = singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan $
- DriverUnknownMessage $ mkPlainError $
- text "module" <+> quotes (ppr mod) <+> text "cannot be found locally"
+ = singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverModuleNotFound mod)
multiRootsErr :: [ModSummary] -> IO ()
multiRootsErr [] = panic "multiRootsErr"
multiRootsErr summs@(summ1:_)
- = throwOneError $
- mkPlainErrorMsgEnvelope noSrcSpan $
- GhcDriverMessage $ DriverUnknownMessage $ mkPlainError $
- text "module" <+> quotes (ppr mod) <+>
- text "is defined in multiple files:" <+>
- sep (map text files)
+ = throwOneError $ fmap GhcDriverMessage $
+ mkPlainErrorMsgEnvelope noSrcSpan $ DriverDuplicatedModuleDeclaration mod files
where
mod = ms_mod summ1
files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
diff --git a/compiler/GHC/Iface/Errors.hs b/compiler/GHC/Iface/Errors.hs
index 9e0df9a9d8..83f9b03920 100644
--- a/compiler/GHC/Iface/Errors.hs
+++ b/compiler/GHC/Iface/Errors.hs
@@ -18,6 +18,7 @@ import GHC.Platform.Ways
import GHC.Utils.Panic.Plain
import GHC.Driver.Session
import GHC.Driver.Env.Types
+import GHC.Driver.Errors.Types
import GHC.Data.Maybe
import GHC.Prelude
import GHC.Unit
@@ -151,7 +152,7 @@ cannotFindModule hsc_env = cannotFindModule'
cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc
cannotFindModule' dflags unit_env profile mod res = pprWithUnitState (ue_units unit_env) $
- cantFindErr (gopt Opt_BuildingCabalPackage dflags)
+ cantFindErr (checkBuildingCabalPackage dflags)
cannotFindMsg
(text "Ambiguous module name")
unit_env
@@ -170,7 +171,7 @@ cannotFindModule' dflags unit_env profile mod res = pprWithUnitState (ue_units u
_ -> text "Could not find module"
cantFindErr
- :: Bool -- ^ Using Cabal?
+ :: BuildingCabalPackage -- ^ Using Cabal?
-> SDoc
-> SDoc
-> UnitEnv
@@ -273,7 +274,7 @@ cantFindErr using_cabal cannot_find _ unit_env profile tried_these mod_name find
<> dot $$ pkg_hidden_hint uid
pkg_hidden_hint uid
- | using_cabal
+ | using_cabal == YesBuildingCabalPackage
= let pkg = expectJust "pkg_hidden" (lookupUnit (ue_units unit_env) uid)
in text "Perhaps you need to add" <+>
quotes (ppr (unitPackageName pkg)) <+>
diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs
index 7e614588f6..2380c95032 100644
--- a/compiler/GHC/Utils/Error.hs
+++ b/compiler/GHC/Utils/Error.hs
@@ -73,6 +73,7 @@ import GHC.Utils.Exception
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
import GHC.Utils.Logger
+import GHC.Utils.Misc ( debugIsOn )
import GHC.Types.Error
import GHC.Types.SrcLoc as SrcLoc
@@ -151,7 +152,7 @@ mkErrorMsgEnvelope :: Diagnostic e
-> e
-> MsgEnvelope e
mkErrorMsgEnvelope locn unqual msg =
- mk_msg_envelope SevError locn unqual msg
+ ASSERT( diagnosticReason msg == ErrorWithoutFlag ) mk_msg_envelope SevError locn unqual msg
-- | Variant that doesn't care about qualified/unqualified names.
mkPlainMsgEnvelope :: Diagnostic e
diff --git a/testsuite/tests/warnings/should_compile/T10637/T10637.stderr b/testsuite/tests/warnings/should_compile/T10637/T10637.stderr
index 7be59d5f2b..ece4316739 100644
--- a/testsuite/tests/warnings/should_compile/T10637/T10637.stderr
+++ b/testsuite/tests/warnings/should_compile/T10637/T10637.stderr
@@ -1,3 +1,3 @@
-T10637.hs:3:23: warning:
+T10637.hs:3:23: warning: [-Wunused-imports (in -Wextra)]
{-# SOURCE #-} unnecessary in import of ‘A’