From 101d25fce311237b82580745c321f70e62755719 Mon Sep 17 00:00:00 2001 From: Alfredo Di Napoli Date: Tue, 13 Apr 2021 10:26:42 +0200 Subject: 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 --- compiler/GHC.hs | 7 +- compiler/GHC/Driver/Backpack.hs | 5 +- compiler/GHC/Driver/Errors/Ppr.hs | 120 ++++++++++++++++-- compiler/GHC/Driver/Errors/Types.hs | 139 +++++++++++++++++++-- compiler/GHC/Driver/Make.hs | 93 +++----------- compiler/GHC/Iface/Errors.hs | 7 +- compiler/GHC/Utils/Error.hs | 3 +- .../warnings/should_compile/T10637/T10637.stderr | 2 +- 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=" +-- replacing 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’ -- cgit v1.2.1