summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichael Sloan <mgsloan@gmail.com>2018-07-12 10:07:28 -0400
committerBen Gamari <ben@smart-cactus.org>2018-07-12 15:04:05 -0400
commit0f79b0ef140e086a48d1aa5b945ad5a3754ccdd1 (patch)
treeab69d7ca75deac90c285e0e982c4a1bd3a92a288
parent234093cf1562d032b38382a5cc08be8dd71c4fe3 (diff)
downloadhaskell-0f79b0ef140e086a48d1aa5b945ad5a3754ccdd1.tar.gz
Fix handling of unbound constructor names in TH #14627
Also adds a comment to UnboundVarE clarifying that it also is used for unbound constructor identifiers, since that isn't very clear from the name. Test Plan: testsuite/tests/th/T14627.hs Reviewers: goldfire, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4923
-rw-r--r--compiler/hsSyn/Convert.hs6
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Syntax.hs7
-rw-r--r--testsuite/tests/th/T14627.hs6
-rw-r--r--testsuite/tests/th/T14627.stderr2
-rw-r--r--testsuite/tests/th/all.T1
5 files changed, 20 insertions, 2 deletions
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index c64cb7c662..84e45948d2 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -913,7 +913,11 @@ cvtl e = wrapL (cvt e)
flds
; return $ mkRdrRecordUpd e' flds' }
cvt (StaticE e) = fmap (HsStatic noExt) $ cvtl e
- cvt (UnboundVarE s) = do { s' <- vName s; return $ HsVar noExt (noLoc s') }
+ cvt (UnboundVarE s) = do -- Use of 'vcName' here instead of 'vName' is
+ -- important, because UnboundVarE may contain
+ -- constructor names - see #14627.
+ { s' <- vcName s
+ ; return $ HsVar noExt (noLoc s') }
cvt (LabelE s) = do { return $ HsOverLabel noExt Nothing (fsLit s) }
{- Note [Dropping constructors]
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 9665c65cf4..f5f60c38b4 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1620,7 +1620,12 @@ data Exp
| RecConE Name [FieldExp] -- ^ @{ T { x = y, z = w } }@
| RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@
| StaticE Exp -- ^ @{ static e }@
- | UnboundVarE Name -- ^ @{ _x }@ (hole)
+ | UnboundVarE Name -- ^ @{ _x }@
+ --
+ -- This is used for holes or unresolved
+ -- identifiers in AST quotes. Note that
+ -- it could either have a variable name
+ -- or constructor name.
| LabelE String -- ^ @{ #x }@ ( Overloaded label )
deriving( Show, Eq, Ord, Data, Generic )
diff --git a/testsuite/tests/th/T14627.hs b/testsuite/tests/th/T14627.hs
new file mode 100644
index 0000000000..aebf6bd4b8
--- /dev/null
+++ b/testsuite/tests/th/T14627.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+import Language.Haskell.TH.Syntax
+
+[d| f = Bool |] >>= addTopDecls >> return []
+
+main = return ()
diff --git a/testsuite/tests/th/T14627.stderr b/testsuite/tests/th/T14627.stderr
new file mode 100644
index 0000000000..1db648811b
--- /dev/null
+++ b/testsuite/tests/th/T14627.stderr
@@ -0,0 +1,2 @@
+
+T14627.hs:4:1: error: Data constructor not in scope: Bool
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index d55d4150cb..b3f72c8b92 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -422,3 +422,4 @@ test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T9693', expect_broken(9693), ghci_script, ['T9693.script'])
test('T14471', normal, compile, [''])
test('TH_rebindableAdo', normal, compile, [''])
+test('T14627', normal, compile_fail, [''])