From 00a8a5ff9abf5bb1a0c2a9225c7bca5ec3bdf306 Mon Sep 17 00:00:00 2001 From: Torsten Schmits Date: Mon, 24 Apr 2023 19:17:30 +0200 Subject: Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. --- compiler/GHC/Rename/Names.hs | 180 ++++----------- compiler/GHC/Tc/Errors/Ppr.hs | 243 ++++++++++++++++----- compiler/GHC/Tc/Errors/Types.hs | 208 ++++++++++++++++-- compiler/GHC/Types/Error/Codes.hs | 30 ++- compiler/GHC/Types/Hint.hs | 5 + compiler/GHC/Types/Hint/Ppr.hs | 2 + .../tests/deriving/should_compile/T17324.stderr | 2 +- testsuite/tests/driver/t22391/t22391.stderr | 4 +- testsuite/tests/driver/t22391/t22391j.stderr | 4 +- testsuite/tests/ghci/prog018/prog018.stdout | 2 +- testsuite/tests/ghci/scripts/T4127a.stderr | 2 +- testsuite/tests/ghci/scripts/ghci048.stderr | 4 +- testsuite/tests/module/T1074.stderr | 2 +- testsuite/tests/module/T11970A.stderr | 2 +- testsuite/tests/module/mod176.stderr | 2 +- testsuite/tests/module/mod177.stderr | 2 +- testsuite/tests/module/mod18.stderr | 2 +- testsuite/tests/module/mod19.stderr | 4 +- testsuite/tests/module/mod20.stderr | 2 +- testsuite/tests/module/mod21.stderr | 2 +- testsuite/tests/module/mod22.stderr | 2 +- testsuite/tests/module/mod38.stderr | 2 +- testsuite/tests/module/mod66.stderr | 2 +- .../should_fail/FieldSelectors.stderr | 4 +- .../should_fail/NFSDuplicate.stderr | 2 +- .../overloadedrecflds/should_fail/T17965.stderr | 2 +- .../should_fail/overloadedrecfldsfail03.stderr | 2 +- .../should_fail/overloadedrecfldsfail06.stderr | 8 +- .../tests/patsyn/should_compile/T9975a.stderr | 2 +- .../tests/rename/should_compile/T13064.stderr | 2 +- .../tests/rename/should_compile/T14881.stderr | 2 +- .../tests/rename/should_compile/T17244A.stderr | 2 +- testsuite/tests/rename/should_compile/T1789.stderr | 6 +- testsuite/tests/rename/should_compile/T4489.stderr | 2 +- testsuite/tests/rename/should_compile/rn037.stderr | 2 +- testsuite/tests/rename/should_compile/rn046.stderr | 4 +- .../rename/should_fail/ImportLookupIllegal.hs | 3 + .../rename/should_fail/ImportLookupIllegal.stderr | 1 + .../rename/should_fail/PackageImportsDisabled.hs | 3 + .../should_fail/PackageImportsDisabled.stderr | 3 + testsuite/tests/rename/should_fail/T3792.stderr | 2 +- testsuite/tests/rename/should_fail/T5211.stderr | 2 +- testsuite/tests/rename/should_fail/T7164.stderr | 2 +- testsuite/tests/rename/should_fail/T7454.stderr | 2 +- testsuite/tests/rename/should_fail/T8149.stderr | 2 +- testsuite/tests/rename/should_fail/T9032.stderr | 3 +- testsuite/tests/rename/should_fail/all.T | 2 + testsuite/tests/rename/should_fail/rn_dup.stderr | 10 +- .../tests/rename/should_fail/rnfail002.stderr | 2 +- .../tests/rename/should_fail/rnfail003.stderr | 2 +- .../tests/rename/should_fail/rnfail009.stderr | 2 +- .../tests/rename/should_fail/rnfail010.stderr | 2 +- .../tests/rename/should_fail/rnfail011.stderr | 2 +- .../tests/rename/should_fail/rnfail012.stderr | 2 +- .../tests/rename/should_fail/rnfail013.stderr | 2 +- .../tests/rename/should_fail/rnfail015.stderr | 2 +- .../tests/rename/should_fail/rnfail043.stderr | 2 +- .../tests/safeHaskell/safeInfered/Mixed01.stderr | 5 +- testsuite/tests/th/T8932.stderr | 2 +- testsuite/tests/th/TH_dupdecl.stderr | 2 +- .../type-data/should_fail/TDMultiple01.stderr | 2 +- .../type-data/should_fail/TDMultiple02.stderr | 2 +- .../tests/type-data/should_fail/TDPunning.stderr | 2 +- .../tests/warnings/should_compile/DeprU.stderr | 2 +- .../tests/warnings/should_compile/DodgyImports.hs | 3 + .../warnings/should_compile/DodgyImports.stderr | 4 + .../warnings/should_compile/DodgyImports_hiding.hs | 3 + .../should_compile/DodgyImports_hiding.stderr | 4 + .../warnings/should_compile/T10890/T10890_2.stderr | 2 +- testsuite/tests/warnings/should_compile/all.T | 2 + .../warnings/should_fail/WarningCategory1.stderr | 2 +- .../warnings/should_fail/WarningCategory2.stderr | 2 +- .../warnings/should_fail/WarningCategory5.stderr | 2 +- .../warnings/should_fail/WarningCategory7.stderr | 2 +- 74 files changed, 552 insertions(+), 294 deletions(-) create mode 100644 testsuite/tests/rename/should_fail/ImportLookupIllegal.hs create mode 100644 testsuite/tests/rename/should_fail/ImportLookupIllegal.stderr create mode 100644 testsuite/tests/rename/should_fail/PackageImportsDisabled.hs create mode 100644 testsuite/tests/rename/should_fail/PackageImportsDisabled.stderr create mode 100644 testsuite/tests/warnings/should_compile/DodgyImports.hs create mode 100644 testsuite/tests/warnings/should_compile/DodgyImports.stderr create mode 100644 testsuite/tests/warnings/should_compile/DodgyImports_hiding.hs create mode 100644 testsuite/tests/warnings/should_compile/DodgyImports_hiding.stderr diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index 92cab86d05..ba45769034 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -72,7 +72,6 @@ import GHC.Types.Basic ( TopLevelFlag(..) ) import GHC.Types.SourceText import GHC.Types.Id import GHC.Types.HpcInfo -import GHC.Types.Error import GHC.Types.PkgQual import GHC.Types.GREInfo (ConInfo(..)) @@ -90,7 +89,7 @@ import GHC.Data.Maybe import GHC.Data.List.SetOps ( removeDups ) import Control.Monad -import Data.Foldable ( for_, toList ) +import Data.Foldable ( for_ ) import Data.IntMap ( IntMap ) import qualified Data.IntMap as IntMap import Data.Map ( Map ) @@ -323,7 +322,7 @@ rnImportDecl this_mod NoRawPkgQual -> pure () RawPkgQual _ -> do pkg_imports <- xoptM LangExt.PackageImports - when (not pkg_imports) $ addErr packageImportErr + when (not pkg_imports) $ addErr TcRnPackageImportsDisabled let qual_only = isImportDeclQualified qual_style @@ -356,8 +355,7 @@ rnImportDecl this_mod NoPkgQual -> True ThisPkg uid -> uid == homeUnitId_ (hsc_dflags hsc_env) OtherPkg _ -> False)) - (addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - (text "A module cannot import itself:" <+> ppr imp_mod_name)) + (addErr (TcRnSelfImport imp_mod_name)) -- Check for a missing import list (Opt_WarnMissingImportList also -- checks for T(..) items but that is done in checkDodgyImport below) @@ -365,12 +363,7 @@ rnImportDecl this_mod Just (Exactly, _) -> return () -- Explicit import list _ | implicit -> return () -- Do not bleat for implicit imports | qual_only -> return () - | otherwise -> whenWOptM Opt_WarnMissingImportList $ do - let msg = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingImportList) - noHints - (missingImportListWarn imp_mod_name) - addDiagnostic msg + | otherwise -> addDiagnostic (TcRnNoExplicitImportList imp_mod_name) iface <- loadSrcInterface doc imp_mod_name want_boot pkg_qual @@ -389,11 +382,9 @@ rnImportDecl this_mod -- is not deterministic. The hs-boot test can show this up. dflags <- getDynFlags warnIf ((want_boot == IsBoot) && (mi_boot iface == NotBoot) && isOneShot (ghcMode dflags)) - (warnRedundantSourceImport imp_mod_name) + (TcRnRedundantSourceImport imp_mod_name) when (mod_safe && not (safeImportsOn dflags)) $ - addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - (text "safe import can't be used as Safe Haskell isn't on!" - $+$ text ("please enable Safe Haskell through either Safe, Trustworthy or Unsafe")) + addErr (TcRnSafeImportsDisabled imp_mod_name) let qual_mod_name = fmap unLoc as_mod `orElse` imp_mod_name @@ -432,12 +423,7 @@ rnImportDecl this_mod -- Complain if we import a deprecated module case mi_warns iface of - WarnAll txt -> do - let msg = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithCategory (warningTxtCategory txt)) - noHints - (moduleWarn imp_mod_name txt) - addDiagnostic msg + WarnAll txt -> addDiagnostic (TcRnDeprecatedModule imp_mod_name txt) _ -> return () -- Complain about -Wcompat-unqualified-imports violations. @@ -614,11 +600,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM () warnUnqualifiedImport decl iface = when bad_import $ do - let msg = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag Opt_WarnCompatUnqualifiedImports) - noHints - warning - addDiagnosticAt loc msg + addDiagnosticAt loc (TcRnCompatUnqualifiedImport decl) where mod = mi_module iface loc = getLocA $ ideclName decl @@ -635,21 +617,10 @@ warnUnqualifiedImport decl iface = && not has_import_list && mod `elemModuleSet` qualifiedMods - warning = vcat - [ text "To ensure compatibility with future core libraries changes" - , text "imports to" <+> ppr (ideclName decl) <+> text "should be" - , text "either qualified or have an explicit import list." - ] - -- Modules for which we warn if we see unqualified imports qualifiedMods = mkModuleSet [ dATA_LIST ] -warnRedundantSourceImport :: ModuleName -> TcRnMessage -warnRedundantSourceImport mod_name - = mkTcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints $ - text "Unnecessary {-# SOURCE #-} in the import of module" <+> quotes (ppr mod_name) - {- ************************************************************************ * * @@ -1252,32 +1223,35 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) = setSrcSpanA loc $ do (stuff, warns) <- liftM (fromMaybe ([],[])) $ run_lookup (lookup_ie ieRdr) - mapM_ emit_warning warns + mapM_ (addTcRnDiagnostic <=< warning_msg) warns return [ (L loc ie, gres) | (ie,gres) <- stuff ] where + -- Warn when importing T(..) and no children are brought in scope - emit_warning (DodgyImport n) = whenWOptM Opt_WarnDodgyImports $ - addTcRnDiagnostic (TcRnDodgyImports n) - emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $ - addTcRnDiagnostic (TcRnMissingImportList ieRdr) - emit_warning (BadImportW ie) = whenWOptM Opt_WarnDodgyImports $ do + warning_msg (DodgyImport n) = + pure (TcRnDodgyImports (DodgyImportsEmptyParent n)) + warning_msg MissingImportList = + pure (TcRnMissingImportList ieRdr) + warning_msg (BadImportW ie) = do -- 'BadImportW' is only constructed below in 'handle_bad_import', in -- the 'EverythingBut' case, so that's what we pass to -- 'badImportItemErr'. - badImportItemErr iface decl_spec ie BadImportIsParent all_avails EverythingBut + reason <- badImportItemErr iface decl_spec ie BadImportIsParent all_avails + pure (TcRnDodgyImports (DodgyImportsHiding reason)) run_lookup :: IELookupM a -> TcRn (Maybe a) run_lookup m = case m of Failed err -> do - lookup_err_msg err + msg <- lookup_err_msg err + addErr (TcRnImportLookup msg) return Nothing Succeeded a -> return (Just a) lookup_err_msg err = case err of - BadImport ie sub -> badImportItemErr iface decl_spec ie sub all_avails Exactly - IllegalImport -> illegalImportItemErr - QualImportError rdr -> qualImportItemErr rdr - AmbiguousImport rdr xs -> ambiguousImportItemErr rdr xs + BadImport ie sub -> badImportItemErr iface decl_spec ie sub all_avails + IllegalImport -> pure ImportLookupIllegal + QualImportError rdr -> pure (ImportLookupQualified rdr) + AmbiguousImport rdr xs -> pure (ImportLookupAmbiguous rdr xs) -- For each import item, we convert its RdrNames to Names, -- and at the same time compute all the GlobalRdrElt corresponding @@ -1756,8 +1730,7 @@ warnUnusedImportDecls gbl_env hsc_src (vcat [ text "Uses:" <+> ppr uses , text "Import usage" <+> ppr usage]) - ; whenWOptM Opt_WarnUnusedImports $ - mapM_ (warnUnusedImport Opt_WarnUnusedImports rdr_env) usage + ; mapM_ (warnUnusedImport rdr_env) usage ; whenGOptM Opt_D_dump_minimal_imports $ printMinimalImports hsc_src usage } @@ -1862,9 +1835,8 @@ mkImportMap gres is:iss -> bestImport (is NE.:| iss) add _ gres = gre : gres -warnUnusedImport :: WarningFlag -> GlobalRdrEnv - -> ImportDeclUsage -> RnM () -warnUnusedImport flag rdr_env (L loc decl, used, unused) +warnUnusedImport :: GlobalRdrEnv -> ImportDeclUsage -> RnM () +warnUnusedImport rdr_env (L loc decl, used, unused) -- Do not warn for 'import M()' | Just (Exactly, L _ []) <- ideclImportList decl @@ -1878,9 +1850,7 @@ warnUnusedImport flag rdr_env (L loc decl, used, unused) -- Nothing used; drop entire declaration | null used - = let dia = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag flag) noHints msg1 - in addDiagnosticAt (locA loc) dia + = addDiagnosticAt (locA loc) (TcRnUnusedImport decl UnusedImportNone) -- Everything imported is used; nop | null unused @@ -1891,45 +1861,27 @@ warnUnusedImport flag rdr_env (L loc decl, used, unused) | Just (_, L _ imports) <- ideclImportList decl , length unused == 1 , Just (L loc _) <- find (\(L _ ie) -> ((ieName ie) :: Name) `elem` unused) imports - = let dia = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints msg2 - in addDiagnosticAt (locA loc) dia + = addDiagnosticAt (locA loc) (TcRnUnusedImport decl (UnusedImportSome sort_unused)) -- Some imports are unused | otherwise - = let dia = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints msg2 - in addDiagnosticAt (locA loc) dia + = addDiagnosticAt (locA loc) (TcRnUnusedImport decl (UnusedImportSome sort_unused)) where - msg1 = vcat [ pp_herald <+> quotes pp_mod <+> is_redundant - , nest 2 (text "except perhaps to import instances from" - <+> quotes pp_mod) - , text "To import instances alone, use:" - <+> text "import" <+> pp_mod <> parens Outputable.empty ] - msg2 = sep [ pp_herald <+> quotes sort_unused - , text "from module" <+> quotes pp_mod <+> is_redundant] - pp_herald = text "The" <+> pp_qual <+> text "import of" - pp_qual - | isImportDeclQualified (ideclQualified decl)= text "qualified" - | otherwise = Outputable.empty - pp_mod = ppr (unLoc (ideclName decl)) - is_redundant = text "is redundant" - -- In warning message, pretty-print identifiers unqualified unconditionally -- to improve the consistent for ambiguous/unambiguous identifiers. -- See trac#14881. - ppr_possible_field n = + possible_field n = case lookupGRE_Name rdr_env n of Just (GRE { gre_par = par, gre_info = IAmRecField info }) -> let fld_occ :: OccName fld_occ = nameOccName $ flSelector $ recFieldLabel info - in case par of - ParentIs p -> pprNameUnqualified p <> parens (ppr fld_occ) - NoParent -> ppr fld_occ - _ -> pprNameUnqualified n + in UnusedImportNameRecField par fld_occ + _ -> UnusedImportNameRegular n -- Print unused names in a deterministic (lexicographic) order - sort_unused :: SDoc - sort_unused = pprWithCommas ppr_possible_field $ + sort_unused :: [UnusedImportName] + sort_unused = fmap possible_field $ sortBy (comparing nameOccName) unused {- @@ -2137,30 +2089,13 @@ DRFPatSynExport for a test of this. ************************************************************************ -} -qualImportItemErr :: RdrName -> TcRn () -qualImportItemErr rdr - = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Illegal qualified name in import item:") - 2 (ppr rdr) - -ambiguousImportItemErr :: RdrName -> [GlobalRdrElt] -> TcRn () -ambiguousImportItemErr rdr gres - = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints err - where - err = hang (text "Ambiguous name" <+> quotes (ppr rdr) <+> text "in import item. It could refer to:") - 2 (vcat (map (ppr . greOccName) gres)) - badImportItemErr :: ModIface -> ImpDeclSpec -> IE GhcPs -> BadImportIsSubordinate -> [AvailInfo] - -> ImportListInterpretation - -> TcRn () -badImportItemErr iface decl_spec ie sub avails ili - = do { patsyns_enabled <- xoptM LangExt.PatternSynonyms - ; let err = TcRnBadImport importErrorKind iface decl_spec ie patsyns_enabled ili - ; case ili of - EverythingBut -> addTcRnDiagnostic err - Exactly -> addErr err } + -> TcRn ImportLookupReason +badImportItemErr iface decl_spec ie sub avails = do + patsyns_enabled <- xoptM LangExt.PatternSynonyms + pure (ImportLookupBad importErrorKind iface decl_spec ie patsyns_enabled) where importErrorKind | any checkIfTyCon avails = case sub of @@ -2189,43 +2124,15 @@ badImportItemErr iface decl_spec ie sub avails ili IEThingWith _ _ _ ns -> map (ieWrappedName . unLoc) ns _ -> panic "importedChildren failed pattern match: no children" -illegalImportItemErr :: TcRn () -illegalImportItemErr = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "Illegal import item" - addDupDeclErr :: NonEmpty GlobalRdrElt -> TcRn () addDupDeclErr gres@(gre :| _) - = addErrAt (getSrcSpan (NE.last sorted_names)) $ mkTcRnUnknownMessage $ mkPlainError noHints $ - -- Report the error at the later location - vcat [text "Multiple declarations of" <+> - quotes (ppr (greOccName gre)), - -- NB. print the OccName, not the Name, because the - -- latter might not be in scope in the RdrEnv and so will - -- be printed qualified. - text "Declared at:" <+> - vcat (toList $ ppr . nameSrcLoc <$> sorted_names)] + -- Report the error at the later location + = addErrAt (getSrcSpan (NE.last sorted_names)) $ (TcRnDuplicateDecls (greOccName gre) sorted_names) where sorted_names = NE.sortBy (SrcLoc.leftmost_smallest `on` nameSrcSpan) (fmap greName gres) -missingImportListWarn :: ModuleName -> SDoc -missingImportListWarn mod - = text "The module" <+> quotes (ppr mod) <+> text "does not have an explicit import list" - -moduleWarn :: ModuleName -> WarningTxt GhcRn -> SDoc -moduleWarn mod (WarningTxt _ _ txt) - = sep [ text "Module" <+> quotes (ppr mod) <> colon, - nest 2 (vcat (map (ppr . hsDocString . unLoc) txt)) ] -moduleWarn mod (DeprecatedTxt _ txt) - = sep [ text "Module" <+> quotes (ppr mod) - <+> text "is deprecated:", - nest 2 (vcat (map (ppr . hsDocString . unLoc) txt)) ] - -packageImportErr :: TcRnMessage -packageImportErr - = mkTcRnUnknownMessage $ mkPlainError noHints $ - text "Package-qualified imports are not enabled; use PackageImports" - -- This data decl will parse OK -- data T = a Int -- treating "a" as the constructor. @@ -2241,9 +2148,4 @@ packageImportErr checkConName :: RdrName -> TcRn () checkConName name - = checkErr (isRdrDataCon name || isRdrTc name) (badDataCon name) - -badDataCon :: RdrName -> TcRnMessage -badDataCon name - = mkTcRnUnknownMessage $ mkPlainError noHints $ - hsep [text "Illegal data constructor name", quotes (ppr name)] + = checkErr (isRdrDataCon name || isRdrTc name) (TcRnIllegalDataCon name) diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 4152866492..ef00752196 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -154,8 +154,11 @@ instance Diagnostic TcRnMessage where ) : [errInfoContext, errInfoSupplementary] TcRnUnusedPatternBinds bind -> mkDecorated [hang (text "This pattern-binding binds no variables:") 2 (ppr bind)] - TcRnDodgyImports gre + TcRnDodgyImports (DodgyImportsEmptyParent gre) -> mkDecorated [dodgy_msg (text "import") gre (dodgy_msg_insert gre)] + TcRnDodgyImports (DodgyImportsHiding reason) + -> mkSimpleDecorated $ + pprImportLookup reason TcRnDodgyExports gre -> mkDecorated [dodgy_msg (text "export") gre (dodgy_msg_insert gre)] TcRnMissingImportList ie @@ -1115,58 +1118,6 @@ instance Diagnostic TcRnMessage where TcRnTypeDataForbids feature -> mkSimpleDecorated $ ppr feature <+> text "are not allowed in type data declarations." - TcRnBadImport k iface decl_spec ie _ps _interp -> - mkSimpleDecorated $ - let - pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc - pprImpDeclSpec iface decl_spec = - quotes (ppr (is_mod decl_spec)) <+> case mi_boot iface of - IsBoot -> text "(hi-boot interface)" - NotBoot -> empty - withContext msgs = - hang (text "In the import of" <+> pprImpDeclSpec iface decl_spec <> colon) - 2 (vcat msgs) - in case k of - BadImportNotExported -> - vcat - [ text "Module" <+> pprImpDeclSpec iface decl_spec <+> - text "does not export" <+> quotes (ppr ie) <> dot - ] - BadImportAvailVar -> - withContext - [ text "an item called" - <+> quotes val <+> text "is exported, but it is not a type." - ] - where - val_occ = rdrNameOcc $ ieName ie - val = parenSymOcc val_occ (ppr val_occ) - BadImportAvailTyCon {} -> - withContext - [ text "an item called" - <+> quotes tycon <+> text "is exported, but it is a type." - ] - where - tycon_occ = rdrNameOcc $ ieName ie - tycon = parenSymOcc tycon_occ (ppr tycon_occ) - BadImportNotExportedSubordinates ns -> - withContext - [ text "an item called" <+> quotes sub <+> text "is exported, but it does not export any children" - , text "(constructors, class methods or field names) called" - <+> pprWithCommas (quotes . ppr) ns <> dot - ] - where - sub_occ = rdrNameOcc $ ieName ie - sub = parenSymOcc sub_occ (ppr sub_occ) - BadImportAvailDataCon dataType_occ -> - withContext - [ text "an item called" <+> quotes datacon - , text "is exported, but it is a data constructor of" - , quotes dataType <> dot - ] - where - datacon_occ = rdrNameOcc $ ieName ie - datacon = parenSymOcc datacon_occ (ppr datacon_occ) - dataType = parenSymOcc dataType_occ (ppr dataType_occ) TcRnIllegalNewtype con show_linear_types reason -> mkSimpleDecorated $ @@ -1791,6 +1742,54 @@ instance Diagnostic TcRnMessage where text "not even by defaulting." TcRnInterfaceError reason -> diagnosticMessage (tcOptsIfaceOpts opts) reason + TcRnSelfImport imp_mod_name + -> mkSimpleDecorated $ + text "A module cannot import itself:" <+> ppr imp_mod_name + TcRnNoExplicitImportList mod + -> mkSimpleDecorated $ + text "The module" <+> quotes (ppr mod) <+> text "does not have an explicit import list" + TcRnSafeImportsDisabled _ + -> mkSimpleDecorated $ + text "safe import can't be used as Safe Haskell isn't on!" + TcRnDeprecatedModule mod txt + -> mkSimpleDecorated $ + sep [ text "Module" <+> quotes (ppr mod) <> text extra <> colon, + nest 2 (vcat (map (ppr . hsDocString . unLoc) msg)) ] + where + (extra, msg) = case txt of + WarningTxt _ _ msg -> ("", msg) + DeprecatedTxt _ msg -> (" is deprecated", msg) + TcRnCompatUnqualifiedImport decl + -> mkSimpleDecorated $ + vcat + [ text "To ensure compatibility with future core libraries changes" + , text "imports to" <+> ppr (ideclName decl) <+> text "should be" + , text "either qualified or have an explicit import list." + ] + TcRnRedundantSourceImport mod_name + -> mkSimpleDecorated $ + text "Unnecessary {-# SOURCE #-} in the import of module" <+> quotes (ppr mod_name) + TcRnImportLookup reason + -> mkSimpleDecorated $ + pprImportLookup reason + TcRnUnusedImport decl reason + -> mkSimpleDecorated $ + pprUnusedImport decl reason + TcRnDuplicateDecls name sorted_names + -> mkSimpleDecorated $ + vcat [text "Multiple declarations of" <+> + quotes (ppr name), + -- NB. print the OccName, not the Name, because the + -- latter might not be in scope in the RdrEnv and so will + -- be printed qualified. + text "Declared at:" <+> + vcat (NE.toList $ ppr . nameSrcLoc <$> sorted_names)] + TcRnPackageImportsDisabled + -> mkSimpleDecorated $ + text "Package-qualified imports are not enabled" + TcRnIllegalDataCon name + -> mkSimpleDecorated $ + hsep [text "Illegal data constructor name", quotes (ppr name)] diagnosticReason = \case TcRnUnknownMessage m @@ -2365,10 +2364,29 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInterfaceError err -> interfaceErrorReason err - TcRnBadImport _ _ _ _ _ importKind - -> case importKind of - Exactly -> ErrorWithoutFlag - EverythingBut -> WarningWithFlag Opt_WarnDodgyImports + TcRnSelfImport{} + -> ErrorWithoutFlag + TcRnNoExplicitImportList{} + -> WarningWithFlag Opt_WarnMissingImportList + TcRnSafeImportsDisabled{} + -> ErrorWithoutFlag + TcRnDeprecatedModule _ txt + -> WarningWithCategory (warningTxtCategory txt) + TcRnCompatUnqualifiedImport{} + -> WarningWithFlag Opt_WarnCompatUnqualifiedImports + TcRnRedundantSourceImport{} + -> WarningWithoutFlag + TcRnImportLookup{} + -> ErrorWithoutFlag + TcRnUnusedImport{} + -> WarningWithFlag Opt_WarnUnusedImports + TcRnDuplicateDecls{} + -> ErrorWithoutFlag + TcRnPackageImportsDisabled + -> ErrorWithoutFlag + TcRnIllegalDataCon{} + -> ErrorWithoutFlag + diagnosticHints = \case TcRnUnknownMessage m @@ -2975,7 +2993,19 @@ instance Diagnostic TcRnMessage where -> [SuggestAddTypeSignatures UnnamedBinding] TcRnInterfaceError reason -> interfaceErrorHints reason - TcRnBadImport k _ is ie patsyns_enabled _ -> + TcRnSelfImport{} + -> noHints + TcRnNoExplicitImportList{} + -> noHints + TcRnSafeImportsDisabled{} + -> [SuggestSafeHaskell] + TcRnDeprecatedModule{} + -> noHints + TcRnCompatUnqualifiedImport{} + -> noHints + TcRnRedundantSourceImport{} + -> noHints + TcRnImportLookup (ImportLookupBad k _ is ie patsyns_enabled) -> let mod = is_mod is occ = rdrNameOcc $ ieName ie in case k of @@ -2984,6 +3014,16 @@ instance Diagnostic TcRnMessage where BadImportAvailTyCon -> [ImportSuggestion occ $ CouldAddTypeKeyword (is_mod is)] BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (is_mod is, patsyns_enabled)) par] BadImportNotExportedSubordinates{} -> noHints + TcRnImportLookup{} + -> noHints + TcRnUnusedImport{} + -> noHints + TcRnDuplicateDecls{} + -> noHints + TcRnPackageImportsDisabled + -> [suggestExtension LangExt.PackageImports] + TcRnIllegalDataCon{} + -> noHints diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode @@ -5153,3 +5193,90 @@ pprDisabledClassExtension cls = \case vcat [ hang (text "Constraint" <+> quotes (ppr pred) <+> text "in the type of" <+> quotes (ppr sel_id)) 2 (text "constrains only the class type variables")] + +pprImportLookup :: ImportLookupReason -> SDoc +pprImportLookup = \case + ImportLookupBad k iface decl_spec ie _ps -> + let + pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc + pprImpDeclSpec iface decl_spec = + quotes (ppr (is_mod decl_spec)) <+> case mi_boot iface of + IsBoot -> text "(hi-boot interface)" + NotBoot -> empty + withContext msgs = + hang (text "In the import of" <+> pprImpDeclSpec iface decl_spec <> colon) + 2 (vcat msgs) + in case k of + BadImportNotExported -> + vcat + [ text "Module" <+> pprImpDeclSpec iface decl_spec <+> + text "does not export" <+> quotes (ppr ie) <> dot + ] + BadImportAvailVar -> + withContext + [ text "an item called" + <+> quotes val <+> text "is exported, but it is not a type." + ] + where + val_occ = rdrNameOcc $ ieName ie + val = parenSymOcc val_occ (ppr val_occ) + BadImportAvailTyCon {} -> + withContext + [ text "an item called" + <+> quotes tycon <+> text "is exported, but it is a type." + ] + where + tycon_occ = rdrNameOcc $ ieName ie + tycon = parenSymOcc tycon_occ (ppr tycon_occ) + BadImportNotExportedSubordinates ns -> + withContext + [ text "an item called" <+> quotes sub <+> text "is exported, but it does not export any children" + , text "(constructors, class methods or field names) called" + <+> pprWithCommas (quotes . ppr) ns <> dot + ] + where + sub_occ = rdrNameOcc $ ieName ie + sub = parenSymOcc sub_occ (ppr sub_occ) + BadImportAvailDataCon dataType_occ -> + withContext + [ text "an item called" <+> quotes datacon + , text "is exported, but it is a data constructor of" + , quotes dataType <> dot + ] + where + datacon_occ = rdrNameOcc $ ieName ie + datacon = parenSymOcc datacon_occ (ppr datacon_occ) + dataType = parenSymOcc dataType_occ (ppr dataType_occ) + ImportLookupQualified rdr -> + hang (text "Illegal qualified name in import item:") + 2 (ppr rdr) + ImportLookupIllegal -> + text "Illegal import item" + ImportLookupAmbiguous rdr gres -> + hang (text "Ambiguous name" <+> quotes (ppr rdr) <+> text "in import item. It could refer to:") + 2 (vcat (map (ppr . greOccName) gres)) + +pprUnusedImport :: ImportDecl GhcRn -> UnusedImportReason -> SDoc +pprUnusedImport decl = \case + UnusedImportNone -> + vcat [ pp_herald <+> quotes pp_mod <+> text "is redundant" + , nest 2 (text "except perhaps to import instances from" + <+> quotes pp_mod) + , text "To import instances alone, use:" + <+> text "import" <+> pp_mod <> parens empty ] + UnusedImportSome sort_unused -> + sep [ pp_herald <+> quotes (pprWithCommas pp_unused sort_unused) + , text "from module" <+> quotes pp_mod <+> text "is redundant"] + where + pp_mod = ppr (unLoc (ideclName decl)) + pp_herald = text "The" <+> pp_qual <+> text "import of" + pp_qual + | isImportDeclQualified (ideclQualified decl) = text "qualified" + | otherwise = empty + pp_unused = \case + UnusedImportNameRegular n -> + pprNameUnqualified n + UnusedImportNameRecField par fld_occ -> + case par of + ParentIs p -> pprNameUnqualified p <> parens (ppr fld_occ) + NoParent -> ppr fld_occ diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index 8cdc5eb007..9e017a6e52 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -110,6 +110,10 @@ module GHC.Tc.Errors.Types ( , HsTyVarBndrExistentialFlag(..) , TySynCycleTyCons , BadImportKind(..) + , DodgyImportsReason (..) + , ImportLookupReason (..) + , UnusedImportReason (..) + , UnusedImportName (..) ) where import GHC.Prelude @@ -365,13 +369,11 @@ data TcRnMessage where -> HsTyVarBndrExistentialFlag -- ^ tyVar binder. -> TcRnMessage - {-| TcRnDodgyImports is a warning (controlled with -Wdodgy-imports) that occurs when - an import of the form 'T(..)' or 'f(..)' does not actually import anything beside - 'T'/'f' itself. + {-| TcRnDodgyImports is a group of warnings (controlled with -Wdodgy-imports). - Test cases: rename/should_compile/T7167 + See 'DodgyImportsReason' for the different warnings. -} - TcRnDodgyImports :: GlobalRdrElt -> TcRnMessage + TcRnDodgyImports :: !DodgyImportsReason -> TcRnMessage {-| TcRnDodgyExports is a warning (controlled by -Wdodgy-exports) that occurs when an export of the form 'T(..)' for a type constructor 'T' does not actually export anything beside 'T' itself. @@ -2937,21 +2939,6 @@ data TcRnMessage where rename/should_fail/T5657 -} TcRnSectionWithoutParentheses :: HsExpr GhcPs -> TcRnMessage - {-| TcRnBadImport is an error that occurs in cases where an item in an import - statement is not exported by the corresponding module. - When a nonexistent item is included in the 'hiding' section of an import - statement, this becomes a warning instead, controlled by -Wdodgy-imports. - - Test cases: - testsuite/tests/module/should_fail/T21826.hs - -} - TcRnBadImport :: BadImportKind - -> ModIface - -> ImpDeclSpec - -> IE GhcPs - -> Bool -- ^ whether @-XPatternSynonyms@ was enabled - -> ImportListInterpretation - -> TcRnMessage {- TcRnBindingOfExistingName is an error triggered by an attempt to rebind built-in syntax, punned list or tuple syntax, or a name quoted via Template Haskell. @@ -3821,6 +3808,105 @@ data TcRnMessage where TcRnTypeSynonymCycle :: !TySynCycleTyCons -- ^ The tycons involved in the cycle -> TcRnMessage + {-| TcRnSelfImport is an error indicating that a module contains an + import of itself. + + Test cases: + T9032 + -} + TcRnSelfImport :: !ModuleName -- ^ The module + -> TcRnMessage + + {-| TcRnNoExplicitImportList is a warning indicating that an import + statement did not include an explicit import list. + + Test cases: + T1789, T4489 + -} + TcRnNoExplicitImportList :: !ModuleName -- ^ The imported module + -> TcRnMessage + + {-| TcRnSafeImportsDisabled is an error indicating that an import was + declared using the @safe@ keyword while SafeHaskell wasn't active. + + Test cases: + Mixed01 + -} + TcRnSafeImportsDisabled :: !ModuleName -- ^ The imported module + -> TcRnMessage + + {-| TcRnDeprecatedModule is a warning indicating that an imported module + is annotated with a warning or deprecation pragma. + + Test cases: + DeprU + -} + TcRnDeprecatedModule :: !ModuleName -- ^ The imported module + -> !(WarningTxt GhcRn) -- ^ The pragma data + -> TcRnMessage + + {-| TcRnCompatUnqualifiedImport is a warning indicating that a special + module (right now only Data.List) was imported unqualified without + import list, for compatibility reasons. + + Test cases: + T17244A + -} + TcRnCompatUnqualifiedImport :: !(ImportDecl GhcPs) -- ^ The import + -> TcRnMessage + + {-| TcRnRedundantSourceImport is a warning indicating that a {-# SOURCE #-} + import was used when there is no import cycle. + + Test cases: + none + -} + TcRnRedundantSourceImport :: !ModuleName -- ^ The imported module + -> TcRnMessage + + {-| TcRnImportLookup is a group of errors about bad imported names. + -} + TcRnImportLookup :: !ImportLookupReason -- ^ Details about the error + -> TcRnMessage + + {-| TcRnUnusedImport is a group of errors about unused imports. + -} + TcRnUnusedImport :: !(ImportDecl GhcRn) -- ^ The import + -> !UnusedImportReason -- ^ Details about the error + -> TcRnMessage + + {-| TcRnDuplicateDecls is an error indicating that the same name was used for + multiple declarations. + + Test cases: + FieldSelectors, overloadedrecfldsfail03, T17965, NFSDuplicate, T9975a, + TDMultiple01, mod19, mod38, mod21, mod66, mod20, TDPunning, mod18, mod22, + TDMultiple02, T4127a, ghci048, T8932, rnfail015, rnfail010, rnfail011, + rnfail013, rnfail002, rnfail003, rn_dup, rnfail009, T7164, rnfail043, + TH_dupdecl, rnfail012 + -} + TcRnDuplicateDecls :: !OccName -- ^ The name of the declarations + -> !(NE.NonEmpty Name) -- ^ The individual declarations + -> TcRnMessage + + {-| TcRnPackageImportsDisabled is an error indicating that an import uses + a package qualifier while the extension PackageImports was disabled. + + Test cases: + PackageImportsDisabled + -} + TcRnPackageImportsDisabled :: TcRnMessage + + {-| TcRnIllegalDataCon is an error indicating that a data constructor was + defined using a lowercase name, or a symbolic name in prefix position. + Mostly caught by PsErrNotADataCon. + + Test cases: + None + -} + TcRnIllegalDataCon :: !RdrName -- ^ The constructor name + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -5246,3 +5332,85 @@ instance Outputable HsTyVarBndrExistentialFlag where type TySynCycleTyCons = [Either TyCon (LTyClDecl GhcRn)] + +-- | Different types of warnings for dodgy imports. +data DodgyImportsReason = + {-| An import of the form 'T(..)' or 'f(..)' does not actually import anything beside + 'T'/'f' itself. + + Test cases: + DodgyImports + -} + DodgyImportsEmptyParent !GlobalRdrElt + | + {-| A 'hiding' clause contains something that would be reported as an error in a + regular import, but is relaxed to a warning. + + Test cases: + DodgyImports_hiding + -} + DodgyImportsHiding !ImportLookupReason + deriving (Generic) + +-- | Different types of errors for import lookup. +data ImportLookupReason where + {-| An item in an import statement is not exported by the corresponding + module. + + Test cases: + T21826, recomp001, retc001, mod79, mod80, mod81, mod91, T6007, T7167, + T9006, T11071, T9905fail2, T5385, T10668 + -} + ImportLookupBad :: BadImportKind + -> ModIface + -> ImpDeclSpec + -> IE GhcPs + -> Bool -- ^ whether @-XPatternSynonyms@ was enabled + -> ImportLookupReason + {-| A name is specified with a qualifying module. + + Test cases: + T3792 + -} + ImportLookupQualified :: !RdrName -- ^ The name extracted from the import item + -> ImportLookupReason + + {-| Something completely unexpected is in an import list, like @module Foo@. + + Test cases: + ImportLookupIllegal + -} + ImportLookupIllegal :: ImportLookupReason + {-| An item in an import list matches multiple names exported from that module. + + Test cases: + None + -} + ImportLookupAmbiguous :: !RdrName -- ^ The name extracted from the import item + -> ![GlobalRdrElt] -- ^ The potential matches + -> ImportLookupReason + deriving (Generic) + +-- | Distinguish record fields from other names for pretty-printing. +data UnusedImportName where + UnusedImportNameRecField :: !Parent -> !OccName -> UnusedImportName + UnusedImportNameRegular :: !Name -> UnusedImportName + +-- | Different types of errors for unused imports. +data UnusedImportReason where + {-| No names in the import list are used in the module. + + Test cases: + overloadedrecfldsfail06, T10890_2, t22391, t22391j, T1074, prog018, + mod177, rn046, rn037, T5211 + -} + UnusedImportNone :: UnusedImportReason + {-| A set of names in the import list are not used in the module. + + Test cases: + overloadedrecfldsfail06, T17324, mod176, T11970A, rn046, T14881, + T7454, T8149, T13064 + -} + UnusedImportSome :: ![UnusedImportName] -- ^ The unsed names + -> UnusedImportReason + deriving (Generic) diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs index 195f6e0608..46597c8e0c 100644 --- a/compiler/GHC/Types/Error/Codes.hs +++ b/compiler/GHC/Types/Error/Codes.hs @@ -331,7 +331,6 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnTypeDoesNotHaveFixedRuntimeRep" = 18478 GhcDiagnosticCode "TcRnImplicitLift" = 00846 GhcDiagnosticCode "TcRnUnusedPatternBinds" = 61367 - GhcDiagnosticCode "TcRnDodgyImports" = 99623 GhcDiagnosticCode "TcRnDodgyExports" = 75356 GhcDiagnosticCode "TcRnMissingImportList" = 77037 GhcDiagnosticCode "TcRnUnsafeDueToPlugin" = 01687 @@ -578,6 +577,15 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnIncoherentRoles" = 18273 GhcDiagnosticCode "TcRnTyFamNameMismatch" = 88221 GhcDiagnosticCode "TcRnTypeSynonymCycle" = 97522 + GhcDiagnosticCode "TcRnSelfImport" = 43281 + GhcDiagnosticCode "TcRnNoExplicitImportList" = 16029 + GhcDiagnosticCode "TcRnSafeImportsDisabled" = 26971 + GhcDiagnosticCode "TcRnDeprecatedModule" = 15328 + GhcDiagnosticCode "TcRnCompatUnqualifiedImport" = 82347 + GhcDiagnosticCode "TcRnRedundantSourceImport" = 54478 + GhcDiagnosticCode "TcRnDuplicateDecls" = 29916 + GhcDiagnosticCode "TcRnPackageImportsDisabled" = 10032 + GhcDiagnosticCode "TcRnIllegalDataCon" = 78448 -- PatSynInvalidRhsReason GhcDiagnosticCode "PatSynNotInvertible" = 69317 @@ -656,6 +664,18 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "DefaultDataInstDecl" = 39639 GhcDiagnosticCode "FunBindLacksEquations" = 52078 + -- TcRnDodgyImports/DodgyImportsReason + GhcDiagnosticCode "DodgyImportsEmptyParent" = 99623 + + -- TcRnImportLookup/ImportLookupReason + GhcDiagnosticCode "ImportLookupQualified" = 48795 + GhcDiagnosticCode "ImportLookupIllegal" = 14752 + GhcDiagnosticCode "ImportLookupAmbiguous" = 92057 + + -- TcRnUnusedImport/UnusedImportReason + GhcDiagnosticCode "UnusedImportNone" = 66111 + GhcDiagnosticCode "UnusedImportSome" = 38856 + -- Diagnostic codes for the foreign function interface GhcDiagnosticCode "NotADataType" = 31136 GhcDiagnosticCode "NewtypeDataConNotInScope" = 72317 @@ -820,6 +840,10 @@ type family ConRecursInto con where ConRecursInto "TcRnRoleValidationFailed" = 'Just RoleValidationFailedReason ConRecursInto "TcRnClassExtensionDisabled" = 'Just DisabledClassExtension ConRecursInto "TcRnTyFamsDisabled" = 'Just TyFamsDisabledReason + ConRecursInto "TcRnDodgyImports" = 'Just DodgyImportsReason + ConRecursInto "DodgyImportsHiding" = 'Just ImportLookupReason + ConRecursInto "TcRnImportLookup" = 'Just ImportLookupReason + ConRecursInto "TcRnUnusedImport" = 'Just UnusedImportReason -- -- TH errors @@ -861,8 +885,8 @@ type family ConRecursInto con where ConRecursInto "DsUnknownMessage" = 'Just UnknownDiagnostic ---------------------------------- - -- Constructors of TcRnBadImport - ConRecursInto "TcRnBadImport" = 'Just BadImportKind + -- Constructors of ImportLookupBad + ConRecursInto "ImportLookupBad" = 'Just BadImportKind ---------------------------------- -- Any other constructors: don't recur, instead directly diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs index c715a8f05e..4ce8d04a9d 100644 --- a/compiler/GHC/Types/Hint.hs +++ b/compiler/GHC/Types/Hint.hs @@ -429,6 +429,11 @@ data GhcHint | SuggestExplicitBidiPatSyn Name (LPat GhcRn) [LIdP GhcRn] + {-| Suggest enabling one of the SafeHaskell modes Safe, Unsafe or + Trustworthy. + -} + | SuggestSafeHaskell + -- | 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 diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs index 774d27ac7c..c0945f29fe 100644 --- a/compiler/GHC/Types/Hint/Ppr.hs +++ b/compiler/GHC/Types/Hint/Ppr.hs @@ -230,6 +230,8 @@ instance Outputable GhcHint where where pp_name = ppr name pp_args = hsep (map ppr args) + SuggestSafeHaskell + -> text "Enable Safe Haskell through either Safe, Trustworthy or Unsafe." perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" diff --git a/testsuite/tests/deriving/should_compile/T17324.stderr b/testsuite/tests/deriving/should_compile/T17324.stderr index 54e6534462..0ae00ce62d 100644 --- a/testsuite/tests/deriving/should_compile/T17324.stderr +++ b/testsuite/tests/deriving/should_compile/T17324.stderr @@ -1,4 +1,4 @@ -T17324.hs:8:1: warning: [-Wunused-imports (in -Wextra)] +T17324.hs:8:1: warning: [GHC-38856] [-Wunused-imports (in -Wextra)] The import of ‘Dual, Product, Sum’ from module ‘Data.Monoid’ is redundant diff --git a/testsuite/tests/driver/t22391/t22391.stderr b/testsuite/tests/driver/t22391/t22391.stderr index e24daa51ae..bdb2abe792 100644 --- a/testsuite/tests/driver/t22391/t22391.stderr +++ b/testsuite/tests/driver/t22391/t22391.stderr @@ -20,12 +20,12 @@ src/Lib/B.hs:3:12: warning: [GHC-18042] [-Wtype-defaults (in -Wall)] • In the expression: 4 In an equation for ‘warnmeup’: warnmeup = 4 -src/Lib.hs:5:1: warning: [-Wunused-imports (in -Wextra)] +src/Lib.hs:5:1: warning: [GHC-66111] [-Wunused-imports (in -Wextra)] The import of ‘Lib.A’ is redundant except perhaps to import instances from ‘Lib.A’ To import instances alone, use: import Lib.A() -src/Lib.hs:6:1: warning: [-Wunused-imports (in -Wextra)] +src/Lib.hs:6:1: warning: [GHC-66111] [-Wunused-imports (in -Wextra)] The import of ‘Lib.B’ is redundant except perhaps to import instances from ‘Lib.B’ To import instances alone, use: import Lib.B() diff --git a/testsuite/tests/driver/t22391/t22391j.stderr b/testsuite/tests/driver/t22391/t22391j.stderr index e24daa51ae..bdb2abe792 100644 --- a/testsuite/tests/driver/t22391/t22391j.stderr +++ b/testsuite/tests/driver/t22391/t22391j.stderr @@ -20,12 +20,12 @@ src/Lib/B.hs:3:12: warning: [GHC-18042] [-Wtype-defaults (in -Wall)] • In the expression: 4 In an equation for ‘warnmeup’: warnmeup = 4 -src/Lib.hs:5:1: warning: [-Wunused-imports (in -Wextra)] +src/Lib.hs:5:1: warning: [GHC-66111] [-Wunused-imports (in -Wextra)] The import of ‘Lib.A’ is redundant except perhaps to import instances from ‘Lib.A’ To import instances alone, use: import Lib.A() -src/Lib.hs:6:1: warning: [-Wunused-imports (in -Wextra)] +src/Lib.hs:6:1: warning: [GHC-66111] [-Wunused-imports (in -Wextra)] The import of ‘Lib.B’ is redundant except perhaps to import instances from ‘Lib.B’ To import instances alone, use: import Lib.B() diff --git a/testsuite/tests/ghci/prog018/prog018.stdout b/testsuite/tests/ghci/prog018/prog018.stdout index c7b39ad2ed..1fff03d755 100644 --- a/testsuite/tests/ghci/prog018/prog018.stdout +++ b/testsuite/tests/ghci/prog018/prog018.stdout @@ -10,7 +10,7 @@ A.hs:5:1: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] A.hs:8:15: warning: [-Wunused-matches (in -Wextra)] Defined but not used: ‘x’ -B.hs:7:1: warning: [-Wunused-imports (in -Wextra)] +B.hs:7:1: warning: [GHC-66111] [-Wunused-imports (in -Wextra)] The import of ‘Data.Tuple’ is redundant except perhaps to import instances from ‘Data.Tuple’ To import instances alone, use: import Data.Tuple() diff --git a/testsuite/tests/ghci/scripts/T4127a.stderr b/testsuite/tests/ghci/scripts/T4127a.stderr index 829ae2f8ca..d879509df2 100644 --- a/testsuite/tests/ghci/scripts/T4127a.stderr +++ b/testsuite/tests/ghci/scripts/T4127a.stderr @@ -1,5 +1,5 @@ -:2:68: +:2:68: [GHC-29916] Multiple declarations of ‘f’ Declared at: :2:32 :2:68 diff --git a/testsuite/tests/ghci/scripts/ghci048.stderr b/testsuite/tests/ghci/scripts/ghci048.stderr index 27cc18f708..b4abcf506e 100644 --- a/testsuite/tests/ghci/scripts/ghci048.stderr +++ b/testsuite/tests/ghci/scripts/ghci048.stderr @@ -1,10 +1,10 @@ -:3:16: +:3:16: [GHC-29916] Multiple declarations of ‘A’ Declared at: :3:12 :3:16 -:5:16: +:5:16: [GHC-29916] Multiple declarations of ‘A’ Declared at: :5:12 :5:16 diff --git a/testsuite/tests/module/T1074.stderr b/testsuite/tests/module/T1074.stderr index 14e56e8c07..30cc86fbfc 100644 --- a/testsuite/tests/module/T1074.stderr +++ b/testsuite/tests/module/T1074.stderr @@ -1,5 +1,5 @@ -T1074.hs:6:1: warning: [-Wunused-imports (in -Wextra)] +T1074.hs:6:1: warning: [GHC-66111] [-Wunused-imports (in -Wextra)] The qualified import of ‘Control.Monad.Reader’ is redundant except perhaps to import instances from ‘Control.Monad.Reader’ To import instances alone, use: import Control.Monad.Reader() diff --git a/testsuite/tests/module/T11970A.stderr b/testsuite/tests/module/T11970A.stderr index 6b478a7335..c717ebf00a 100644 --- a/testsuite/tests/module/T11970A.stderr +++ b/testsuite/tests/module/T11970A.stderr @@ -1,5 +1,5 @@ [1 of 2] Compiling T11970A1 ( T11970A1.hs, T11970A1.o ) [2 of 2] Compiling T11970A ( T11970A.hs, T11970A.o ) -T11970A.hs:3:1: warning: [-Wunused-imports (in -Wextra)] +T11970A.hs:3:1: warning: [GHC-38856] [-Wunused-imports (in -Wextra)] The import of ‘Fail(b)’ from module ‘T11970A1’ is redundant diff --git a/testsuite/tests/module/mod176.stderr b/testsuite/tests/module/mod176.stderr index 20ccfc1ffb..a8b51c1a4b 100644 --- a/testsuite/tests/module/mod176.stderr +++ b/testsuite/tests/module/mod176.stderr @@ -1,4 +1,4 @@ -mod176.hs:4:1: warning: [-Wunused-imports (in -Wextra)] +mod176.hs:4:1: warning: [GHC-38856] [-Wunused-imports (in -Wextra)] The import of ‘Monad, return’ from module ‘Control.Monad’ is redundant diff --git a/testsuite/tests/module/mod177.stderr b/testsuite/tests/module/mod177.stderr index ea9306aa76..02edcbffdd 100644 --- a/testsuite/tests/module/mod177.stderr +++ b/testsuite/tests/module/mod177.stderr @@ -1,5 +1,5 @@ -mod177.hs:4:1: warning: [-Wunused-imports (in -Wextra)] +mod177.hs:4:1: warning: [GHC-66111] [-Wunused-imports (in -Wextra)] The import of ‘Data.Maybe’ is redundant except perhaps to import instances from ‘Data.Maybe’ To import instances alone, use: import Data.Maybe() diff --git a/testsuite/tests/module/mod18.stderr b/testsuite/tests/module/mod18.stderr index 0e1a4e3b7f..1f4198a167 100644 --- a/testsuite/tests/module/mod18.stderr +++ b/testsuite/tests/module/mod18.stderr @@ -1,5 +1,5 @@ -mod18.hs:3:1: +mod18.hs:3:1: [GHC-29916] Multiple declarations of ‘T’ Declared at: mod18.hs:2:1 mod18.hs:3:1 diff --git a/testsuite/tests/module/mod19.stderr b/testsuite/tests/module/mod19.stderr index b59d584f21..821b6d3fa1 100644 --- a/testsuite/tests/module/mod19.stderr +++ b/testsuite/tests/module/mod19.stderr @@ -1,10 +1,10 @@ -mod19.hs:3:1: +mod19.hs:3:1: [GHC-29916] Multiple declarations of ‘C’ Declared at: mod19.hs:2:1 mod19.hs:3:1 -mod19.hs:3:17: +mod19.hs:3:17: [GHC-29916] Multiple declarations of ‘m’ Declared at: mod19.hs:2:17 mod19.hs:3:17 diff --git a/testsuite/tests/module/mod20.stderr b/testsuite/tests/module/mod20.stderr index 23190d6a2f..3352ef308a 100644 --- a/testsuite/tests/module/mod20.stderr +++ b/testsuite/tests/module/mod20.stderr @@ -1,5 +1,5 @@ -mod20.hs:3:18: +mod20.hs:3:18: [GHC-29916] Multiple declarations of ‘m’ Declared at: mod20.hs:2:18 mod20.hs:3:18 diff --git a/testsuite/tests/module/mod21.stderr b/testsuite/tests/module/mod21.stderr index 09c83c05ce..3e2ae15831 100644 --- a/testsuite/tests/module/mod21.stderr +++ b/testsuite/tests/module/mod21.stderr @@ -1,5 +1,5 @@ -mod21.hs:3:1: +mod21.hs:3:1: [GHC-29916] Multiple declarations of ‘T’ Declared at: mod21.hs:2:1 mod21.hs:3:1 diff --git a/testsuite/tests/module/mod22.stderr b/testsuite/tests/module/mod22.stderr index d1d61ba628..ee292d7ee3 100644 --- a/testsuite/tests/module/mod22.stderr +++ b/testsuite/tests/module/mod22.stderr @@ -1,5 +1,5 @@ -mod22.hs:3:11: +mod22.hs:3:11: [GHC-29916] Multiple declarations of ‘K’ Declared at: mod22.hs:2:11 mod22.hs:3:11 diff --git a/testsuite/tests/module/mod38.stderr b/testsuite/tests/module/mod38.stderr index 971d31c931..1ac5f7c830 100644 --- a/testsuite/tests/module/mod38.stderr +++ b/testsuite/tests/module/mod38.stderr @@ -1,5 +1,5 @@ -mod38.hs:4:1: +mod38.hs:4:1: [GHC-29916] Multiple declarations of ‘C’ Declared at: mod38.hs:3:1 mod38.hs:4:1 diff --git a/testsuite/tests/module/mod66.stderr b/testsuite/tests/module/mod66.stderr index 4a03192ef0..cb0db5d55c 100644 --- a/testsuite/tests/module/mod66.stderr +++ b/testsuite/tests/module/mod66.stderr @@ -1,5 +1,5 @@ -mod66.hs:5:1: +mod66.hs:5:1: [GHC-29916] Multiple declarations of ‘f’ Declared at: mod66.hs:3:1 mod66.hs:5:1 diff --git a/testsuite/tests/overloadedrecflds/should_fail/FieldSelectors.stderr b/testsuite/tests/overloadedrecflds/should_fail/FieldSelectors.stderr index 8edc117f3d..14542c580b 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/FieldSelectors.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/FieldSelectors.stderr @@ -1,4 +1,4 @@ -FieldSelectors.hs:10:1: +FieldSelectors.hs:10:1: [GHC-29916] Multiple declarations of ‘foo’ Declared at: FieldSelectors.hs:8:18 - FieldSelectors.hs:10:1 \ No newline at end of file + FieldSelectors.hs:10:1 diff --git a/testsuite/tests/overloadedrecflds/should_fail/NFSDuplicate.stderr b/testsuite/tests/overloadedrecflds/should_fail/NFSDuplicate.stderr index f30bb1e490..e76dc0703c 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/NFSDuplicate.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/NFSDuplicate.stderr @@ -1,5 +1,5 @@ -NFSDuplicate.hs:8:16: error: +NFSDuplicate.hs:8:16: error: [GHC-29916] Multiple declarations of ‘foo’ Declared at: NFSDuplicate.hs:7:16 NFSDuplicate.hs:8:16 diff --git a/testsuite/tests/overloadedrecflds/should_fail/T17965.stderr b/testsuite/tests/overloadedrecflds/should_fail/T17965.stderr index 446913eda4..16d2ecdb37 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/T17965.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/T17965.stderr @@ -1,5 +1,5 @@ -T17965.hs:4:17: error: +T17965.hs:4:17: error: [GHC-29916] Multiple declarations of ‘f’ Declared at: T17965.hs:3:29 T17965.hs:4:17 diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.stderr index 4aec21c608..9629d7e027 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.stderr @@ -1,5 +1,5 @@ -overloadedrecfldsfail03.hs:8:16: +overloadedrecfldsfail03.hs:8:16: [GHC-29916] Multiple declarations of ‘foo’ Declared at: overloadedrecfldsfail03.hs:6:1 overloadedrecfldsfail03.hs:8:16 diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr index 3f0b17106a..f1b59db83f 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr @@ -10,20 +10,20 @@ OverloadedRecFldsFail06_A.hs:9:59: warning: [-Wunused-top-binds (in -Wextra, -Wu Defined but not used: record field of MkUnused ‘used_locally’ [2 of 3] Compiling Main ( overloadedrecfldsfail06.hs, overloadedrecfldsfail06.o ) -overloadedrecfldsfail06.hs:7:1: error: [-Wunused-imports (in -Wextra), Werror=unused-imports] +overloadedrecfldsfail06.hs:7:1: error: [GHC-38856] [-Wunused-imports (in -Wextra), Werror=unused-imports] The import of ‘MkV, Unused, Unused(unused), V(x), U(y)’ from module ‘OverloadedRecFldsFail06_A’ is redundant -overloadedrecfldsfail06.hs:8:1: error: [-Wunused-imports (in -Wextra), Werror=unused-imports] +overloadedrecfldsfail06.hs:8:1: error: [GHC-66111] [-Wunused-imports (in -Wextra), Werror=unused-imports] The qualified import of ‘OverloadedRecFldsFail06_A’ is redundant except perhaps to import instances from ‘OverloadedRecFldsFail06_A’ To import instances alone, use: import OverloadedRecFldsFail06_A() -overloadedrecfldsfail06.hs:9:1: error: [-Wunused-imports (in -Wextra), Werror=unused-imports] +overloadedrecfldsfail06.hs:9:1: error: [GHC-38856] [-Wunused-imports (in -Wextra), Werror=unused-imports] The qualified import of ‘V(y)’ from module ‘OverloadedRecFldsFail06_A’ is redundant -overloadedrecfldsfail06.hs:10:1: error: [-Wunused-imports (in -Wextra), Werror=unused-imports] +overloadedrecfldsfail06.hs:10:1: error: [GHC-38856] [-Wunused-imports (in -Wextra), Werror=unused-imports] The qualified import of ‘U, U(x)’ from module ‘OverloadedRecFldsFail06_A’ is redundant diff --git a/testsuite/tests/patsyn/should_compile/T9975a.stderr b/testsuite/tests/patsyn/should_compile/T9975a.stderr index faddb2a3e5..8723833ce0 100644 --- a/testsuite/tests/patsyn/should_compile/T9975a.stderr +++ b/testsuite/tests/patsyn/should_compile/T9975a.stderr @@ -1,5 +1,5 @@ -T9975a.hs:6:1: +T9975a.hs:6:1: [GHC-29916] Multiple declarations of ‘Test’ Declared at: T9975a.hs:5:13 T9975a.hs:6:1 diff --git a/testsuite/tests/rename/should_compile/T13064.stderr b/testsuite/tests/rename/should_compile/T13064.stderr index a94e5b70d5..8716be11fd 100644 --- a/testsuite/tests/rename/should_compile/T13064.stderr +++ b/testsuite/tests/rename/should_compile/T13064.stderr @@ -1,3 +1,3 @@ -T13064.hs:5:21: warning: [-Wunused-imports (in -Wextra)] +T13064.hs:5:21: warning: [GHC-38856] [-Wunused-imports (in -Wextra)] The import of ‘pure’ from module ‘Prelude’ is redundant diff --git a/testsuite/tests/rename/should_compile/T14881.stderr b/testsuite/tests/rename/should_compile/T14881.stderr index bfb6ca913f..2e3ff2b406 100644 --- a/testsuite/tests/rename/should_compile/T14881.stderr +++ b/testsuite/tests/rename/should_compile/T14881.stderr @@ -1,6 +1,6 @@ [1 of 2] Compiling T14881Aux ( T14881Aux.hs, T14881Aux.o ) [2 of 2] Compiling T14881 ( T14881.hs, T14881.o ) -T14881.hs:3:1: warning: [-Wunused-imports (in -Wextra)] +T14881.hs:3:1: warning: [GHC-38856] [-Wunused-imports (in -Wextra)] The qualified import of ‘adjust, length, L(tail), L(x)’ from module ‘T14881Aux’ is redundant diff --git a/testsuite/tests/rename/should_compile/T17244A.stderr b/testsuite/tests/rename/should_compile/T17244A.stderr index 621e9439f1..3ba54e4a17 100644 --- a/testsuite/tests/rename/should_compile/T17244A.stderr +++ b/testsuite/tests/rename/should_compile/T17244A.stderr @@ -1,5 +1,5 @@ -T17244A.hs:6:8: warning: [-Wcompat-unqualified-imports (in -Wcompat)] +T17244A.hs:6:8: warning: [GHC-82347] [-Wcompat-unqualified-imports (in -Wcompat)] To ensure compatibility with future core libraries changes imports to Data.List should be either qualified or have an explicit import list. diff --git a/testsuite/tests/rename/should_compile/T1789.stderr b/testsuite/tests/rename/should_compile/T1789.stderr index 9941f21ec6..afb5a90cf8 100644 --- a/testsuite/tests/rename/should_compile/T1789.stderr +++ b/testsuite/tests/rename/should_compile/T1789.stderr @@ -1,12 +1,12 @@ -T1789.hs:6:1: warning: [-Wmissing-import-lists] +T1789.hs:6:1: warning: [GHC-16029] [-Wmissing-import-lists] The module ‘Prelude’ does not have an explicit import list -T1789.hs:7:1: warning: [-Wmissing-import-lists] +T1789.hs:7:1: warning: [GHC-16029] [-Wmissing-import-lists] The module ‘Data.Map’ does not have an explicit import list T1789.hs:9:20: warning: [GHC-77037] [-Wmissing-import-lists] The import item ‘Maybe(..)’ does not have an explicit import list -T1789.hs:10:1: warning: [-Wmissing-import-lists] +T1789.hs:10:1: warning: [GHC-16029] [-Wmissing-import-lists] The module ‘Data.Maybe’ does not have an explicit import list diff --git a/testsuite/tests/rename/should_compile/T4489.stderr b/testsuite/tests/rename/should_compile/T4489.stderr index b4ad5cd093..826fdba28a 100644 --- a/testsuite/tests/rename/should_compile/T4489.stderr +++ b/testsuite/tests/rename/should_compile/T4489.stderr @@ -1,5 +1,5 @@ -T4489.hs:4:1: warning: [-Wmissing-import-lists] +T4489.hs:4:1: warning: [GHC-16029] [-Wmissing-import-lists] The module ‘Data.Maybe’ does not have an explicit import list T4489.hs:5:20: warning: [GHC-77037] [-Wmissing-import-lists] diff --git a/testsuite/tests/rename/should_compile/rn037.stderr b/testsuite/tests/rename/should_compile/rn037.stderr index c386e896de..e2d6216ebc 100644 --- a/testsuite/tests/rename/should_compile/rn037.stderr +++ b/testsuite/tests/rename/should_compile/rn037.stderr @@ -1,5 +1,5 @@ -rn037.hs:3:1: warning: [-Wunused-imports (in -Wextra)] +rn037.hs:3:1: warning: [GHC-66111] [-Wunused-imports (in -Wextra)] The import of ‘Data.Tuple’ is redundant except perhaps to import instances from ‘Data.Tuple’ To import instances alone, use: import Data.Tuple() diff --git a/testsuite/tests/rename/should_compile/rn046.stderr b/testsuite/tests/rename/should_compile/rn046.stderr index e1947d914d..227b09e6e1 100644 --- a/testsuite/tests/rename/should_compile/rn046.stderr +++ b/testsuite/tests/rename/should_compile/rn046.stderr @@ -1,8 +1,8 @@ -rn046.hs:2:1: warning: [-Wunused-imports (in -Wextra)] +rn046.hs:2:1: warning: [GHC-66111] [-Wunused-imports (in -Wextra)] The import of ‘Data.List’ is redundant except perhaps to import instances from ‘Data.List’ To import instances alone, use: import Data.List() -rn046.hs:3:19: warning: [-Wunused-imports (in -Wextra)] +rn046.hs:3:19: warning: [GHC-38856] [-Wunused-imports (in -Wextra)] The import of ‘ord’ from module ‘Data.Char’ is redundant diff --git a/testsuite/tests/rename/should_fail/ImportLookupIllegal.hs b/testsuite/tests/rename/should_fail/ImportLookupIllegal.hs new file mode 100644 index 0000000000..f1bdacadcf --- /dev/null +++ b/testsuite/tests/rename/should_fail/ImportLookupIllegal.hs @@ -0,0 +1,3 @@ +module ImportLookupIllegal where + +import Control.Concurrent (module Control.Concurrent.MVar) diff --git a/testsuite/tests/rename/should_fail/ImportLookupIllegal.stderr b/testsuite/tests/rename/should_fail/ImportLookupIllegal.stderr new file mode 100644 index 0000000000..6e4ab849fb --- /dev/null +++ b/testsuite/tests/rename/should_fail/ImportLookupIllegal.stderr @@ -0,0 +1 @@ +ImportLookupIllegal.hs:3:28: [GHC-14752] Illegal import item diff --git a/testsuite/tests/rename/should_fail/PackageImportsDisabled.hs b/testsuite/tests/rename/should_fail/PackageImportsDisabled.hs new file mode 100644 index 0000000000..0a3faca96c --- /dev/null +++ b/testsuite/tests/rename/should_fail/PackageImportsDisabled.hs @@ -0,0 +1,3 @@ +module PackageImportsDisabled where + +import "base" Data.Char diff --git a/testsuite/tests/rename/should_fail/PackageImportsDisabled.stderr b/testsuite/tests/rename/should_fail/PackageImportsDisabled.stderr new file mode 100644 index 0000000000..63499309b6 --- /dev/null +++ b/testsuite/tests/rename/should_fail/PackageImportsDisabled.stderr @@ -0,0 +1,3 @@ +PackageImportsDisabled.hs:3:1: [GHC-10032] + Package-qualified imports are not enabled + Suggested fix: Perhaps you intended to use PackageImports diff --git a/testsuite/tests/rename/should_fail/T3792.stderr b/testsuite/tests/rename/should_fail/T3792.stderr index 964ea2ea8b..a8cd4670ae 100644 --- a/testsuite/tests/rename/should_fail/T3792.stderr +++ b/testsuite/tests/rename/should_fail/T3792.stderr @@ -1,3 +1,3 @@ -T3792.hs:3:17: error: +T3792.hs:3:17: error: [GHC-48795] Illegal qualified name in import item: Prelude.map diff --git a/testsuite/tests/rename/should_fail/T5211.stderr b/testsuite/tests/rename/should_fail/T5211.stderr index dc02ab4085..cca888e9de 100644 --- a/testsuite/tests/rename/should_fail/T5211.stderr +++ b/testsuite/tests/rename/should_fail/T5211.stderr @@ -1,5 +1,5 @@ -T5211.hs:5:1: warning: [-Wunused-imports (in -Wextra)] +T5211.hs:5:1: warning: [GHC-66111] [-Wunused-imports (in -Wextra)] The qualified import of ‘Foreign.Storable’ is redundant except perhaps to import instances from ‘Foreign.Storable’ To import instances alone, use: import Foreign.Storable() diff --git a/testsuite/tests/rename/should_fail/T7164.stderr b/testsuite/tests/rename/should_fail/T7164.stderr index 8049b27cde..732f8a1040 100644 --- a/testsuite/tests/rename/should_fail/T7164.stderr +++ b/testsuite/tests/rename/should_fail/T7164.stderr @@ -1,5 +1,5 @@ -T7164.hs:8:1: +T7164.hs:8:1: [GHC-29916] Multiple declarations of ‘derp’ Declared at: T7164.hs:5:5 T7164.hs:8:1 diff --git a/testsuite/tests/rename/should_fail/T7454.stderr b/testsuite/tests/rename/should_fail/T7454.stderr index ba9666cf35..2eb477b9ff 100644 --- a/testsuite/tests/rename/should_fail/T7454.stderr +++ b/testsuite/tests/rename/should_fail/T7454.stderr @@ -1,3 +1,3 @@ -T7454.hs:5:23: warning: [-Wunused-imports (in -Wextra)] +T7454.hs:5:23: warning: [GHC-38856] [-Wunused-imports (in -Wextra)] The import of ‘Arrow’ from module ‘Control.Arrow’ is redundant diff --git a/testsuite/tests/rename/should_fail/T8149.stderr b/testsuite/tests/rename/should_fail/T8149.stderr index 33b45e9598..c25cd8eb87 100644 --- a/testsuite/tests/rename/should_fail/T8149.stderr +++ b/testsuite/tests/rename/should_fail/T8149.stderr @@ -1,4 +1,4 @@ -T8149.hs:5:36: warning: [-Wunused-imports (in -Wextra)] +T8149.hs:5:36: warning: [GHC-38856] [-Wunused-imports (in -Wextra)] The import of ‘WriterT’ from module ‘Control.Monad.Trans.Writer’ is redundant diff --git a/testsuite/tests/rename/should_fail/T9032.stderr b/testsuite/tests/rename/should_fail/T9032.stderr index 21af9ac713..b64e7f0e26 100644 --- a/testsuite/tests/rename/should_fail/T9032.stderr +++ b/testsuite/tests/rename/should_fail/T9032.stderr @@ -1,2 +1,3 @@ -T9032.hs:6:1: A module cannot import itself: T9032 +T9032.hs:6:1: [GHC-43281] + A module cannot import itself: T9032 diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 53f6028f9c..7ea8d6fd3a 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -195,3 +195,5 @@ test('RnDefaultSigFail', normal, compile_fail, ['']) test('RnMultipleMinimalPragmaFail', normal, compile_fail, ['']) test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) +test('PackageImportsDisabled', normal, compile_fail, ['']) +test('ImportLookupIllegal', normal, compile_fail, ['']) diff --git a/testsuite/tests/rename/should_fail/rn_dup.stderr b/testsuite/tests/rename/should_fail/rn_dup.stderr index 907fc38fe8..7ebcb0ec33 100644 --- a/testsuite/tests/rename/should_fail/rn_dup.stderr +++ b/testsuite/tests/rename/should_fail/rn_dup.stderr @@ -1,10 +1,10 @@ -rn_dup.hs:9:10: error: +rn_dup.hs:9:10: error: [GHC-29916] Multiple declarations of ‘MkT’ Declared at: rn_dup.hs:7:16 rn_dup.hs:9:10 -rn_dup.hs:9:10: error: +rn_dup.hs:9:10: error: [GHC-29916] Multiple declarations of ‘MkT’ Declared at: rn_dup.hs:7:10 rn_dup.hs:9:10 @@ -12,17 +12,17 @@ rn_dup.hs:9:10: error: rn_dup.hs:11:27: error: [GHC-85524] Duplicate field name ‘rf’ in record declaration -rn_dup.hs:12:16: error: +rn_dup.hs:12:16: error: [GHC-29916] Multiple declarations of ‘rf’ Declared at: rn_dup.hs:11:27 rn_dup.hs:12:16 -rn_dup.hs:17:3: error: +rn_dup.hs:17:3: error: [GHC-29916] Multiple declarations of ‘CT’ Declared at: rn_dup.hs:15:3 rn_dup.hs:17:3 -rn_dup.hs:18:3: error: +rn_dup.hs:18:3: error: [GHC-29916] Multiple declarations of ‘f’ Declared at: rn_dup.hs:16:3 rn_dup.hs:18:3 diff --git a/testsuite/tests/rename/should_fail/rnfail002.stderr b/testsuite/tests/rename/should_fail/rnfail002.stderr index ffa05e767d..f68952bd4f 100644 --- a/testsuite/tests/rename/should_fail/rnfail002.stderr +++ b/testsuite/tests/rename/should_fail/rnfail002.stderr @@ -1,5 +1,5 @@ -rnfail002.hs:6:1: +rnfail002.hs:6:1: [GHC-29916] Multiple declarations of ‘y’ Declared at: rnfail002.hs:5:1 rnfail002.hs:6:1 diff --git a/testsuite/tests/rename/should_fail/rnfail003.stderr b/testsuite/tests/rename/should_fail/rnfail003.stderr index 24c74a6cbb..8d5d8183ea 100644 --- a/testsuite/tests/rename/should_fail/rnfail003.stderr +++ b/testsuite/tests/rename/should_fail/rnfail003.stderr @@ -1,5 +1,5 @@ -rnfail003.hs:4:1: +rnfail003.hs:4:1: [GHC-29916] Multiple declarations of ‘f’ Declared at: rnfail003.hs:2:1 rnfail003.hs:4:1 diff --git a/testsuite/tests/rename/should_fail/rnfail009.stderr b/testsuite/tests/rename/should_fail/rnfail009.stderr index d8d3fa5fcc..dcd35ef164 100644 --- a/testsuite/tests/rename/should_fail/rnfail009.stderr +++ b/testsuite/tests/rename/should_fail/rnfail009.stderr @@ -1,5 +1,5 @@ -rnfail009.hs:5:10: +rnfail009.hs:5:10: [GHC-29916] Multiple declarations of ‘A’ Declared at: rnfail009.hs:3:10 rnfail009.hs:5:10 diff --git a/testsuite/tests/rename/should_fail/rnfail010.stderr b/testsuite/tests/rename/should_fail/rnfail010.stderr index bd20f39188..7bfedd4b23 100644 --- a/testsuite/tests/rename/should_fail/rnfail010.stderr +++ b/testsuite/tests/rename/should_fail/rnfail010.stderr @@ -1,5 +1,5 @@ -rnfail010.hs:6:1: +rnfail010.hs:6:1: [GHC-29916] Multiple declarations of ‘f’ Declared at: rnfail010.hs:2:1 rnfail010.hs:6:1 diff --git a/testsuite/tests/rename/should_fail/rnfail011.stderr b/testsuite/tests/rename/should_fail/rnfail011.stderr index 0d55b36f50..2a15ab2dc4 100644 --- a/testsuite/tests/rename/should_fail/rnfail011.stderr +++ b/testsuite/tests/rename/should_fail/rnfail011.stderr @@ -1,5 +1,5 @@ -rnfail011.hs:6:1: +rnfail011.hs:6:1: [GHC-29916] Multiple declarations of ‘A’ Declared at: rnfail011.hs:2:1 rnfail011.hs:6:1 diff --git a/testsuite/tests/rename/should_fail/rnfail012.stderr b/testsuite/tests/rename/should_fail/rnfail012.stderr index 833256a1ca..a0d2293249 100644 --- a/testsuite/tests/rename/should_fail/rnfail012.stderr +++ b/testsuite/tests/rename/should_fail/rnfail012.stderr @@ -1,5 +1,5 @@ -rnfail012.hs:8:1: +rnfail012.hs:8:1: [GHC-29916] Multiple declarations of ‘A’ Declared at: rnfail012.hs:2:1 rnfail012.hs:8:1 diff --git a/testsuite/tests/rename/should_fail/rnfail013.stderr b/testsuite/tests/rename/should_fail/rnfail013.stderr index ae2ead8fc4..fbd225456b 100644 --- a/testsuite/tests/rename/should_fail/rnfail013.stderr +++ b/testsuite/tests/rename/should_fail/rnfail013.stderr @@ -1,5 +1,5 @@ -rnfail013.hs:7:11: +rnfail013.hs:7:11: [GHC-29916] Multiple declarations of ‘MkT’ Declared at: rnfail013.hs:5:11 rnfail013.hs:7:11 diff --git a/testsuite/tests/rename/should_fail/rnfail015.stderr b/testsuite/tests/rename/should_fail/rnfail015.stderr index 8edd5e3740..2d92dcf859 100644 --- a/testsuite/tests/rename/should_fail/rnfail015.stderr +++ b/testsuite/tests/rename/should_fail/rnfail015.stderr @@ -1,5 +1,5 @@ -rnfail015.hs:14:9: +rnfail015.hs:14:9: [GHC-29916] Multiple declarations of ‘TokLiteral’ Declared at: rnfail015.hs:8:9 rnfail015.hs:14:9 diff --git a/testsuite/tests/rename/should_fail/rnfail043.stderr b/testsuite/tests/rename/should_fail/rnfail043.stderr index 3547ac55b9..7c3d1f3ed7 100644 --- a/testsuite/tests/rename/should_fail/rnfail043.stderr +++ b/testsuite/tests/rename/should_fail/rnfail043.stderr @@ -1,5 +1,5 @@ -rnfail043.hs:10:1: +rnfail043.hs:10:1: [GHC-29916] Multiple declarations of ‘f’ Declared at: rnfail043.hs:6:1 rnfail043.hs:10:1 diff --git a/testsuite/tests/safeHaskell/safeInfered/Mixed01.stderr b/testsuite/tests/safeHaskell/safeInfered/Mixed01.stderr index 1d8bcf1cd4..eff0bf7a43 100644 --- a/testsuite/tests/safeHaskell/safeInfered/Mixed01.stderr +++ b/testsuite/tests/safeHaskell/safeInfered/Mixed01.stderr @@ -1,4 +1,5 @@ -Mixed01.hs:5:1: +Mixed01.hs:5:1: [GHC-26971] safe import can't be used as Safe Haskell isn't on! - please enable Safe Haskell through either Safe, Trustworthy or Unsafe + Suggested fix: + Enable Safe Haskell through either Safe, Trustworthy or Unsafe. diff --git a/testsuite/tests/th/T8932.stderr b/testsuite/tests/th/T8932.stderr index 4dbbfe620a..82d94d79fe 100644 --- a/testsuite/tests/th/T8932.stderr +++ b/testsuite/tests/th/T8932.stderr @@ -1,5 +1,5 @@ -T8932.hs:11:1: error: +T8932.hs:11:1: error: [GHC-29916] Multiple declarations of ‘foo’ Declared at: T8932.hs:5:2 T8932.hs:11:1 diff --git a/testsuite/tests/th/TH_dupdecl.stderr b/testsuite/tests/th/TH_dupdecl.stderr index c44ba63098..089d8c1552 100644 --- a/testsuite/tests/th/TH_dupdecl.stderr +++ b/testsuite/tests/th/TH_dupdecl.stderr @@ -1,5 +1,5 @@ -TH_dupdecl.hs:10:2: error: +TH_dupdecl.hs:10:2: error: [GHC-29916] Multiple declarations of ‘x’ Declared at: TH_dupdecl.hs:8:2 TH_dupdecl.hs:10:2 diff --git a/testsuite/tests/type-data/should_fail/TDMultiple01.stderr b/testsuite/tests/type-data/should_fail/TDMultiple01.stderr index 5b3abe33ed..265c21c28b 100644 --- a/testsuite/tests/type-data/should_fail/TDMultiple01.stderr +++ b/testsuite/tests/type-data/should_fail/TDMultiple01.stderr @@ -1,5 +1,5 @@ -TDMultiple01.hs:5:18: +TDMultiple01.hs:5:18: [GHC-29916] Multiple declarations of ‘P’ Declared at: TDMultiple01.hs:4:1 TDMultiple01.hs:5:18 diff --git a/testsuite/tests/type-data/should_fail/TDMultiple02.stderr b/testsuite/tests/type-data/should_fail/TDMultiple02.stderr index c08709fa8c..8b1520c1ea 100644 --- a/testsuite/tests/type-data/should_fail/TDMultiple02.stderr +++ b/testsuite/tests/type-data/should_fail/TDMultiple02.stderr @@ -1,5 +1,5 @@ -TDMultiple02.hs:5:18: +TDMultiple02.hs:5:18: [GHC-29916] Multiple declarations of ‘P’ Declared at: TDMultiple02.hs:4:1 TDMultiple02.hs:5:18 diff --git a/testsuite/tests/type-data/should_fail/TDPunning.stderr b/testsuite/tests/type-data/should_fail/TDPunning.stderr index 95ddbf51d3..6320a0d56d 100644 --- a/testsuite/tests/type-data/should_fail/TDPunning.stderr +++ b/testsuite/tests/type-data/should_fail/TDPunning.stderr @@ -1,5 +1,5 @@ -TDPunning.hs:4:15: +TDPunning.hs:4:15: [GHC-29916] Multiple declarations of ‘T’ Declared at: TDPunning.hs:4:1 TDPunning.hs:4:15 diff --git a/testsuite/tests/warnings/should_compile/DeprU.stderr b/testsuite/tests/warnings/should_compile/DeprU.stderr index a458dc4f2b..9de0ab31ff 100644 --- a/testsuite/tests/warnings/should_compile/DeprU.stderr +++ b/testsuite/tests/warnings/should_compile/DeprU.stderr @@ -1,7 +1,7 @@ [1 of 2] Compiling DeprM ( DeprM.hs, DeprM.o ) [2 of 2] Compiling A ( DeprU.hs, DeprU.o ) -DeprU.hs:3:1: warning: [-Wdeprecations (in -Wextended-warnings)] +DeprU.hs:3:1: warning: [GHC-15328] [-Wdeprecations (in -Wextended-warnings)] Module ‘DeprM’ is deprecated: "Here can be your menacing deprecation warning!" diff --git a/testsuite/tests/warnings/should_compile/DodgyImports.hs b/testsuite/tests/warnings/should_compile/DodgyImports.hs new file mode 100644 index 0000000000..2361832409 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/DodgyImports.hs @@ -0,0 +1,3 @@ +module DodgyImports where + +import Data.Semigroup (ArgMin (..)) diff --git a/testsuite/tests/warnings/should_compile/DodgyImports.stderr b/testsuite/tests/warnings/should_compile/DodgyImports.stderr new file mode 100644 index 0000000000..de90c743f2 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/DodgyImports.stderr @@ -0,0 +1,4 @@ +DodgyImports.hs:3:24: warning: [GHC-99623] [-Wdodgy-imports (in -Wextra)] + The import item ‘Data.Semigroup.ArgMin(..)’ suggests that + ‘Data.Semigroup.ArgMin’ has (in-scope) constructors or record fields, + but it has none diff --git a/testsuite/tests/warnings/should_compile/DodgyImports_hiding.hs b/testsuite/tests/warnings/should_compile/DodgyImports_hiding.hs new file mode 100644 index 0000000000..e810b3cf27 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/DodgyImports_hiding.hs @@ -0,0 +1,3 @@ +module DodgyImports_hiding where + +import Data.Semigroup hiding (ArgMin (..)) diff --git a/testsuite/tests/warnings/should_compile/DodgyImports_hiding.stderr b/testsuite/tests/warnings/should_compile/DodgyImports_hiding.stderr new file mode 100644 index 0000000000..4a30f78b16 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/DodgyImports_hiding.stderr @@ -0,0 +1,4 @@ +DodgyImports_hiding.hs:3:31: warning: [GHC-99623] [-Wdodgy-imports (in -Wextra)] + The import item ‘Data.Semigroup.ArgMin(..)’ suggests that + ‘Data.Semigroup.ArgMin’ has (in-scope) constructors or record fields, + but it has none diff --git a/testsuite/tests/warnings/should_compile/T10890/T10890_2.stderr b/testsuite/tests/warnings/should_compile/T10890/T10890_2.stderr index d676ca9556..3b803dfec3 100644 --- a/testsuite/tests/warnings/should_compile/T10890/T10890_2.stderr +++ b/testsuite/tests/warnings/should_compile/T10890/T10890_2.stderr @@ -1,5 +1,5 @@ -T10890_2.hs:12:1: warning: [-Wunused-imports (in -Wextra)] +T10890_2.hs:12:1: warning: [GHC-66111] [-Wunused-imports (in -Wextra)] The import of ‘T10890_2B’ is redundant except perhaps to import instances from ‘T10890_2B’ To import instances alone, use: import T10890_2B() diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T index 0c8c2f6a5d..f001e40164 100644 --- a/testsuite/tests/warnings/should_compile/all.T +++ b/testsuite/tests/warnings/should_compile/all.T @@ -60,3 +60,5 @@ test('T20312', normal, compile,['-Wall']) test('T22151', normal, compile, ['-Wredundant-constraints']) test('T22759', normal, compile, ['']) test('T22676', [extra_files(['src'])], multimod_compile, ['src.hs', '-working-dir src -Wmissing-home-modules -v0']) +test('DodgyImports', normal, compile, ['-Wdodgy-imports']) +test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports']) diff --git a/testsuite/tests/warnings/should_fail/WarningCategory1.stderr b/testsuite/tests/warnings/should_fail/WarningCategory1.stderr index 1d86cedab1..95148407a4 100644 --- a/testsuite/tests/warnings/should_fail/WarningCategory1.stderr +++ b/testsuite/tests/warnings/should_fail/WarningCategory1.stderr @@ -1,5 +1,5 @@ -WarningCategory1.hs:4:1: error: [-Wx-module-warning-42 (in -Wextended-warnings), -Werror=x-module-warning-42] +WarningCategory1.hs:4:1: error: [GHC-15328] [-Wx-module-warning-42 (in -Wextended-warnings), -Werror=x-module-warning-42] Module ‘WarningCategoryModule’: "Module-level warning" WarningCategory1.hs:7:8: error: [GHC-63394] [-Wx-dangerous (in -Wextended-warnings), -Werror=x-dangerous] diff --git a/testsuite/tests/warnings/should_fail/WarningCategory2.stderr b/testsuite/tests/warnings/should_fail/WarningCategory2.stderr index 6b8faed762..af2e9aa5e2 100644 --- a/testsuite/tests/warnings/should_fail/WarningCategory2.stderr +++ b/testsuite/tests/warnings/should_fail/WarningCategory2.stderr @@ -1,5 +1,5 @@ -WarningCategory1.hs:4:1: error: [-Wx-module-warning-42 (in -Wextended-warnings), -Werror=x-module-warning-42] +WarningCategory1.hs:4:1: error: [GHC-15328] [-Wx-module-warning-42 (in -Wextended-warnings), -Werror=x-module-warning-42] Module ‘WarningCategoryModule’: "Module-level warning" WarningCategory1.hs:7:8: error: [GHC-63394] [-Wx-dangerous (in -Wextended-warnings), -Werror=x-dangerous] diff --git a/testsuite/tests/warnings/should_fail/WarningCategory5.stderr b/testsuite/tests/warnings/should_fail/WarningCategory5.stderr index 536a40bc25..aa10de3563 100644 --- a/testsuite/tests/warnings/should_fail/WarningCategory5.stderr +++ b/testsuite/tests/warnings/should_fail/WarningCategory5.stderr @@ -1,5 +1,5 @@ -WarningCategory1.hs:4:1: warning: [-Wx-module-warning-42 (in -Wextended-warnings)] +WarningCategory1.hs:4:1: warning: [GHC-15328] [-Wx-module-warning-42 (in -Wextended-warnings)] Module ‘WarningCategoryModule’: "Module-level warning" WarningCategory1.hs:7:8: error: [GHC-63394] [-Wx-dangerous (in -Wextended-warnings), -Werror=x-dangerous] diff --git a/testsuite/tests/warnings/should_fail/WarningCategory7.stderr b/testsuite/tests/warnings/should_fail/WarningCategory7.stderr index 1d86cedab1..95148407a4 100644 --- a/testsuite/tests/warnings/should_fail/WarningCategory7.stderr +++ b/testsuite/tests/warnings/should_fail/WarningCategory7.stderr @@ -1,5 +1,5 @@ -WarningCategory1.hs:4:1: error: [-Wx-module-warning-42 (in -Wextended-warnings), -Werror=x-module-warning-42] +WarningCategory1.hs:4:1: error: [GHC-15328] [-Wx-module-warning-42 (in -Wextended-warnings), -Werror=x-module-warning-42] Module ‘WarningCategoryModule’: "Module-level warning" WarningCategory1.hs:7:8: error: [GHC-63394] [-Wx-dangerous (in -Wextended-warnings), -Werror=x-dangerous] -- cgit v1.2.1