[commit: ghc] master: Fix handling of unbound constructor names in TH #14627 (0f79b0e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/0f79b0ef140e086a48d1aa5b945ad5a3754ccdd1/ghc

>---------------------------------------------------------------

commit 0f79b0ef140e086a48d1aa5b945ad5a3754ccdd1
Author: Michael Sloan <mgsloan at gmail.com>
Date:   Thu Jul 12 10:07:28 2018 -0400

    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


>---------------------------------------------------------------

0f79b0ef140e086a48d1aa5b945ad5a3754ccdd1
 compiler/hsSyn/Convert.hs                                | 6 +++++-
 libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 7 ++++++-
 testsuite/tests/th/T14627.hs                             | 6 ++++++
 testsuite/tests/th/T14627.stderr                         | 2 ++
 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 c64cb7c..84e4594 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 9665c65..f5f60c3 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 0000000..aebf6bd
--- /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 0000000..1db6488
--- /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 d55d415..b3f72c8 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, [''])