diff options
-rw-r--r-- | compiler/GHC/Driver/Flags.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Types.hs | 12 | ||||
-rw-r--r-- | compiler/GHC/Tc/TyCl.hs | 43 | ||||
-rw-r--r-- | compiler/GHC/Types/Error/Codes.hs | 1 | ||||
-rw-r--r-- | docs/users_guide/using-warnings.rst | 22 | ||||
-rw-r--r-- | testsuite/tests/linters/notes.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/warnings/should_compile/T22702a.hs | 25 | ||||
-rw-r--r-- | testsuite/tests/warnings/should_compile/T22702a.stderr | 6 | ||||
-rw-r--r-- | testsuite/tests/warnings/should_compile/T22702b.hs | 23 | ||||
-rw-r--r-- | testsuite/tests/warnings/should_compile/all.T | 2 |
12 files changed, 144 insertions, 4 deletions
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs index 2099d7c100..759c137eb5 100644 --- a/compiler/GHC/Driver/Flags.hs +++ b/compiler/GHC/Driver/Flags.hs @@ -636,6 +636,7 @@ data WarningFlag = | Opt_WarnTypeEqualityRequiresOperators -- Since 9.4 | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 + | Opt_WarnMissingRoleAnnotations -- Since 9.8 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -742,6 +743,7 @@ warnFlagNames wflag = case wflag of Opt_WarnTypeEqualityOutOfScope -> "type-equality-out-of-scope" :| [] Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] + Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index d7fd2f3249..dd5bb6b7cb 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -2249,7 +2249,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnGADTMonoLocalBinds, warnSpec Opt_WarnTypeEqualityOutOfScope, warnSpec Opt_WarnTypeEqualityRequiresOperators, - warnSpec Opt_WarnTermVariableCapture + warnSpec Opt_WarnTermVariableCapture, + warnSpec Opt_WarnMissingRoleAnnotations ] warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index bf92125405..a9b1084914 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -1338,6 +1338,9 @@ instance Diagnostic TcRnMessage where TcRnSectionWithoutParentheses expr -> mkSimpleDecorated $ hang (text "A section must be enclosed in parentheses") 2 (text "thus:" <+> (parens (ppr expr))) + TcRnMissingRoleAnnotation name roles -> mkSimpleDecorated $ + hang (text "Missing role annotation" <> colon) + 2 (text "type role" <+> ppr name <+> hsep (map ppr roles)) TcRnCapturedTermName tv_name shadowed_term_names -> mkSimpleDecorated $ @@ -2547,6 +2550,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnGhciMonadLookupFail {} -> ErrorWithoutFlag + TcRnMissingRoleAnnotation{} + -> WarningWithFlag Opt_WarnMissingRoleAnnotations diagnosticHints = \case TcRnUnknownMessage m @@ -3226,6 +3231,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnGhciMonadLookupFail {} -> noHints + TcRnMissingRoleAnnotation{} + -> noHints diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index 4f0d961a3d..41fa0515ee 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -4168,6 +4168,18 @@ data TcRnMessage where -> Maybe [GlobalRdrElt] -- ^ lookup result -> TcRnMessage + {- TcRnMissingRoleAnnotation is a warning that occurs when type declaration + doesn't have a role annotatiosn + + Controlled by flags: + - Wmissing-role-annotations + + Test cases: + T22702 + + -} + TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs index a2d507475a..6abbbfde26 100644 --- a/compiler/GHC/Tc/TyCl.hs +++ b/compiler/GHC/Tc/TyCl.hs @@ -4976,9 +4976,13 @@ checkValidRoleAnnots role_annots tc | isVisibleTyConBinder tvb = Just (role, binderVar tvb) | otherwise = Nothing - check_roles - = whenIsJust role_annot_decl_maybe $ - \decl@(L loc (RoleAnnotDecl _ _ the_role_annots)) -> + check_roles = case role_annot_decl_maybe of + Nothing -> + setSrcSpan (getSrcSpan name) $ + -- See Note [Missing role annotations warning] + warnIf (not (isClassTyCon tc) && not (null vis_roles)) $ + TcRnMissingRoleAnnotation name vis_roles + Just (decl@(L loc (RoleAnnotDecl _ _ the_role_annots))) -> addRoleAnnotCtxt name $ setSrcSpanA loc $ do { role_annots_ok <- xoptM LangExt.RoleAnnotations @@ -5001,6 +5005,39 @@ checkValidRoleAnnots role_annots tc check_no_roles = whenIsJust role_annot_decl_maybe illegalRoleAnnotDecl +-- Note [Missing role annotations warning] +-- +-- We warn about missing role annotations for tycons +-- 1. not type-classes: +-- type classes are nominal by default, which is most conservative +-- choice. E.g. we cannot have a type-class with an (accidentally) +-- phantom or representational type variable, as we can with +-- data types. +-- 2. with visible roles +-- +-- We don't make any exceptions for other data types. +-- In particular we explicitly warn about omitted (default and common) +-- representational roles. That is the point of the warning. +-- For example the default representational role for `Map`s key type parameter +-- would be wrong, and this warning is there to warn about it, +-- asking users to be explicit. +-- +-- If the default roles have been nominal, i.e. as conservative as possible, +-- the warning would still be valuable, as most types can be `representational` +-- (c.f. type-classes, which usually cannot). +-- +-- We don't warn about types with invisible roles only, because users cannot +-- specify them: +-- +-- type Foo :: forall {k}. Type +-- data Foo = Foo Int +-- type role Foo phantom +-- +-- is incorrect, GHC complains: +-- Wrong number of roles listed in role annotation; +-- Expected 0, got 1: +-- + checkRoleAnnot :: TyVar -> LocatedAn NoEpAnns (Maybe Role) -> Role -> TcM () checkRoleAnnot _ (L _ Nothing) _ = return () checkRoleAnnot tv (L _ (Just r1)) r2 diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs index 7bcafbe32e..25f78f9fbd 100644 --- a/compiler/GHC/Types/Error/Codes.hs +++ b/compiler/GHC/Types/Error/Codes.hs @@ -439,6 +439,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnUnexpectedKindVar" = 12875 GhcDiagnosticCode "TcRnNegativeNumTypeLiteral" = 93632 GhcDiagnosticCode "TcRnUnusedQuantifiedTypeVar" = 54180 + GhcDiagnosticCode "TcRnMissingRoleAnnotation" = 65490 GhcDiagnosticCode "TcRnUntickedPromotedThing" = 49957 GhcDiagnosticCode "TcRnIllegalBuiltinSyntax" = 39716 diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 577bce0a74..922a9638c0 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -2393,6 +2393,28 @@ of ``-W(no-)*``. When :ghc-flag:`-Wterm-variable-capture` is enabled, GHC warns against implicit quantification that would stop working under ``RequiredTypeArguments``. +.. ghc-flag:: -Wmissing-role-annotations + :shortdesc: warn when type declarations don't have role annotations + :type: dynamic + :reverse: -Wno-role-annotations-signatures + :category: + + :since: 9.8 + :default: off + + .. index:: + single: roles, missing + + If you would like GHC to check that every data type definition + has a :ref:`role annotation <role-annotations>`, use the + :ghc-flag:`-Wmissing-role-annotations` option. + You can specify the role via :extension:`RoleAnnotations`. + + GHC will not warn about type class definitions with missing role annotations, + as their default roles are the strictest: all nominal. + In other words the type-class role cannot be accidentally left + representational or phantom, which could affected the code correctness. + If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's diff --git a/testsuite/tests/linters/notes.stdout b/testsuite/tests/linters/notes.stdout index 0e82fe5214..a269670e43 100644 --- a/testsuite/tests/linters/notes.stdout +++ b/testsuite/tests/linters/notes.stdout @@ -34,6 +34,8 @@ ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family i ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting] ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names] +ref compiler/GHC/Tc/TyCl.hs:4982:17: Note [Missing role annotations warning] +ref compiler/GHC/Tc/TyCl.hs:5008:3: Note [Missing role annotations warning] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] diff --git a/testsuite/tests/warnings/should_compile/T22702a.hs b/testsuite/tests/warnings/should_compile/T22702a.hs new file mode 100644 index 0000000000..14b0b94047 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T22702a.hs @@ -0,0 +1,25 @@ +{-# OPTIONS_GHC -Wmissing-role-annotations #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +module T22702a where + +import Data.Kind (Type) + +-- type with parameters +-- warns +type Foo :: Type -> Type -> Type +data Foo x y = Foo x + +-- type without parameters +-- doesn't warn +data Quu = Quu1 | Quu2 + +-- polykinded type +-- warns, no role for `k` +type Bar :: (k -> Type) -> k -> Type +data Bar f a = Bar (f a) + +-- type-class may have roles as well +-- doesn't warn +class C a where diff --git a/testsuite/tests/warnings/should_compile/T22702a.stderr b/testsuite/tests/warnings/should_compile/T22702a.stderr new file mode 100644 index 0000000000..c407c64b7d --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T22702a.stderr @@ -0,0 +1,6 @@ + +T22702a.hs:12:1: warning: [GHC-65490] [-Wmissing-role-annotations] + Missing role annotation: type role Foo representational phantom + +T22702a.hs:21:1: warning: [GHC-65490] [-Wmissing-role-annotations] + Missing role annotation: type role Bar representational nominal diff --git a/testsuite/tests/warnings/should_compile/T22702b.hs b/testsuite/tests/warnings/should_compile/T22702b.hs new file mode 100644 index 0000000000..b9bb929f77 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T22702b.hs @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -Wmissing-role-annotations #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +module T22702b where + +import Data.Kind (Type) + +-- type with parameters +type Foo :: Type -> Type -> Type +type role Foo representational phantom +data Foo x y = Foo x + +-- type without parameters +data Quu = Quu1 | Quu2 + +-- polykinded type +type Bar :: (k -> Type) -> k -> Type +type role Bar representational nominal +data Bar f a = Bar (f a) + +-- type-class may have roles as well +class C a where diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T index f001e40164..8697709203 100644 --- a/testsuite/tests/warnings/should_compile/all.T +++ b/testsuite/tests/warnings/should_compile/all.T @@ -62,3 +62,5 @@ 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']) +test('T22702a', normal, compile, ['']) +test('T22702b', normal, compile, ['']) |