summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2019-12-19 11:50:10 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-12-20 10:50:57 -0500
commit70e56b272492b65e41a149ec39a939e794fea66b (patch)
treea030c730bed2d539433ebdf16609aa88439c83fe
parent1a0d1a6583cc39a31d6947eda1d4998c4fb53c4f (diff)
downloadhaskell-70e56b272492b65e41a149ec39a939e794fea66b.tar.gz
lookupBindGroupOcc: recommend names in the same namespace (#17593)
Previously, `lookupBindGroupOcc`'s error message would recommend all similar names in scope, regardless of whether they were type constructors, data constructors, or functions, leading to the confusion witnessed in #17593. This is easily fixed by only recommending names in the same namespace, using the `nameSpacesRelated` function. Fixes #17593.
-rw-r--r--compiler/basicTypes/Name.hs12
-rw-r--r--compiler/iface/LoadIface.hs2
-rw-r--r--compiler/rename/RnEnv.hs13
-rw-r--r--testsuite/tests/rename/should_fail/T17593.hs9
-rw-r--r--testsuite/tests/rename/should_fail/T17593.stderr7
-rw-r--r--testsuite/tests/rename/should_fail/all.T1
6 files changed, 35 insertions, 9 deletions
diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index b0dfa806e0..2cbd50ed6f 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -50,7 +50,7 @@ module Name (
-- ** Manipulating and deconstructing 'Name's
nameUnique, setNameUnique,
- nameOccName, nameModule, nameModule_maybe,
+ nameOccName, nameNameSpace, nameModule, nameModule_maybe,
setNameLoc,
tidyNameOcc,
localiseName,
@@ -196,14 +196,16 @@ instance HasOccName Name where
nameUnique :: Name -> Unique
nameOccName :: Name -> OccName
+nameNameSpace :: Name -> NameSpace
nameModule :: HasDebugCallStack => Name -> Module
nameSrcLoc :: Name -> SrcLoc
nameSrcSpan :: Name -> SrcSpan
-nameUnique name = n_uniq name
-nameOccName name = n_occ name
-nameSrcLoc name = srcSpanStart (n_loc name)
-nameSrcSpan name = n_loc name
+nameUnique name = n_uniq name
+nameOccName name = n_occ name
+nameNameSpace name = occNameSpace (n_occ name)
+nameSrcLoc name = srcSpanStart (n_loc name)
+nameSrcSpan name = n_loc name
{-
************************************************************************
diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index 38f7524b8e..176b6cd0d0 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -156,7 +156,7 @@ importDecl name
where
nd_doc = text "Need decl for" <+> ppr name
not_found_msg = hang (text "Can't find interface-file declaration for" <+>
- pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
+ pprNameSpace (nameNameSpace name) <+> ppr name)
2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file",
text "Use -ddump-if-trace to get an idea of which file caused the error"])
found_things_msg eps =
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 00a76df77a..6f615a1721 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -1475,9 +1475,16 @@ lookupBindGroupOcc ctxt what rdr_name
lookup_top keep_me
= do { env <- getGlobalRdrEnv
; let all_gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
- ; let candidates_msg = candidates $ map gre_name
- $ filter isLocalGRE
- $ globalRdrEnvElts env
+ names_in_scope = -- If rdr_name lacks a binding, only
+ -- recommend alternatives from related
+ -- namespaces. See #17593.
+ filter (\n -> nameSpacesRelated
+ (rdrNameSpace rdr_name)
+ (nameNameSpace n))
+ $ map gre_name
+ $ filter isLocalGRE
+ $ globalRdrEnvElts env
+ candidates_msg = candidates names_in_scope
; case filter (keep_me . gre_name) all_gres of
[] | null all_gres -> bale_out_with candidates_msg
| otherwise -> bale_out_with local_msg
diff --git a/testsuite/tests/rename/should_fail/T17593.hs b/testsuite/tests/rename/should_fail/T17593.hs
new file mode 100644
index 0000000000..6e05343613
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T17593.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+module T17593 where
+
+(<+>) :: Int
+data (<+>)
+
+type MkT :: T
+data T = MkT
diff --git a/testsuite/tests/rename/should_fail/T17593.stderr b/testsuite/tests/rename/should_fail/T17593.stderr
new file mode 100644
index 0000000000..005f6c9fd4
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T17593.stderr
@@ -0,0 +1,7 @@
+
+T17593.hs:5:1: error:
+ The type signature for ‘<+>’ lacks an accompanying binding
+
+T17593.hs:8:6: error:
+ The standalone kind signature for ‘MkT’
+ lacks an accompanying binding
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index c36c4cfcf9..179ff13560 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -152,3 +152,4 @@ test('T16385', normal, compile_fail, [''])
test('T16504', normal, compile_fail, [''])
test('T14548', normal, compile_fail, [''])
test('T16610', normal, compile_fail, [''])
+test('T17593', normal, compile_fail, [''])