From ce90f12f53dca5c55e87158d60529340a75851d2 Mon Sep 17 00:00:00 2001
From: Andrei Borzenkov <andreyborzenkov2002@gmail.com>
Date: Mon, 5 Feb 2024 18:22:28 +0400
Subject: [PATCH] Hide WARNING/DEPRECATED namespacing under
-XExplicitNamespaces (#24396)
---
compiler/GHC/Hs/Decls.hs | 2 +-
compiler/GHC/Rename/Module.hs | 5 +++-
compiler/GHC/Tc/Errors/Ppr.hs | 15 ++++++++++++
compiler/GHC/Tc/Errors/Types.hs | 7 ++++++
compiler/GHC/Types/Error/Codes.hs | 1 +
docs/users_guide/9.10.1-notes.rst | 5 ++--
docs/users_guide/exts/pragmas.rst | 3 ++-
libraries/ghc-prim/GHC/Tuple.hs | 2 +-
.../tests/warnings/should_compile/T24396a.hs | 2 ++
.../tests/warnings/should_fail/T24396c.hs | 20 ++++++++++++++++
.../tests/warnings/should_fail/T24396c.stderr | 24 +++++++++++++++++++
testsuite/tests/warnings/should_fail/all.T | 1 +
12 files changed, 81 insertions(+), 6 deletions(-)
create mode 100644 testsuite/tests/warnings/should_fail/T24396c.hs
create mode 100644 testsuite/tests/warnings/should_fail/T24396c.stderr
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index e42bdcdcd24d..50c1bc96f633 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -1288,7 +1288,7 @@ data NamespaceSpecifier
= NoNamespaceSpecifier
| TypeNamespaceSpecifier (EpToken "type")
| DataNamespaceSpecifier (EpToken "data")
- deriving (Data)
+ deriving (Eq, Data)
overlappingNamespaceSpecifiers :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
overlappingNamespaceSpecifiers NoNamespaceSpecifier _ = True
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 4fde200b6ad2..b9a9e1fd1489 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -283,10 +283,13 @@ rnSrcWarnDecls bndr_set decls'
sig_ctxt = TopSigCtxt bndr_set
- rn_deprec (Warning (ns_spec, _) rdr_names txt)
+ rn_deprec w@(Warning (ns_spec, _) rdr_names txt)
-- ensures that the names are defined locally
= do { names <- concatMapM (lookupLocalTcNames sig_ctxt what ns_spec . unLoc)
rdr_names
+ ; unlessXOptM LangExt.ExplicitNamespaces $
+ when (ns_spec /= NoNamespaceSpecifier) $
+ addErr (TcRnNamespacedWarningPragmaWithoutFlag w)
; txt' <- rnWarningTxt txt
; return [(nameOccName nm, txt') | (_, nm) <- names] }
-- Use the OccName from the Name we looked up, rather than from the RdrName,
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 95708e472227..0d1539922796 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -1889,6 +1889,17 @@ instance Diagnostic TcRnMessage where
| otherwise
= text "they are not unfilled metavariables"
+ TcRnNamespacedWarningPragmaWithoutFlag warning@(Warning (kw, _) _ txt) -> mkSimpleDecorated $
+ vcat [ text "Illegal use of the" <+> quotes (ppr kw) <+> text "keyword:"
+ , nest 2 (ppr warning)
+ , text "in a" <+> pragma_type <+> text "pragma"
+ ]
+ where
+ pragma_type = case txt of
+ WarningTxt{} -> text "WARNING"
+ DeprecatedTxt{} -> text "DEPRECATED"
+
+ diagnosticReason :: TcRnMessage -> DiagnosticReason
diagnosticReason = \case
TcRnUnknownMessage m
-> diagnosticReason m
@@ -2512,6 +2523,8 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnInvalidDefaultedTyVar{}
-> ErrorWithoutFlag
+ TcRnNamespacedWarningPragmaWithoutFlag{}
+ -> ErrorWithoutFlag
diagnosticHints = \case
TcRnUnknownMessage m
@@ -3170,6 +3183,8 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnInvalidDefaultedTyVar{}
-> noHints
+ TcRnNamespacedWarningPragmaWithoutFlag{}
+ -> [suggestExtension LangExt.ExplicitNamespaces]
diagnosticCode = constructorCode
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 8ee307034cc3..9f197aac0175 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -4205,6 +4205,13 @@ data TcRnMessage where
-> NE.NonEmpty TcTyVar -- ^ The invalid type variables of the proposal
-> TcRnMessage
+ {-| TcRnNamespacedWarningPragmaWithoutFlag is an error that occurs when
+ a namespace specifier is used in {-# WARNING ... #-} or {-# DEPRECATED ... #-}
+ pragmas without the -XExplicitNamespaces extension enabled
+
+ -}
+ TcRnNamespacedWarningPragmaWithoutFlag :: WarnDecl GhcPs -> TcRnMessage
+
deriving Generic
diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs
index b1e6ffe2b36f..79f5b9d07c42 100644
--- a/compiler/GHC/Types/Error/Codes.hs
+++ b/compiler/GHC/Types/Error/Codes.hs
@@ -600,6 +600,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnDeprecatedInvisTyArgInConPat" = 69797
GhcDiagnosticCode "TcRnInvalidDefaultedTyVar" = 45625
GhcDiagnosticCode "TcRnIllegalTermLevelUse" = 01928
+ GhcDiagnosticCode "TcRnNamespacedWarningPragmaWithoutFlag" = 14995
-- TcRnTypeApplicationsDisabled
GhcDiagnosticCode "TypeApplication" = 23482
diff --git a/docs/users_guide/9.10.1-notes.rst b/docs/users_guide/9.10.1-notes.rst
index 44217960346d..629352f3ea34 100644
--- a/docs/users_guide/9.10.1-notes.rst
+++ b/docs/users_guide/9.10.1-notes.rst
@@ -75,9 +75,10 @@ Language
- GHC Proposal `#65 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0065-type-infix.rst>`_
"Require namespacing fixity declarations for type names and WARNING/DEPRECATED pragmas" has been partially implemented.
- Now you can specify namespace of a name that you want to warn about or deprecate: ::
+ Now, with :extension:`ExplicitNamespaces` enabled, you can specify the
+ namespace of a name that you want to warn about or deprecate: ::
- {-# DEPRACATED type D "Use `()` instead" #-} -- this will deprecate type D, but will not touch pattern synonym
+ {-# DEPRECATED type D "Use `()` instead" #-} -- this will deprecate type D, but will not touch pattern synonym
data D = MkD
{-# DEPRECATED data D "Use `MkD` instead" #-} -- this will deprecate pattern synonym only
diff --git a/docs/users_guide/exts/pragmas.rst b/docs/users_guide/exts/pragmas.rst
index ee98075e3cb8..78910dd8a273 100644
--- a/docs/users_guide/exts/pragmas.rst
+++ b/docs/users_guide/exts/pragmas.rst
@@ -251,7 +251,8 @@ When a deprecated name appears in both value and type namespaces (i.e. punning o
{-# DEPRECATED D "This will deprecate both the type D and the pattern synonym D" #-}
It is possible to specify the namespace of the name to be warned about
-or deprecated using ``type`` and ``data`` specifiers: ::
+or deprecated using ``type`` and ``data`` specifiers, but this feature
+requires enabling :extension:`ExplicitNamespaces`: ::
{-# LANGUAGE PatternSynonyms #-}
diff --git a/libraries/ghc-prim/GHC/Tuple.hs b/libraries/ghc-prim/GHC/Tuple.hs
index 6938c365aea2..7c8cf95eee76 100644
--- a/libraries/ghc-prim/GHC/Tuple.hs
+++ b/libraries/ghc-prim/GHC/Tuple.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, PatternSynonyms #-}
+{-# LANGUAGE NoImplicitPrelude, PatternSynonyms, ExplicitNamespaces #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Tuple
diff --git a/testsuite/tests/warnings/should_compile/T24396a.hs b/testsuite/tests/warnings/should_compile/T24396a.hs
index 1cdbce79adea..3bbb3460391e 100644
--- a/testsuite/tests/warnings/should_compile/T24396a.hs
+++ b/testsuite/tests/warnings/should_compile/T24396a.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE ExplicitNamespaces #-}
+
module T24396a where
class C1
diff --git a/testsuite/tests/warnings/should_fail/T24396c.hs b/testsuite/tests/warnings/should_fail/T24396c.hs
new file mode 100644
index 000000000000..34d97670d85f
--- /dev/null
+++ b/testsuite/tests/warnings/should_fail/T24396c.hs
@@ -0,0 +1,20 @@
+
+module T24396c where
+
+
+f = id
+
+{-# WARNING data f "warning on data level" #-}
+
+data F
+
+{-# WARNING type F "warning on type level" #-}
+
+
+g = id
+
+{-# DEPRECATED data g "deprecation on data level" #-}
+
+data G
+
+{-# DEPRECATED type G "deprecation on type level" #-}
diff --git a/testsuite/tests/warnings/should_fail/T24396c.stderr b/testsuite/tests/warnings/should_fail/T24396c.stderr
new file mode 100644
index 000000000000..ee4f56bcc1d3
--- /dev/null
+++ b/testsuite/tests/warnings/should_fail/T24396c.stderr
@@ -0,0 +1,24 @@
+
+T24396c.hs:7:13: error: [GHC-14995]
+ Illegal use of the ‘data’ keyword:
+ data f "warning on data level"
+ in a WARNING pragma
+ Suggested fix: Perhaps you intended to use ExplicitNamespaces
+
+T24396c.hs:11:13: error: [GHC-14995]
+ Illegal use of the ‘type’ keyword:
+ type F "warning on type level"
+ in a WARNING pragma
+ Suggested fix: Perhaps you intended to use ExplicitNamespaces
+
+T24396c.hs:16:16: error: [GHC-14995]
+ Illegal use of the ‘data’ keyword:
+ data g "deprecation on data level"
+ in a DEPRECATED pragma
+ Suggested fix: Perhaps you intended to use ExplicitNamespaces
+
+T24396c.hs:20:16: error: [GHC-14995]
+ Illegal use of the ‘type’ keyword:
+ type G "deprecation on type level"
+ in a DEPRECATED pragma
+ Suggested fix: Perhaps you intended to use ExplicitNamespaces
diff --git a/testsuite/tests/warnings/should_fail/all.T b/testsuite/tests/warnings/should_fail/all.T
index a7ded1ebf882..aafc92e6dca8 100644
--- a/testsuite/tests/warnings/should_fail/all.T
+++ b/testsuite/tests/warnings/should_fail/all.T
@@ -26,3 +26,4 @@ test('WarningCategory5', [extra_files(['WarningCategory1.hs', 'WarningCategory1_
test('WarningCategory6', [extra_files(['WarningCategory1.hs', 'WarningCategory1_B.hs', 'WarningCategoryModule.hs'])], multimod_compile_fail, ['WarningCategory1', '-v0 -Wno-extended-warnings -Wdeprecations -Werror=warnings-deprecations'])
test('WarningCategory7', [extra_files(['WarningCategory1.hs', 'WarningCategory1_B.hs', 'WarningCategoryModule.hs'])], multimod_compile_fail, ['WarningCategory1', '-v0 -Werror -w -Wall'])
test('WarningCategoryInvalid', normal, compile_fail, [''])
+test('T24396c', normal, compile_fail, [''])
--
GitLab