diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-12-03 07:03:55 -0500 |
|---|---|---|
| committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-12-03 07:03:55 -0500 |
| commit | 89d80921d9328499ffca9877e7dea540350be9c1 (patch) | |
| tree | ecb2c4b4577af6bf2ce373de42d6fe204c3cc855 | |
| parent | 2e6cc3d08f8439a2c0b6426e839d80072dbcda2c (diff) | |
| download | haskell-89d80921d9328499ffca9877e7dea540350be9c1.tar.gz | |
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
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Ppr.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/th/T15985.hs | 7 | ||||
| -rw-r--r-- | testsuite/tests/th/all.T | 1 |
3 files changed, 11 insertions, 1 deletions
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs index 138cf62b24..621c0f5fcc 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 0000000000..3ddd5577f8 --- /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 b1583138cc..e404c8ff82 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, ['']) |