diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-08-28 20:54:28 +0200 |
|---|---|---|
| committer | Krzysztof Gogolewski <krz.gogolewski@gmail.com> | 2018-08-28 20:54:28 +0200 |
| commit | c46a5f2002f6694ea58f79f505d57f3b7bd450e7 (patch) | |
| tree | d011cfd805c4326aea30f7d8744d597d5b6f52aa | |
| parent | c18b525a6f226187a12ed907fa5d3b200daab914 (diff) | |
| download | haskell-c46a5f2002f6694ea58f79f505d57f3b7bd450e7.tar.gz | |
Fix #15572 by checking for promoted names in ConT
Summary:
When converting `ConT`s to `HsTyVar`s in `Convert`, we were
failing to account for the possibility of promoted data constructor
names appearing in a `ConT`, which could result in improper
pretty-printing results (as observed in #15572). The fix is
straightforward: use `Promoted` instead of `NotPromoted` when the
name of a `ConT` is a data constructor name.
Test Plan: make test TEST=T15572
Reviewers: goldfire, bgamari, simonpj, monoidal
Reviewed By: goldfire, simonpj
Subscribers: monoidal, rwbarton, carter
GHC Trac Issues: #15572
Differential Revision: https://phabricator.haskell.org/D5112
| -rw-r--r-- | compiler/hsSyn/Convert.hs | 9 | ||||
| -rw-r--r-- | testsuite/tests/th/T15572.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/th/T15572.stderr | 6 | ||||
| -rw-r--r-- | testsuite/tests/th/all.T | 1 |
4 files changed, 23 insertions, 1 deletions
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 687c828fef..832a5134aa 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -1305,7 +1305,14 @@ cvtTypeKind ty_str ty VarT nm -> do { nm' <- tNameL nm ; mk_apps (HsTyVar noExt NotPromoted nm') tys' } ConT nm -> do { nm' <- tconName nm - ; mk_apps (HsTyVar noExt NotPromoted (noLoc nm')) tys'} + ; -- ConT can contain both data constructor (i.e., + -- promoted) names and other (i.e, unpromoted) + -- names, as opposed to PromotedT, which can only + -- contain data constructor names. See #15572. + let prom = if isRdrDataCon nm' + then Promoted + else NotPromoted + ; mk_apps (HsTyVar noExt prom (noLoc nm')) tys'} ForallT tvs cxt ty | null tys' diff --git a/testsuite/tests/th/T15572.hs b/testsuite/tests/th/T15572.hs new file mode 100644 index 0000000000..7bbbcacbcd --- /dev/null +++ b/testsuite/tests/th/T15572.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module T15572 where + +import Language.Haskell.TH + +$([d| type AbsoluteUnit1 = '() |]) +$(pure [TySynD (mkName "AbsoluteUnit2") [] (ConT '())]) diff --git a/testsuite/tests/th/T15572.stderr b/testsuite/tests/th/T15572.stderr new file mode 100644 index 0000000000..27132d69e0 --- /dev/null +++ b/testsuite/tests/th/T15572.stderr @@ -0,0 +1,6 @@ +T15572.hs:7:3-33: Splicing declarations + [d| type AbsoluteUnit1 = '() |] ======> type AbsoluteUnit1 = '() +T15572.hs:8:3-54: Splicing declarations + pure [TySynD (mkName "AbsoluteUnit2") [] (ConT '())] + ======> + type AbsoluteUnit2 = '() diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 296cec7718..cf9153e43d 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -428,3 +428,4 @@ test('TH_invalid_add_top_decl', normal, compile_fail, ['']) test('T15550', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15502', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T15518', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15572', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) |