diff options
author | Andrei Borzenkov <andreyborzenkov2002@gmail.com> | 2023-01-23 19:43:29 +0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-01-28 02:59:18 -0500 |
commit | 50b1e2e8141fb1a3d1d3c1563935d08e90dca11a (patch) | |
tree | 99dda3c3e67265324312c8e8b2b4577b31b02809 | |
parent | 082b7d43ee4b8203dc9bca53e5e1f7a45c42eeb8 (diff) | |
download | haskell-50b1e2e8141fb1a3d1d3c1563935d08e90dca11a.tar.gz |
Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115)
I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind
module. Instead, these TcRnMessage messages were introduced:
TcRnMultipleFixityDecls
TcRnIllegalPatternSynonymDecl
TcRnIllegalClassBiding
TcRnOrphanCompletePragma
TcRnEmptyCase
TcRnNonStdGuards
TcRnDuplicateSigDecl
TcRnMisplacedSigDecl
TcRnUnexpectedDefaultSig
TcRnBindInBootFile
TcRnDuplicateMinimalSig
31 files changed, 419 insertions, 113 deletions
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs index fa5c7b8532..0849c9810f 100644 --- a/compiler/GHC/Rename/Bind.hs +++ b/compiler/GHC/Rename/Bind.hs @@ -72,8 +72,7 @@ import qualified GHC.LanguageExtensions as LangExt import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import Control.Monad -import Data.Foldable ( toList ) -import Data.List ( partition, sortBy ) +import Data.List ( partition ) import Data.List.NonEmpty ( NonEmpty(..) ) {- @@ -690,16 +689,10 @@ makeMiniFixityEnv decls = foldlM add_one_sig emptyFsEnv decls Nothing -> return $ extendFsEnv env fs fix_item Just (L loc' _) -> do { setSrcSpan loc $ - addErrAt name_loc (dupFixityDecl loc' name) + addErrAt name_loc (TcRnMultipleFixityDecls loc' name) ; return env} } -dupFixityDecl :: SrcSpan -> RdrName -> TcRnMessage -dupFixityDecl loc rdr_name - = mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [text "Multiple fixity declarations for" <+> quotes (ppr rdr_name), - text "also at " <+> ppr loc] - {- ********************************************************************* * * @@ -716,7 +709,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name , psb_dir = dir }) -- invariant: no free vars here when it's a FunBind = do { pattern_synonym_ok <- xoptM LangExt.PatternSynonyms - ; unless pattern_synonym_ok (addErr patternSynonymErr) + ; unless pattern_synonym_ok (addErr TcRnIllegalPatternSynonymDecl) ; let scoped_tvs = sig_fn name ; ((pat', details'), fvs1) <- bindSigTyVarsFV scoped_tvs $ @@ -785,11 +778,6 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name -- See Note [Renaming pattern synonym variables] lookupPatSynBndr = wrapLocMA lookupLocalOccRn - patternSynonymErr :: TcRnMessage - patternSynonymErr - = mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Illegal pattern synonym declaration") - 2 (text "Use -XPatternSynonyms to enable this extension") {- Note [Renaming pattern synonym variables] @@ -943,18 +931,11 @@ rnMethodBindLHS _ cls (L loc bind@(FunBind { fun_id = name })) rest -- Report error for all other forms of bindings -- This is why we use a fold rather than map rnMethodBindLHS is_cls_decl _ (L loc bind) rest - = do { addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ what <+> text "not allowed in" <+> decl_sort - , nest 2 (ppr bind) ] + = do { addErrAt (locA loc) $ TcRnIllegalClassBinding decl_sort bind ; return rest } where - decl_sort | is_cls_decl = text "class declaration:" - | otherwise = text "instance declaration:" - what = case bind of - PatBind {} -> text "Pattern bindings (except simple variables)" - PatSynBind {} -> text "Pattern synonyms" - -- Associated pattern synonyms are not implemented yet - _ -> pprPanic "rnMethodBind" (ppr bind) + decl_sort | is_cls_decl = ClassDeclSort + | otherwise = InstanceDeclSort {- ************************************************************************ @@ -1009,7 +990,7 @@ renameSig ctxt sig@(TypeSig _ vs ty) renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty) = do { defaultSigs_on <- xoptM LangExt.DefaultSignatures ; when (is_deflt && not defaultSigs_on) $ - addErr (defaultSigErr sig) + addErr (TcRnUnexpectedDefaultSig sig) ; mapM_ warnForallIdentifier vs ; new_v <- mapM (lookupSigOccRnN ctxt sig) vs ; (new_ty, fvs) <- rnHsSigType ty_ctxt TypeLevel ty @@ -1083,15 +1064,10 @@ renameSig _ctxt sig@(CompleteMatchSig (_, s) (L l bf) mty) this_mod <- fmap tcg_mod getGblEnv unless (any (nameIsLocalOrFrom this_mod . unLoc) new_bf) $ -- Why 'any'? See Note [Orphan COMPLETE pragmas] - addErrCtxt (text "In" <+> ppr sig) $ failWithTc orphanError + addErrCtxt (text "In" <+> ppr sig) $ failWithTc TcRnOrphanCompletePragma return (CompleteMatchSig (noAnn, s) (L l new_bf) new_mty, emptyFVs) - where - orphanError :: TcRnMessage - orphanError = mkTcRnUnknownMessage $ mkPlainError noHints $ - text "Orphan COMPLETE pragmas not supported" $$ - text "A COMPLETE pragma must mention at least one data constructor" $$ - text "or pattern synonym defined in the same module." + {- Note [Orphan COMPLETE pragmas] @@ -1196,7 +1172,7 @@ findDupSigs sigs checkDupMinimalSigs :: [LSig GhcPs] -> RnM () checkDupMinimalSigs sigs = case filter isMinimalLSig sigs of - minSigs@(_:_:_) -> dupMinimalSigErr minSigs + sig1 : sig2 : otherSigs -> dupMinimalSigErr sig1 sig2 otherSigs _ -> return () {- @@ -1246,7 +1222,7 @@ rnMatchGroup :: (Outputable (body GhcPs), AnnoBody body) => HsMatchContext GhcRn -> RnM (MatchGroup GhcRn (LocatedA (body GhcRn)), FreeVars) rnMatchGroup ctxt rnBody (MG { mg_alts = L lm ms, mg_ext = origin }) -- see Note [Empty MatchGroups] - = do { whenM ((null ms &&) <$> mustn't_be_empty) (addErr (emptyCaseErr ctxt)) + = do { whenM ((null ms &&) <$> mustn't_be_empty) (addErr (TcRnEmptyCase ctxt)) ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms ; return (mkMatchGroup origin (L lm new_ms), ms_fvs) } where @@ -1277,29 +1253,6 @@ rnMatch' ctxt rnBody (Match { m_ctxt = mf, m_pats = pats, m_grhss = grhss }) ; return (Match { m_ext = noAnn, m_ctxt = mf', m_pats = pats' , m_grhss = grhss'}, grhss_fvs ) } -emptyCaseErr :: HsMatchContext GhcRn -> TcRnMessage -emptyCaseErr ctxt = mkTcRnUnknownMessage $ mkPlainError noHints $ message ctxt - where - pp_ctxt :: HsMatchContext GhcRn -> SDoc - pp_ctxt c = case c of - CaseAlt -> text "case expression" - LamCaseAlt LamCase -> text "\\case expression" - ArrowMatchCtxt (ArrowLamCaseAlt LamCase) -> text "\\case command" - ArrowMatchCtxt ArrowCaseAlt -> text "case command" - ArrowMatchCtxt KappaExpr -> text "kappa abstraction" - _ -> text "(unexpected)" - <+> pprMatchContextNoun c - - message :: HsMatchContext GhcRn -> SDoc - message (LamCaseAlt LamCases) = lcases_msg <+> text "expression" - message (ArrowMatchCtxt (ArrowLamCaseAlt LamCases)) = - lcases_msg <+> text "command" - message ctxt = - hang (text "Empty list of alternatives in" <+> pp_ctxt ctxt) - 2 (text "Use EmptyCase to allow this") - - lcases_msg = - text "Empty list of alternatives is not allowed in \\cases" {- ************************************************************************ @@ -1336,9 +1289,7 @@ rnGRHS' ctxt rnBody (GRHS _ guards rhs) rnBody rhs ; unless (pattern_guards_allowed || is_standard_guard guards') $ - let diag = mkTcRnUnknownMessage $ - mkPlainDiagnostic WarningWithoutFlag noHints (nonStdGuardErr guards') - in addDiagnostic diag + addDiagnostic (nonStdGuardErr guards') ; return (GRHS noAnn guards' rhs', fvs) } where @@ -1390,44 +1341,21 @@ rnSrcFixityDecl sig_ctxt = rn_decl -} dupSigDeclErr :: NonEmpty (LocatedN RdrName, Sig GhcPs) -> RnM () -dupSigDeclErr pairs@((L loc name, sig) :| _) - = addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ text "Duplicate" <+> what_it_is - <> text "s for" <+> quotes (ppr name) - , text "at" <+> vcat (map ppr $ sortBy SrcLoc.leftmost_smallest - $ map (getLocA . fst) - $ toList pairs) - ] - where - what_it_is = hsSigDoc sig +dupSigDeclErr pairs@((L loc _, _) :| _) + = addErrAt (locA loc) $ TcRnDuplicateSigDecl pairs misplacedSigErr :: LSig GhcRn -> RnM () misplacedSigErr (L loc sig) - = addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ - sep [text "Misplaced" <+> hsSigDoc sig <> colon, ppr sig] - -defaultSigErr :: Sig GhcPs -> TcRnMessage -defaultSigErr sig = mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ hang (text "Unexpected default signature:") - 2 (ppr sig) - , text "Use DefaultSignatures to enable default signatures" ] + = addErrAt (locA loc) $ TcRnMisplacedSigDecl sig bindInHsBootFileErr :: LHsBindLR GhcRn GhcPs -> RnM () -bindInHsBootFileErr (L loc _) - = addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ text "Bindings in hs-boot files are not allowed" ] +bindInHsBootFileErr (L loc _) = addErrAt (locA loc) TcRnBindInBootFile nonStdGuardErr :: (Outputable body, Anno (Stmt GhcRn body) ~ SrcSpanAnnA) - => [LStmtLR GhcRn GhcRn body] -> SDoc -nonStdGuardErr guards - = hang (text "accepting non-standard pattern guards (use PatternGuards to suppress this message)") - 4 (interpp'SP guards) - -dupMinimalSigErr :: [LSig GhcPs] -> RnM () -dupMinimalSigErr sigs@(L loc _ : _) - = addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ text "Multiple minimal complete definitions" - , text "at" <+> vcat (map ppr $ sortBy SrcLoc.leftmost_smallest $ map getLocA sigs) - , text "Combine alternative minimal complete definitions with `|'" ] -dupMinimalSigErr [] = panic "dupMinimalSigErr" + => [LStmtLR GhcRn GhcRn body] -> TcRnMessage +nonStdGuardErr guards = TcRnNonStdGuards (NonStandardGuards guards) + +dupMinimalSigErr :: LSig GhcPs -> LSig GhcPs -> [LSig GhcPs] -> RnM () +dupMinimalSigErr sig1 sig2 otherSigs + = addErrAt (getLocA sig1) $ TcRnDuplicateMinimalSig sig1 sig2 otherSigs diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 3d6dfab2a4..9880c13a9c 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -1241,6 +1241,71 @@ instance Diagnostic TcRnMessage where <+> ppr (nameSrcLoc lcl_name) TcRnBindingOfExistingName name -> mkSimpleDecorated $ text "Illegal binding of an existing name:" <+> ppr (filterCTuple name) + TcRnMultipleFixityDecls loc rdr_name -> mkSimpleDecorated $ + vcat [text "Multiple fixity declarations for" <+> quotes (ppr rdr_name), + text "also at " <+> ppr loc] + TcRnIllegalPatternSynonymDecl -> mkSimpleDecorated $ + text "Illegal pattern synonym declaration" + TcRnIllegalClassBinding dsort bind -> mkSimpleDecorated $ + vcat [ what <+> text "not allowed in" <+> decl_sort + , nest 2 (ppr bind) ] + where + decl_sort = case dsort of + ClassDeclSort -> text "class declaration:" + InstanceDeclSort -> text "instance declaration:" + what = case bind of + PatBind {} -> text "Pattern bindings (except simple variables)" + PatSynBind {} -> text "Pattern synonyms" + -- Associated pattern synonyms are not implemented yet + _ -> pprPanic "rnMethodBind" (ppr bind) + TcRnOrphanCompletePragma -> mkSimpleDecorated $ + text "Orphan COMPLETE pragmas not supported" $$ + text "A COMPLETE pragma must mention at least one data constructor" $$ + text "or pattern synonym defined in the same module." + TcRnEmptyCase ctxt -> mkSimpleDecorated message + where + pp_ctxt = case ctxt of + CaseAlt -> text "case expression" + LamCaseAlt LamCase -> text "\\case expression" + ArrowMatchCtxt (ArrowLamCaseAlt LamCase) -> text "\\case command" + ArrowMatchCtxt ArrowCaseAlt -> text "case command" + ArrowMatchCtxt KappaExpr -> text "kappa abstraction" + _ -> text "(unexpected)" + <+> pprMatchContextNoun ctxt + + message = case ctxt of + LamCaseAlt LamCases -> lcases_msg <+> text "expression" + ArrowMatchCtxt (ArrowLamCaseAlt LamCases) -> lcases_msg <+> text "command" + _ -> text "Empty list of alternatives in" <+> pp_ctxt + + lcases_msg = + text "Empty list of alternatives is not allowed in \\cases" + TcRnNonStdGuards (NonStandardGuards guards) -> mkSimpleDecorated $ + text "accepting non-standard pattern guards" $$ + nest 4 (interpp'SP guards) + TcRnDuplicateSigDecl pairs@((L _ name, sig) :| _) -> mkSimpleDecorated $ + vcat [ text "Duplicate" <+> what_it_is + <> text "s for" <+> quotes (ppr name) + , text "at" <+> vcat (map ppr $ sortBy leftmost_smallest + $ map (getLocA . fst) + $ NE.toList pairs) + ] + where + what_it_is = hsSigDoc sig + TcRnMisplacedSigDecl sig -> mkSimpleDecorated $ + sep [text "Misplaced" <+> hsSigDoc sig <> colon, ppr sig] + TcRnUnexpectedDefaultSig sig -> mkSimpleDecorated $ + hang (text "Unexpected default signature:") + 2 (ppr sig) + TcRnBindInBootFile -> mkSimpleDecorated $ + text "Bindings in hs-boot files are not allowed" + TcRnDuplicateMinimalSig sig1 sig2 otherSigs -> mkSimpleDecorated $ + vcat [ text "Multiple minimal complete definitions" + , text "at" <+> vcat (map ppr $ sortBy leftmost_smallest $ map getLocA sigs) + , text "Combine alternative minimal complete definitions with `|'" ] + where + sigs = sig1 : sig2 : otherSigs + diagnosticReason = \case TcRnUnknownMessage m @@ -1647,6 +1712,28 @@ instance Diagnostic TcRnMessage where -> WarningWithFlag Opt_WarnTermVariableCapture TcRnBindingOfExistingName{} -> ErrorWithoutFlag + TcRnMultipleFixityDecls{} + -> ErrorWithoutFlag + TcRnIllegalPatternSynonymDecl{} + -> ErrorWithoutFlag + TcRnIllegalClassBinding{} + -> ErrorWithoutFlag + TcRnOrphanCompletePragma{} + -> ErrorWithoutFlag + TcRnEmptyCase{} + -> ErrorWithoutFlag + TcRnNonStdGuards{} + -> WarningWithoutFlag + TcRnDuplicateSigDecl{} + -> ErrorWithoutFlag + TcRnMisplacedSigDecl{} + -> ErrorWithoutFlag + TcRnUnexpectedDefaultSig{} + -> ErrorWithoutFlag + TcRnBindInBootFile{} + -> ErrorWithoutFlag + TcRnDuplicateMinimalSig{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2062,6 +2149,30 @@ instance Diagnostic TcRnMessage where -> [SuggestRenameTypeVariable] TcRnBindingOfExistingName{} -> noHints + TcRnMultipleFixityDecls{} + -> noHints + TcRnIllegalPatternSynonymDecl{} + -> [suggestExtension LangExt.PatternSynonyms] + TcRnIllegalClassBinding{} + -> noHints + TcRnOrphanCompletePragma{} + -> noHints + TcRnEmptyCase ctxt -> case ctxt of + LamCaseAlt LamCases -> noHints -- cases syntax doesn't support empty case. + ArrowMatchCtxt (ArrowLamCaseAlt LamCases) -> noHints + _ -> [suggestExtension LangExt.EmptyCase] + TcRnNonStdGuards{} + -> [suggestExtension LangExt.PatternGuards] + TcRnDuplicateSigDecl{} + -> noHints + TcRnMisplacedSigDecl{} + -> noHints + TcRnUnexpectedDefaultSig{} + -> [suggestExtension LangExt.DefaultSignatures] + TcRnBindInBootFile{} + -> noHints + TcRnDuplicateMinimalSig{} + -> noHints diagnosticCode = constructorCode diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index c377e32eaa..c1b8461839 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -88,6 +88,8 @@ module GHC.Tc.Errors.Types ( , IllegalDecls(..) , EmptyStatementGroupErrReason(..) , UnexpectedStatement(..) + , DeclSort(..) + , NonStandardGuards(..) ) where import GHC.Prelude @@ -2762,6 +2764,165 @@ data TcRnMessage where th/T13968 -} TcRnBindingOfExistingName :: RdrName -> TcRnMessage + {-| TcRnMultipleFixityDecls is an error triggered by multiple + fixity declarations for the same operator. + + Example(s): + + infixr 6 $$ + infixl 4 $$ + + Test cases: rename/should_fail/RnMultipleFixityFail + -} + TcRnMultipleFixityDecls :: SrcSpan -> RdrName -> TcRnMessage + + {-| TcRnIllegalPatternSynonymDecl is an error thrown when a user + defines a pattern synonyms without enabling the PatternSynonyms extension. + + Example: + + pattern O :: Int + pattern O = 0 + + Test cases: rename/should_fail/RnPatternSynonymFail + -} + TcRnIllegalPatternSynonymDecl :: TcRnMessage + + {-| TcRnIllegalClassBinding is an error triggered by a binding + in a class or instance declaration of an illegal form. + + Examples: + + class ZeroOne a where + zero :: a + one :: a + instance ZeroOne Int where + (zero,one) = (0,1) + + class C a where + pattern P = () + + Test cases: module/mod48 + patsyn/should_fail/T9705-1 + patsyn/should_fail/T9705-2 + typecheck/should_fail/tcfail021 + + -} + TcRnIllegalClassBinding :: DeclSort -> HsBindLR GhcPs GhcPs -> TcRnMessage + + {-| TcRnOrphanCompletePragma is an error triggered by a {-# COMPLETE #-} + pragma which does not mention any data constructors or pattern synonyms + defined in the current module. + + Test cases: patsyn/should_fail/T13349 + -} + TcRnOrphanCompletePragma :: TcRnMessage + + {-| TcRnEmptyCase is an error thrown when a user uses + a case expression with an empty list of alternatives without + enabling the EmptyCase extension. + + Example(s): + + case () of + + Test cases: rename/should_fail/RnEmptyCaseFail + -} + TcRnEmptyCase :: HsMatchContext GhcRn -> TcRnMessage + + {-| TcRnNonStdGuards is a warning thrown when a user uses + non-standard guards (e.g. patterns in guards) without + enabling the PatternGuards extension. + More realistically: the user has explicitly disabled PatternGuards, + as it is enabled by default with `-XHaskell2010`. + + Example(s): + + f | 5 <- 2 + 3 = ... + + Test cases: rename/should_compile/rn049 + -} + TcRnNonStdGuards :: NonStandardGuards -> TcRnMessage + + {-| TcRnDuplicateSigDecl is an error triggered by two or more + signatures for one entity. + + Examples: + + f :: Int -> Bool + f :: Int -> Bool + f _ = True + + g x = x + {-# INLINE g #-} + {-# NOINLINE g #-} + + pattern P = () + {-# COMPLETE P #-} + {-# COMPLETE P #-} + + Test cases: module/mod68 + parser/should_fail/OpaqueParseFail4 + patsyn/should_fail/T12165 + rename/should_fail/rnfail048 + rename/should_fail/T5589 + rename/should_fail/T7338 + rename/should_fail/T7338a + -} + TcRnDuplicateSigDecl :: NE.NonEmpty (LocatedN RdrName, Sig GhcPs) -> TcRnMessage + + {-| TcRnMisplacedSigDecl is an error triggered by the pragma application + in the wrong context, like `MINIMAL` applied to a function or + `SPECIALIZE` to an instance. + + Example: + + f x = x + {-# MINIMAL f #-} + + Test cases: rename/should_fail/T18138 + warnings/minimal/WarnMinimalFail1 + -} + TcRnMisplacedSigDecl :: Sig GhcRn -> TcRnMessage + + {-| TcRnUnexpectedDefaultSig is an error thrown when a user uses + default signatures without enabling the DefaultSignatures extension. + + Example: + + class C a where + m :: a + default m :: Num a => a + m = 0 + + Test cases: rename/should_fail/RnDefaultSigFail + -} + TcRnUnexpectedDefaultSig :: Sig GhcPs -> TcRnMessage + + {-| TcRnBindInBootFile is an error triggered by a binding in hs-boot file. + + Example: + + -- in an .hs-boot file: + x = 3 + + Test cases: rename/should_fail/T19781 + -} + TcRnBindInBootFile :: TcRnMessage + + {-| TcRnDuplicateMinimalSig is an error triggered by two or more minimal + signatures for one type class. + + Example: + + class C where + f :: () + {-# MINIMAL f #-} + {-# MINIMAL f #-} + + Test cases: rename/should_fail/RnMultipleMinimalPragmaFail + -} + TcRnDuplicateMinimalSig :: LSig GhcPs -> LSig GhcPs -> [LSig GhcPs] -> TcRnMessage deriving Generic @@ -3991,3 +4152,12 @@ data UnexpectedStatement where :: Outputable (StmtLR GhcPs GhcPs body) => StmtLR GhcPs GhcPs body -> UnexpectedStatement + +data DeclSort = ClassDeclSort | InstanceDeclSort + +data NonStandardGuards where + NonStandardGuards + :: (Outputable body, + Anno (Stmt GhcRn body) ~ SrcSpanAnnA) + => [LStmtLR GhcRn GhcRn body] + -> NonStandardGuards diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs index c46320da0d..d7b57113ee 100644 --- a/compiler/GHC/Types/Error/Codes.hs +++ b/compiler/GHC/Types/Error/Codes.hs @@ -501,6 +501,17 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnNotOpenFamily" = 06207 GhcDiagnosticCode "TcRnCapturedTermName" = 54201 GhcDiagnosticCode "TcRnBindingOfExistingName" = 58805 + GhcDiagnosticCode "TcRnMultipleFixityDecls" = 50419 + GhcDiagnosticCode "TcRnIllegalPatternSynonymDecl" = 41507 + GhcDiagnosticCode "TcRnIllegalClassBinding" = 69248 + GhcDiagnosticCode "TcRnOrphanCompletePragma" = 93961 + GhcDiagnosticCode "TcRnEmptyCase" = 48010 + GhcDiagnosticCode "TcRnNonStdGuards" = 59119 + GhcDiagnosticCode "TcRnDuplicateSigDecl" = 31744 + GhcDiagnosticCode "TcRnMisplacedSigDecl" = 87866 + GhcDiagnosticCode "TcRnUnexpectedDefaultSig" = 40700 + GhcDiagnosticCode "TcRnBindInBootFile" = 11247 + GhcDiagnosticCode "TcRnDuplicateMinimalSig" = 85346 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 diff --git a/testsuite/tests/module/mod48.stderr b/testsuite/tests/module/mod48.stderr index d2e2652403..96e8f7cf62 100644 --- a/testsuite/tests/module/mod48.stderr +++ b/testsuite/tests/module/mod48.stderr @@ -1,4 +1,4 @@ -mod48.hs:5:3: error: +mod48.hs:5:3: error: [GHC-69248] Pattern bindings (except simple variables) not allowed in class declaration: (x, y) = error "foo" diff --git a/testsuite/tests/module/mod68.stderr b/testsuite/tests/module/mod68.stderr index 754124f15c..4d40083a44 100644 --- a/testsuite/tests/module/mod68.stderr +++ b/testsuite/tests/module/mod68.stderr @@ -1,5 +1,5 @@ -mod68.hs:4:1: +mod68.hs:4:1: error: [GHC-31744] Duplicate type signatures for ‘f’ at mod68.hs:3:1 mod68.hs:4:1 diff --git a/testsuite/tests/parser/should_fail/OpaqueParseFail4.stderr b/testsuite/tests/parser/should_fail/OpaqueParseFail4.stderr index 413b4fcc0c..529eb5f2ac 100644 --- a/testsuite/tests/parser/should_fail/OpaqueParseFail4.stderr +++ b/testsuite/tests/parser/should_fail/OpaqueParseFail4.stderr @@ -1,4 +1,5 @@ -OpaqueParseFail4.hs:6:12: error: + +OpaqueParseFail4.hs:6:12: error: [GHC-31744] Duplicate INLINE pragmas for ‘f’ at OpaqueParseFail4.hs:5:12 OpaqueParseFail4.hs:6:12 diff --git a/testsuite/tests/patsyn/should_fail/T12165.stderr b/testsuite/tests/patsyn/should_fail/T12165.stderr index 881e46905e..0787b79f1a 100644 --- a/testsuite/tests/patsyn/should_fail/T12165.stderr +++ b/testsuite/tests/patsyn/should_fail/T12165.stderr @@ -1,5 +1,5 @@ -T12165.hs:5:9: error: +T12165.hs:5:9: error: [GHC-31744] Duplicate pattern synonym signatures for ‘P’ at T12165.hs:4:9 T12165.hs:5:9 diff --git a/testsuite/tests/patsyn/should_fail/T13349.stderr b/testsuite/tests/patsyn/should_fail/T13349.stderr index 5bf91cbaa4..29b258870f 100644 --- a/testsuite/tests/patsyn/should_fail/T13349.stderr +++ b/testsuite/tests/patsyn/should_fail/T13349.stderr @@ -1,5 +1,5 @@ -T13349.hs:5:1: error: +T13349.hs:5:1: error: [GHC-93961] • Orphan COMPLETE pragmas not supported A COMPLETE pragma must mention at least one data constructor or pattern synonym defined in the same module. diff --git a/testsuite/tests/patsyn/should_fail/T9705-1.stderr b/testsuite/tests/patsyn/should_fail/T9705-1.stderr index 595b70362b..bf89d60be5 100644 --- a/testsuite/tests/patsyn/should_fail/T9705-1.stderr +++ b/testsuite/tests/patsyn/should_fail/T9705-1.stderr @@ -1,4 +1,4 @@ -T9705-1.hs:3:5: error: +T9705-1.hs:3:5: error: [GHC-69248] Pattern synonyms not allowed in class declaration: pattern P = () diff --git a/testsuite/tests/patsyn/should_fail/T9705-2.stderr b/testsuite/tests/patsyn/should_fail/T9705-2.stderr index 520480b2f9..60c75a36bb 100644 --- a/testsuite/tests/patsyn/should_fail/T9705-2.stderr +++ b/testsuite/tests/patsyn/should_fail/T9705-2.stderr @@ -1,4 +1,4 @@ -T9705-2.hs:6:5: error: +T9705-2.hs:6:5: error: [GHC-69248] Pattern synonyms not allowed in instance declaration: pattern P = () diff --git a/testsuite/tests/rename/should_compile/rn049.stderr b/testsuite/tests/rename/should_compile/rn049.stderr index 77df012628..5c13eb3936 100644 --- a/testsuite/tests/rename/should_compile/rn049.stderr +++ b/testsuite/tests/rename/should_compile/rn049.stderr @@ -1,4 +1,5 @@ -rn049.hs:12:6: Warning: - accepting non-standard pattern guards (use PatternGuards to suppress this message) +rn049.hs:12:6: warning: [GHC-59119] + accepting non-standard pattern guards x <- 1 * 2 + 3 * 4 + Suggested fix: Perhaps you intended to use PatternGuards diff --git a/testsuite/tests/rename/should_fail/RnDefaultSigFail.hs b/testsuite/tests/rename/should_fail/RnDefaultSigFail.hs new file mode 100644 index 0000000000..29a5f6a7e5 --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnDefaultSigFail.hs @@ -0,0 +1,6 @@ +module RnDefaultSigFail where + +class C a where + m :: a + default m :: Num a => a + m = 0 diff --git a/testsuite/tests/rename/should_fail/RnDefaultSigFail.stderr b/testsuite/tests/rename/should_fail/RnDefaultSigFail.stderr new file mode 100644 index 0000000000..fa58838e88 --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnDefaultSigFail.stderr @@ -0,0 +1,4 @@ + +RnDefaultSigFail.hs:5:3: error: [GHC-40700] + Unexpected default signature: default m :: Num a => a + Suggested fix: Perhaps you intended to use DefaultSignatures diff --git a/testsuite/tests/rename/should_fail/RnEmptyCaseFail.hs b/testsuite/tests/rename/should_fail/RnEmptyCaseFail.hs new file mode 100644 index 0000000000..4ba8082d6c --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnEmptyCaseFail.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE NoEmptyCase #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE Arrows #-} +module RnEmptyCaseFail where + +f = case () of + +g = \case + +h = \cases + +j = proc x -> do \case + +k = proc x -> do case () of diff --git a/testsuite/tests/rename/should_fail/RnEmptyCaseFail.stderr b/testsuite/tests/rename/should_fail/RnEmptyCaseFail.stderr new file mode 100644 index 0000000000..d611567a6e --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnEmptyCaseFail.stderr @@ -0,0 +1,19 @@ + +RnEmptyCaseFail.hs:6:5: error: [GHC-48010] + Empty list of alternatives in case expression + Suggested fix: Perhaps you intended to use EmptyCase + +RnEmptyCaseFail.hs:8:5: error: [GHC-48010] + Empty list of alternatives in \case expression + Suggested fix: Perhaps you intended to use EmptyCase + +RnEmptyCaseFail.hs:10:5: error: [GHC-48010] + Empty list of alternatives is not allowed in \cases expression + +RnEmptyCaseFail.hs:12:18: error: [GHC-48010] + Empty list of alternatives in \case command + Suggested fix: Perhaps you intended to use EmptyCase + +RnEmptyCaseFail.hs:14:18: error: [GHC-48010] + Empty list of alternatives in case command + Suggested fix: Perhaps you intended to use EmptyCase diff --git a/testsuite/tests/rename/should_fail/RnMultipleFixityFail.hs b/testsuite/tests/rename/should_fail/RnMultipleFixityFail.hs new file mode 100644 index 0000000000..039e6151a7 --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnMultipleFixityFail.hs @@ -0,0 +1,7 @@ +module RnMultipleFixityFail where + + +($$) = ($) + +infixr 4 $$ +infixl 6 $$ diff --git a/testsuite/tests/rename/should_fail/RnMultipleFixityFail.stderr b/testsuite/tests/rename/should_fail/RnMultipleFixityFail.stderr new file mode 100644 index 0000000000..73c3314a2e --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnMultipleFixityFail.stderr @@ -0,0 +1,4 @@ + +RnMultipleFixityFail.hs:6:10: error: [GHC-50419] + Multiple fixity declarations for ‘$$’ + also at RnMultipleFixityFail.hs:7:1-11 diff --git a/testsuite/tests/rename/should_fail/RnMultipleMinimalPragmaFail.hs b/testsuite/tests/rename/should_fail/RnMultipleMinimalPragmaFail.hs new file mode 100644 index 0000000000..b28a6b4a6b --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnMultipleMinimalPragmaFail.hs @@ -0,0 +1,9 @@ +module RnMultipleMinimalPragmaFail where + +class C a where + {-# MINIMAL m1 | m2 #-} + m1 :: a + m2 :: a + m2 = m1 + m1 = m2 + {-# MINIMAL m1 | m2 #-} diff --git a/testsuite/tests/rename/should_fail/RnMultipleMinimalPragmaFail.stderr b/testsuite/tests/rename/should_fail/RnMultipleMinimalPragmaFail.stderr new file mode 100644 index 0000000000..b613af6206 --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnMultipleMinimalPragmaFail.stderr @@ -0,0 +1,6 @@ + +RnMultipleMinimalPragmaFail.hs:4:3: error: [GHC-85346] + Multiple minimal complete definitions + at RnMultipleMinimalPragmaFail.hs:4:3-25 + RnMultipleMinimalPragmaFail.hs:9:3-25 + Combine alternative minimal complete definitions with `|' diff --git a/testsuite/tests/rename/should_fail/RnPatternSynonymFail.hs b/testsuite/tests/rename/should_fail/RnPatternSynonymFail.hs new file mode 100644 index 0000000000..fd3c06e02c --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnPatternSynonymFail.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} +module RnPatternSynonymFail where + +import Language.Haskell.TH + +$(pure [ PatSynD (mkName "None") (PrefixPatSyn []) ImplBidir (ConP 'Nothing [] [])]) diff --git a/testsuite/tests/rename/should_fail/RnPatternSynonymFail.stderr b/testsuite/tests/rename/should_fail/RnPatternSynonymFail.stderr new file mode 100644 index 0000000000..0bf8f16f04 --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnPatternSynonymFail.stderr @@ -0,0 +1,4 @@ + +RnPatternSynonymFail.hs:6:2: error: [GHC-41507] + Illegal pattern synonym declaration + Suggested fix: Perhaps you intended to use PatternSynonyms diff --git a/testsuite/tests/rename/should_fail/T18138.stderr b/testsuite/tests/rename/should_fail/T18138.stderr index dea2871a51..afd11678f1 100644 --- a/testsuite/tests/rename/should_fail/T18138.stderr +++ b/testsuite/tests/rename/should_fail/T18138.stderr @@ -1,4 +1,4 @@ -T18138.hs:4:1: error: +T18138.hs:4:1: error: [GHC-87866] Misplaced SPECIALISE instance pragma: {-# SPECIALISE instance Eq (T Int) #-} diff --git a/testsuite/tests/rename/should_fail/T19781.stderr b/testsuite/tests/rename/should_fail/T19781.stderr index 1e468715aa..ffe4a4d329 100644 --- a/testsuite/tests/rename/should_fail/T19781.stderr +++ b/testsuite/tests/rename/should_fail/T19781.stderr @@ -1,6 +1,6 @@ -T19781_A.hs-boot:4:1: error: +T19781_A.hs-boot:4:1: error: [GHC-11247] Bindings in hs-boot files are not allowed -T19781_A.hs-boot:7:1: error: +T19781_A.hs-boot:7:1: error: [GHC-11247] Bindings in hs-boot files are not allowed diff --git a/testsuite/tests/rename/should_fail/T5589.stderr b/testsuite/tests/rename/should_fail/T5589.stderr index f3e5e8d05c..591a51dc74 100644 --- a/testsuite/tests/rename/should_fail/T5589.stderr +++ b/testsuite/tests/rename/should_fail/T5589.stderr @@ -1,5 +1,5 @@ -T5589.hs:4:1: +T5589.hs:4:1: error: [GHC-31744] Duplicate type signatures for ‘aaa’ at T5589.hs:3:6-8 T5589.hs:4:1-3 diff --git a/testsuite/tests/rename/should_fail/T7338.stderr b/testsuite/tests/rename/should_fail/T7338.stderr index ceb6753a22..138d1f2838 100644 --- a/testsuite/tests/rename/should_fail/T7338.stderr +++ b/testsuite/tests/rename/should_fail/T7338.stderr @@ -1,5 +1,5 @@ -T7338.hs:4:1: +T7338.hs:4:1: error: [GHC-31744] Duplicate type signatures for ‘a’ at T7338.hs:3:1 T7338.hs:3:4 diff --git a/testsuite/tests/rename/should_fail/T7338a.stderr b/testsuite/tests/rename/should_fail/T7338a.stderr index 8d6d00097c..01acd0582b 100644 --- a/testsuite/tests/rename/should_fail/T7338a.stderr +++ b/testsuite/tests/rename/should_fail/T7338a.stderr @@ -1,10 +1,10 @@ -T7338a.hs:7:4: +T7338a.hs:7:4: error: [GHC-31744] Duplicate type signatures for ‘a’ at T7338a.hs:3:1 T7338a.hs:7:4 -T7338a.hs:10:1: +T7338a.hs:10:1: error: [GHC-31744] Duplicate type signatures for ‘c’ at T7338a.hs:7:1 T7338a.hs:10:1 diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index c25ba747e7..eee582db2b 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -184,3 +184,8 @@ test('T21605b', normal, compile_fail, ['']) test('T21605c', normal, compile_fail, ['']) test('T21605d', normal, compile_fail, ['']) test('T22839', normal, compile_fail, ['']) +test('RnPatternSynonymFail', normal, compile_fail, ['']) +test('RnMultipleFixityFail', normal, compile_fail, ['']) +test('RnEmptyCaseFail', normal, compile_fail, ['']) +test('RnDefaultSigFail', normal, compile_fail, ['']) +test('RnMultipleMinimalPragmaFail', normal, compile_fail, ['']) diff --git a/testsuite/tests/rename/should_fail/rnfail048.stderr b/testsuite/tests/rename/should_fail/rnfail048.stderr index 64955c3982..bd616596b2 100644 --- a/testsuite/tests/rename/should_fail/rnfail048.stderr +++ b/testsuite/tests/rename/should_fail/rnfail048.stderr @@ -1,5 +1,5 @@ -rnfail048.hs:11:12: +rnfail048.hs:11:12: error: [GHC-31744] Duplicate INLINE pragmas for ‘foo’ at rnfail048.hs:6:17-19 rnfail048.hs:7:18-20 diff --git a/testsuite/tests/typecheck/should_fail/tcfail021.stderr b/testsuite/tests/typecheck/should_fail/tcfail021.stderr index 03a1efc328..59f91cff67 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail021.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail021.stderr @@ -1,4 +1,4 @@ -tcfail021.hs:8:5: error: +tcfail021.hs:8:5: error: [GHC-69248] Pattern bindings (except simple variables) not allowed in instance declaration: ((==), (/=)) = (\ x -> \ y -> True, \ x -> \ y -> False) diff --git a/testsuite/tests/warnings/minimal/WarnMinimalFail1.stderr b/testsuite/tests/warnings/minimal/WarnMinimalFail1.stderr index 43145384e1..9acca4db07 100644 --- a/testsuite/tests/warnings/minimal/WarnMinimalFail1.stderr +++ b/testsuite/tests/warnings/minimal/WarnMinimalFail1.stderr @@ -1,3 +1,3 @@ -WarnMinimalFail1.hs:5:1: +WarnMinimalFail1.hs:5:1: error: [GHC-87866] Misplaced MINIMAL pragma: {-# MINIMAL global #-} |