diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index b000943a30c51ba045ce8049df832fc8dc0fd42f..f969716d5efb3090bf9e3a99d61c127877cd58b4 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -456,7 +456,7 @@ ppr_dec _ (ClosedTypeFamilyD tfhead eqns)
     ppr_eqn (TySynEqn mb_bndrs lhs rhs)
       = ppr_bndrs mb_bndrs <+> ppr lhs <+> text "=" <+> ppr rhs
 ppr_dec _ (RoleAnnotD name roles)
-  = hsep [ text "type role", ppr name ] <+> hsep (map ppr roles)
+  = hsep [ text "type role", pprName' Applied name ] <+> hsep (map ppr roles)
 ppr_dec _ (StandaloneDerivD ds cxt ty)
   = hsep [ text "deriving"
          , maybe empty ppr_deriv_strategy ds
diff --git a/testsuite/tests/th/T23954.hs b/testsuite/tests/th/T23954.hs
new file mode 100644
index 0000000000000000000000000000000000000000..19ca0fb9de58c0a12eee518e6890c6dd337fff92
--- /dev/null
+++ b/testsuite/tests/th/T23954.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE Haskell2010, RoleAnnotations, TemplateHaskell, TypeOperators #-}
+
+import Language.Haskell.TH (runQ)
+import Language.Haskell.TH.Ppr (pprint)
+
+main =
+  runQ [d|
+         data a ## b
+         type role (##) nominal nominal
+       |]
+  >>= putStrLn . pprint
diff --git a/testsuite/tests/th/T23954.stdout b/testsuite/tests/th/T23954.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..18bc6c58f0d0bf91a2313a0424cded124ee94388
--- /dev/null
+++ b/testsuite/tests/th/T23954.stdout
@@ -0,0 +1,2 @@
+data (##_0) a_1 b_2
+type role (##_0) nominal nominal
\ No newline at end of file
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 50ca7bb3926b3ccaf9accb6a227eb48af8b03571..7cb3e003326243b36ebb00884e7f19bda4c6124a 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -580,7 +580,6 @@ test('T22559a', normal, compile_fail, [''])
 test('T22559b', normal, compile_fail, [''])
 test('T22559c', normal, compile_fail, [''])
 test('T23525', normal, compile, [''])
-test('T23927', normal, compile_and_run, [''])
 test('CodeQ_HKD', normal, compile, [''])
 test('T23748', normal, compile, [''])
 test('T23796', normal, compile, [''])
@@ -588,3 +587,5 @@ test('T23829_timely', normal, compile, [''])
 test('T23829_tardy', normal, warn_and_run, [''])
 test('T23829_hasty', normal, compile_fail, [''])
 test('T23829_hasty_b', normal, compile_fail, [''])
+test('T23927', normal, compile_and_run, [''])
+test('T23954', normal, compile_and_run, [''])