diff options
| -rw-r--r-- | compiler/rename/RnEnv.hs | 18 | ||||
| -rw-r--r-- | testsuite/tests/th/T13968.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/th/T13968.stderr | 3 | ||||
| -rw-r--r-- | 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 617b3556bb..298de54168 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 0000000000..1e54ef12f3 --- /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 0000000000..2850dae0c5 --- /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 f89be6e0bb..df31162c3e 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']) |