From 1c834ad41ff59713c421d95cd385aafd0e7416e5 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Thu, 30 May 2024 20:21:53 -0400
Subject: [PATCH] Print namespace specifiers in FixitySig's Outputable instance

For whatever reason, the `Outputable` instance for `FixitySig` simply did not
print out namespace specifiers, leading to the confusing `-ddump-splices`
output seen in #24911. This patch corrects this oversight.

Fixes #24911.
---
 compiler/GHC/Hs/Binds.hs                        |  7 ++++++-
 .../tests/rename/should_fail/T14032c.stderr     |  6 +++---
 testsuite/tests/th/T24911.hs                    | 12 ++++++++++++
 testsuite/tests/th/T24911.stderr                | 17 +++++++++++++++++
 testsuite/tests/th/all.T                        |  1 +
 5 files changed, 39 insertions(+), 4 deletions(-)
 create mode 100644 testsuite/tests/th/T24911.hs
 create mode 100644 testsuite/tests/th/T24911.stderr

diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 47cd4cc1c7b7..6e21fef67f10 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -898,8 +898,13 @@ extractSpecPragName srcTxt =  case (words $ show srcTxt) of
 
 instance OutputableBndrId p
        => Outputable (FixitySig (GhcPass p)) where
-  ppr (FixitySig _ names fixity) = sep [ppr fixity, pprops]
+  ppr (FixitySig ns_spec names fixity) = sep [ppr fixity, ppr_ns_spec, pprops]
     where
+      ppr_ns_spec =
+        case ghcPass @p of
+          GhcPs -> ppr ns_spec
+          GhcRn -> ppr ns_spec
+          GhcTc -> empty
       pprops = hsep $ punctuate comma (map (pprInfixOcc . unLoc) names)
 
 pragBrackets :: SDoc -> SDoc
diff --git a/testsuite/tests/rename/should_fail/T14032c.stderr b/testsuite/tests/rename/should_fail/T14032c.stderr
index 37c8509b13f8..f64d3bd7ad3e 100644
--- a/testsuite/tests/rename/should_fail/T14032c.stderr
+++ b/testsuite/tests/rename/should_fail/T14032c.stderr
@@ -1,14 +1,14 @@
-
 T14032c.hs:1:1: error: [GHC-78534]
     Illegal use of the ‘type’ keyword:
-      infix 0 $
+      infix 0 type $
     in a fixity signature
     Suggested fix:
       Perhaps you intended to use the ‘ExplicitNamespaces’ extension (implied by ‘TypeFamilies’ and ‘TypeOperators’)
 
 T14032c.hs:1:1: error: [GHC-78534]
     Illegal use of the ‘data’ keyword:
-      infix 0 $
+      infix 0 data $
     in a fixity signature
     Suggested fix:
       Perhaps you intended to use the ‘ExplicitNamespaces’ extension (implied by ‘TypeFamilies’ and ‘TypeOperators’)
+
diff --git a/testsuite/tests/th/T24911.hs b/testsuite/tests/th/T24911.hs
new file mode 100644
index 000000000000..fa738eef53d0
--- /dev/null
+++ b/testsuite/tests/th/T24911.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE ExplicitNamespaces #-}
+{-# LANGUAGE TemplateHaskell #-}
+module T24911 where
+
+$([d| infixl 4 data ###
+      (###) :: a -> a -> a
+      x ### y = x
+
+      infixl 4 type ###
+      type (###) :: a -> a -> a
+      type x ### y = x
+    |])
diff --git a/testsuite/tests/th/T24911.stderr b/testsuite/tests/th/T24911.stderr
new file mode 100644
index 000000000000..ff2e39591440
--- /dev/null
+++ b/testsuite/tests/th/T24911.stderr
@@ -0,0 +1,17 @@
+T24911.hs:(5,2)-(12,7): Splicing declarations
+    [d| infixl 4 type ###
+        infixl 4 data ###
+        
+        (###) :: a -> a -> a
+        x ### y = x
+        
+        type (###) :: a -> a -> a
+        
+        type x ### y = x |]
+  ======>
+    infixl 4 data ###
+    (###) :: a -> a -> a
+    (###) x y = x
+    infixl 4 type ###
+    type (###) :: a -> a -> a
+    type (###) x y = x
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index bda61c4df471..0e2febdcb99f 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -615,3 +615,4 @@ test('T24557e', normal, compile, [''])
 test('T24702a', normal, compile, [''])
 test('T24702b', normal, compile, [''])
 test('T24837', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('T24911', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
-- 
GitLab