[commit: ghc] master: Fix pretty-printing of data declarations in splices (3aa09cc)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/3aa09cc5af9cacba91915c095f9652ee5ed31ec7/ghc

>---------------------------------------------------------------

commit 3aa09cc5af9cacba91915c095f9652ee5ed31ec7
Author: Krzysztof Gogolewski <krz.gogolewski at gmail.com>
Date:   Sun Jul 22 18:58:33 2018 +0200

    Fix pretty-printing of data declarations in splices
    
    Test Plan: validate
    
    Reviewers: RyanGlScott, bgamari
    
    Reviewed By: RyanGlScott
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #15365
    
    Differential Revision: https://phabricator.haskell.org/D4998


>---------------------------------------------------------------

3aa09cc5af9cacba91915c095f9652ee5ed31ec7
 compiler/hsSyn/HsDecls.hs        |  4 ++--
 testsuite/tests/th/T15365.hs     | 31 +++++++++++++++++++++++++++++++
 testsuite/tests/th/T15365.stderr | 33 +++++++++++++++++++++++++++++++++
 testsuite/tests/th/all.T         |  1 +
 4 files changed, 67 insertions(+), 2 deletions(-)

diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index 3f54d20..6dde482 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -757,7 +757,7 @@ pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
          , hsep (map (ppr.unLoc) varsr)]
       | otherwise = hsep [ pprPrefixOcc (unLoc thing)
                   , hsep (map (ppr.unLoc) (varl:varsr))]
-    pp_tyvars [] = ppr thing
+    pp_tyvars [] = pprPrefixOcc (unLoc thing)
 pp_vanilla_decl_head _ (XLHsQTyVars x) _ _ = ppr x
 
 pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc
@@ -2375,7 +2375,7 @@ type instance XXRoleAnnotDecl (GhcPass _) = NoExt
 instance (p ~ GhcPass pass, OutputableBndr (IdP p))
        => Outputable (RoleAnnotDecl p) where
   ppr (RoleAnnotDecl _ ltycon roles)
-    = text "type role" <+> ppr ltycon <+>
+    = text "type role" <+> pprPrefixOcc (unLoc ltycon) <+>
       hsep (map (pp_role . unLoc) roles)
     where
       pp_role Nothing  = underscore
diff --git a/testsuite/tests/th/T15365.hs b/testsuite/tests/th/T15365.hs
new file mode 100644
index 0000000..00ff2e6
--- /dev/null
+++ b/testsuite/tests/th/T15365.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+module T15365 where
+
+$([d| type (|||) = Either
+
+      (&&&) :: Bool -> Bool -> Bool
+      (&&&) = (&&)
+
+      type role (***)
+      data (***)
+
+      class (???)
+      instance (???)
+
+      data family ($$$)
+      data instance ($$$)
+
+      type family (^^^)
+      type instance (^^^) = Int
+
+      type family (###) where
+        (###) = Int
+
+      pattern (:!!!) :: Bool
+      pattern (:!!!) = True
+    |])
diff --git a/testsuite/tests/th/T15365.stderr b/testsuite/tests/th/T15365.stderr
new file mode 100644
index 0000000..3c85950
--- /dev/null
+++ b/testsuite/tests/th/T15365.stderr
@@ -0,0 +1,33 @@
+T15365.hs:(9,3)-(31,6): Splicing declarations
+    [d| (&&&) :: Bool -> Bool -> Bool
+        (&&&) = (&&)
+        pattern (:!!!) :: Bool
+        pattern (:!!!) = True
+        
+        type (|||) = Either
+        data (***)
+        class (???)
+        data family ($$$)
+        type family (^^^)
+        type family (###) where
+          (###) = Int
+        
+        instance (???)
+        data instance ($$$)
+        type instance (^^^) = Int |]
+  ======>
+    type (|||) = Either
+    (&&&) :: Bool -> Bool -> Bool
+    (&&&) = (&&)
+    type role (***)
+    data (***)
+    class (???)
+    instance (???)
+    data family ($$$)
+    data instance ($$$)
+    type family (^^^)
+    type instance (^^^) = Int
+    type family (###) where
+      (###) = Int
+    pattern (:!!!) :: Bool
+    pattern (:!!!) = True
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index b3f72c8..cd80a6c 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -418,6 +418,7 @@ test('T15243', normal, compile, ['-dsuppress-uniques'])
 test('T15321', normal, compile_fail, [''])
 test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('T15365', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 # Note: T9693 should be only_ways(['ghci']) once it's fixed.
 test('T9693', expect_broken(9693), ghci_script, ['T9693.script'])
 test('T14471', normal, compile, [''])