[commit: ghc] master: Fix #13968 by consulting isBuiltInOcc_maybe (d774b4e)

[git at git.haskell.org]

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

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

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

commit d774b4e2de4f07d2432b67010305fede7aeefc78
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Wed Jul 26 17:13:57 2017 -0400

    Fix #13968 by consulting isBuiltInOcc_maybe
    
    Summary:
    We were unconditionally reporting `Illegal binding of built-in syntax`
    in an error message, but this error doesn't make sense in certain Template
    Haskell scenarios which can trigger it. Let's give a more sensible error
    message by first checking if the name we're binding really is built-in syntax,
    using the handy `isBuiltInOcc_maybe` function.
    
    Test Plan: make test TEST=T13968
    
    Reviewers: bgamari, austin, goldfire
    
    Reviewed By: goldfire
    
    Subscribers: goldfire, rwbarton, thomie
    
    GHC Trac Issues: #13968
    
    Differential Revision: https://phabricator.haskell.org/D3789


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

d774b4e2de4f07d2432b67010305fede7aeefc78
 compiler/rename/RnEnv.hs         | 18 +++++++++++++++---
 testsuite/tests/th/T13968.hs     |  6 ++++++
 testsuite/tests/th/T13968.stderr |  3 +++
 testsuite/tests/th/all.T         |  1 +
 4 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 617b355..298de54 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -53,7 +53,7 @@ import HscTypes
 import TcEnv
 import TcRnMonad
 import RdrHsSyn         ( setRdrNameSpace )
-import TysWiredIn       ( starKindTyConName, unicodeStarKindTyConName )
+import TysWiredIn
 import Name
 import NameSet
 import NameEnv
@@ -1573,5 +1573,17 @@ opDeclErr n
 
 badOrigBinding :: RdrName -> SDoc
 badOrigBinding name
-  = text "Illegal binding of built-in syntax:" <+> ppr (rdrNameOcc name)
-        -- The rdrNameOcc is because we don't want to print Prelude.(,)
+  | Just _ <- isBuiltInOcc_maybe occ
+  = text "Illegal binding of built-in syntax:" <+> ppr occ
+    -- Use an OccName here because we don't want to print Prelude.(,)
+  | otherwise
+  = text "Cannot redefine a Name retrieved by a Template Haskell quote:"
+    <+> ppr name
+    -- This can happen when one tries to use a Template Haskell splice to
+    -- define a top-level identifier with an already existing name, e.g.,
+    --
+    --   $(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []])
+    --
+    -- (See Trac #13968.)
+  where
+    occ = rdrNameOcc name
diff --git a/testsuite/tests/th/T13968.hs b/testsuite/tests/th/T13968.hs
new file mode 100644
index 0000000..1e54ef1
--- /dev/null
+++ b/testsuite/tests/th/T13968.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T13968 where
+
+import Language.Haskell.TH
+
+$(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []])
diff --git a/testsuite/tests/th/T13968.stderr b/testsuite/tests/th/T13968.stderr
new file mode 100644
index 0000000..2850dae
--- /dev/null
+++ b/testsuite/tests/th/T13968.stderr
@@ -0,0 +1,3 @@
+
+T13968.hs:6:3: error:
+    Cannot redefine a Name retrieved by a Template Haskell quote: succ
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index f89be6e..df31162 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -390,3 +390,4 @@ test('T13642', normal, compile_fail, ['-v0'])
 test('T13781', normal, compile, ['-v0'])
 test('T13782', normal, compile, [''])
 test('T13856', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('T13968', normal, compile_fail, ['-v0'])