[commit: ghc] master: Fix embarrassing infinite loop in pprParendType (89d8092)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/89d80921d9328499ffca9877e7dea540350be9c1/ghc

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

commit 89d80921d9328499ffca9877e7dea540350be9c1
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Mon Dec 3 07:03:55 2018 -0500

    Fix embarrassing infinite loop in pprParendType
    
    Summary:
    `pprParendType` was missing an explicit case for
    `EqualityT`, which caused it to fall through to a catch-all case
    that invokes `ppr`. But `ppr` itself does not have a case for a
    partial application of `EqualityT`, so //it// falls back to
    `pprParendType`, resulting in an infinite loop!
    
    The fix is simple: add a case for `EqualityT` in `pprParendType`.
    While I was in the neighborhood, I removed the catch-call case in
    `pprParendType` to make this sort of mistake less likely to happen
    in the future.
    
    Test Plan: make test TEST=T15985
    
    Reviewers: bgamari, monoidal, simonpj
    
    Reviewed By: monoidal, simonpj
    
    Subscribers: rwbarton, carter
    
    GHC Trac Issues: #15985
    
    Differential Revision: https://phabricator.haskell.org/D5403


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

89d80921d9328499ffca9877e7dea540350be9c1
 libraries/template-haskell/Language/Haskell/TH/Ppr.hs | 4 +++-
 testsuite/tests/th/T15985.hs                          | 7 +++++++
 testsuite/tests/th/all.T                              | 1 +
 3 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 138cf62..621c0f5 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -739,7 +739,9 @@ pprParendType tuple | (TupleT n, args) <- split tuple
                     , length args == n
                     = parens (commaSep args)
 pprParendType (ImplicitParamT n t)= text ('?':n) <+> text "::" <+> ppr t
-pprParendType other               = parens (ppr other)
+pprParendType EqualityT           = text "(~)"
+pprParendType t@(ForallT {})      = parens (ppr t)
+pprParendType t@(AppT {})         = parens (ppr t)
 
 pprUInfixT :: Type -> Doc
 pprUInfixT (UInfixT x n y) = pprUInfixT x <+> pprName' Infix n <+> pprUInfixT y
diff --git a/testsuite/tests/th/T15985.hs b/testsuite/tests/th/T15985.hs
new file mode 100644
index 0000000..3ddd557
--- /dev/null
+++ b/testsuite/tests/th/T15985.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T15985 where
+
+import Language.Haskell.TH
+
+foo :: String
+foo = $(stringE (pprint EqualityT))
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index b158313..e404c8f 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -451,3 +451,4 @@ test('T15815', normal, multimod_compile,
 test('T15845', normal, compile, ['-v0 -dsuppress-uniques'])
 test('T15437', expect_broken(15437), multimod_compile,
      ['T15437', '-v0 ' + config.ghc_th_way_flags])
+test('T15985', normal, compile, [''])