diff options
author | Michael Sloan <mgsloan@gmail.com> | 2018-07-12 10:07:28 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2018-07-12 15:04:05 -0400 |
commit | 0f79b0ef140e086a48d1aa5b945ad5a3754ccdd1 (patch) | |
tree | ab69d7ca75deac90c285e0e982c4a1bd3a92a288 | |
parent | 234093cf1562d032b38382a5cc08be8dd71c4fe3 (diff) | |
download | haskell-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.hs | 6 | ||||
-rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/th/T14627.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/th/T14627.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/th/all.T | 1 |
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, ['']) |