Fix embarrassing infinite loop in pprParendType
authorRyan Scott <ryan.gl.scott@gmail.com>
Mon, 3 Dec 2018 12:03:55 +0000 (07:03 -0500)
committerRyan Scott <ryan.gl.scott@gmail.com>
Mon, 3 Dec 2018 12:03:55 +0000 (07:03 -0500)
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

libraries/template-haskell/Language/Haskell/TH/Ppr.hs
testsuite/tests/th/T15985.hs [new file with mode: 0644]
testsuite/tests/th/all.T

index 138cf62..621c0f5 100644 (file)
@@ -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 (file)
index 0000000..3ddd557
--- /dev/null
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T15985 where
+
+import Language.Haskell.TH
+
+foo :: String
+foo = $(stringE (pprint EqualityT))
index b158313..e404c8f 100644 (file)
@@ -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, [''])