diff options
author | Yuras Shumovich <shumovichy@gmail.com> | 2014-06-05 07:56:05 -0500 |
---|---|---|
committer | Austin Seipp <austin@well-typed.com> | 2014-06-05 07:56:05 -0500 |
commit | c226d25fef519db663d0c9efe7845637423f1dca (patch) | |
tree | 3d500b84ece11cdf13983df9ad6277974d37696d | |
parent | 56ea745c3dd00c87ad86b80f91a31ced5e86e488 (diff) | |
download | haskell-c226d25fef519db663d0c9efe7845637423f1dca.tar.gz |
Emit error in case of duplicate GRE; fixes #7241
Signed-off-by: Austin Seipp <austin@well-typed.com>
-rw-r--r-- | compiler/rename/RnEnv.lhs | 21 | ||||
-rw-r--r-- | testsuite/tests/th/T7241.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/th/T7241.stderr | 6 | ||||
-rw-r--r-- | testsuite/tests/th/T8932.stderr | 16 | ||||
-rw-r--r-- | testsuite/tests/th/all.T | 1 |
5 files changed, 39 insertions, 12 deletions
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index bdc2cdfe59..a89ab1f0a0 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -268,22 +268,29 @@ lookupExactOcc name ; return name } - (gre:_) -> return (gre_name gre) } + [gre] -> return (gre_name gre) + (gre:_) -> do {addErr dup_nm_err + ; return (gre_name gre) + } -- We can get more than one GRE here, if there are multiple - -- bindings for the same name; but there will already be a - -- reported error for the duplicate. (If we add the error - -- rather than stopping when we encounter it.) - -- So all we need do here is not crash. - -- Example is Trac #8932: + -- bindings for the same name. Sometimes they are catched later + -- by findLocalDupsRdrEnv, like in the this example (Trac #8932): -- $( [d| foo :: a->a; foo x = x |]) -- foo = True - -- Here the 'foo' in the splice turns into an Exact Name + -- But when the names are totally identical, we get panic (Trac #7241): + -- $(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] [''Show]]) + -- So, lets emit error here, even if it will lead to two errors in some cases. + } where exact_nm_err = hang (ptext (sLit "The exact Name") <+> quotes (ppr name) <+> ptext (sLit "is not in scope")) 2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ") , ptext (sLit "perhaps via newName, but did not bind it") , ptext (sLit "If that's it, then -ddump-splices might be useful") ]) + dup_nm_err = hang (ptext (sLit "Duplicate exact Name") <+> quotes (ppr $ nameOccName name)) + 2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ") + , ptext (sLit "perhaps via newName, but bound it multiple times") + , ptext (sLit "If that's it, then -ddump-splices might be useful") ]) ----------------------------------------------- lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name diff --git a/testsuite/tests/th/T7241.hs b/testsuite/tests/th/T7241.hs new file mode 100644 index 0000000000..971a2678f8 --- /dev/null +++ b/testsuite/tests/th/T7241.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T7241 where + +import Language.Haskell.TH + +$(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] []]) diff --git a/testsuite/tests/th/T7241.stderr b/testsuite/tests/th/T7241.stderr new file mode 100644 index 0000000000..343cdc827d --- /dev/null +++ b/testsuite/tests/th/T7241.stderr @@ -0,0 +1,6 @@ + +T7241.hs:7:3: + Duplicate exact Name ‘Foo’ + Probable cause: you used a unique Template Haskell name (NameU), + perhaps via newName, but bound it multiple times + If that's it, then -ddump-splices might be useful diff --git a/testsuite/tests/th/T8932.stderr b/testsuite/tests/th/T8932.stderr index 0e0f9774d5..c861235091 100644 --- a/testsuite/tests/th/T8932.stderr +++ b/testsuite/tests/th/T8932.stderr @@ -1,5 +1,11 @@ -
-T8932.hs:11:1:
- Multiple declarations of ‘foo’
- Declared at: T8932.hs:5:3
- T8932.hs:11:1
+ +T8932.hs:5:3: + Duplicate exact Name ‘foo’ + Probable cause: you used a unique Template Haskell name (NameU), + perhaps via newName, but bound it multiple times + If that's it, then -ddump-splices might be useful + +T8932.hs:11:1: + Multiple declarations of ‘foo’ + Declared at: T8932.hs:5:3 + T8932.hs:11:1 diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 22bb7cc637..ca7ead628e 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -326,4 +326,5 @@ test('T8884', normal, compile, ['-v0']) test('T8954', normal, compile, ['-v0']) test('T8932', normal, compile_fail, ['-v0']) test('T8987', normal, compile_fail, ['-v0']) +test('T7241', normal, compile_fail, ['-v0']) |