[Git][ghc/ghc][wip/fabu/T24452-confusing-error] compiler: Fix emitting a confusing error for non visible class method
Fabricio Nascimento (@fabu)
gitlab at gitlab.haskell.org
Fri Jun 21 14:09:27 UTC 2024
Fabricio Nascimento pushed to branch wip/fabu/T24452-confusing-error at Glasgow Haskell Compiler / GHC
Commits:
fa6b8287 by Fabricio de Sousa Nascimento at 2024-06-21T23:06:31+09:00
compiler: Fix emitting a confusing error for non visible class method
Changes the error message when trying to lookup names on GRE that
`must_have_parent` but we get an `AmbiguousOccurrence`. The new
behavior now points the user to the missing name, instead of the
name clash which would be unhelpful in solving their compiling issue.
Fixes #24452
- - - - -
11 changed files:
- compiler/GHC/Rename/Env.hs
- + testsuite/tests/rename/T24452/T24452a.hs
- + testsuite/tests/rename/T24452/T24452b.hs
- + testsuite/tests/rename/T24452/T24452b.stderr
- + testsuite/tests/rename/T24452/T24452c.hs
- + testsuite/tests/rename/T24452/T24452c.stderr
- + testsuite/tests/rename/T24452/T24452d.hs
- + testsuite/tests/rename/T24452/T24452d.stderr
- + testsuite/tests/rename/T24452/T24452e.hs
- + testsuite/tests/rename/T24452/T24452e.stderr
- + testsuite/tests/rename/T24452/all.T
Changes:
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -708,8 +708,8 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup
else checkFld g
DisambiguatedOccurrence g ->
checkFld g
- AmbiguousOccurrence gres ->
- mkNameClashErr gres
+ AmbiguousOccurrence _ ->
+ noMatchingParentErr original_gres
where
checkFld :: GlobalRdrElt -> RnM ChildLookupResult
checkFld g = do
@@ -721,21 +721,25 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup
-- 1. There were none to begin with.
-- 2. None of the matching ones were the parent but
-- a. They were from an overloaded record field so we can report
- -- a better error
+ -- a better error.
-- b. The original lookup was actually ambiguous.
-- For example, the case where overloading is off and two
-- record fields are in scope from different record
- -- constructors, neither of which is the parent.
+ -- constructors, neither of which is the parent. Or two or more
+ -- class methods with the same name are in scope, in which case
+ -- we want to report we did not find the method for the expected
+ -- parent, instead of a clashing name error, which would be confusing
+ -- and point the user the wrong direction (#24452).
noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr original_gres = do
- traceRn "npe" (ppr original_gres)
+ traceRn "noMatchingParentErr" (ppr original_gres)
dup_fields_ok <- xoptM LangExt.DuplicateRecordFields
case original_gres of
[] -> return NameNotFound
[g] -> return $ IncorrectParent parent g
[p | ParentIs p <- [greParent g]]
gss@(g:gss'@(_:_)) ->
- if all isRecFldGRE gss && dup_fields_ok
+ if must_have_parent || dup_fields_ok && all isRecFldGRE gss
then return $
IncorrectParent parent g
[p | x <- gss, ParentIs p <- [greParent x]]
=====================================
testsuite/tests/rename/T24452/T24452a.hs
=====================================
@@ -0,0 +1,13 @@
+-- A program with empty (Alternative.empty, Map.empty, Set.empty) builds
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module BugReproduce where
+
+import Control.Applicative (Alternative (empty, (<|>)))
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+newtype Foo a = MkFoo [a] deriving (Functor, Applicative)
+
+instance Alternative Foo where
+ empty = undefined
+ p <|> q = undefined
=====================================
testsuite/tests/rename/T24452/T24452b.hs
=====================================
@@ -0,0 +1,10 @@
+-- Alternative.empty is not visible
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module BugReproduce where
+
+import Control.Applicative (Alternative)
+
+newtype Foo a = MkFoo [a] deriving (Functor, Applicative)
+
+instance Alternative Foo where
+ empty = undefined
=====================================
testsuite/tests/rename/T24452/T24452b.stderr
=====================================
@@ -0,0 +1,2 @@
+T24452b.hs:10:3: error: [GHC-54721]
+ ‘empty’ is not a (visible) method of class ‘Alternative’
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/T24452c.hs
=====================================
@@ -0,0 +1,11 @@
+-- Having Map.empty present, does not change the fact that Alternative.empty is not visible
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module BugReproduce where
+
+import Control.Applicative (Alternative)
+import qualified Data.Map as Map
+
+newtype Foo a = MkFoo [a] deriving (Functor, Applicative)
+
+instance Alternative Foo where
+ empty = undefined
=====================================
testsuite/tests/rename/T24452/T24452c.stderr
=====================================
@@ -0,0 +1,2 @@
+T24452c.hs:11:3: error: [GHC-54721]
+ ‘empty’ is not a (visible) method of class ‘Alternative’
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/T24452d.hs
=====================================
@@ -0,0 +1,12 @@
+-- Multiple other empty (Map.empty, Data.empty), but the issue still Alternative.empty not visible.
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module BugReproduce where
+
+import Control.Applicative (Alternative)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+newtype Foo a = MkFoo [a] deriving (Functor, Applicative)
+
+instance Alternative Foo where
+ empty = undefined
=====================================
testsuite/tests/rename/T24452/T24452d.stderr
=====================================
@@ -0,0 +1,2 @@
+T24452d.hs:12:3: error: [GHC-54721]
+ ‘empty’ is not a (visible) method of class ‘Alternative’
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/T24452e.hs
=====================================
@@ -0,0 +1,24 @@
+-- Multiple unrelated errors related to empty.
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedRecordUpdate #-}
+
+module BugReproduce where
+
+import Control.Applicative (Alternative)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+data A = A {
+ empty :: ()
+}
+data B = B {
+ empty :: ()
+}
+
+foo = empty
+
+newtype Foo a = MkFoo [a] deriving (Functor, Applicative)
+
+instance Alternative Foo where
+ empty = undefined
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/T24452e.stderr
=====================================
@@ -0,0 +1,10 @@
+T24452e.hs:19:7: error: [GHC-87543]
+ Ambiguous occurrence ‘empty’.
+ It could refer to
+ either the field ‘empty’ of record ‘A’,
+ defined at T24452e.hs:13:5,
+ or the field ‘empty’ of record ‘B’,
+ defined at T24452e.hs:16:5.
+
+T24452e.hs:24:3: error: [GHC-54721]
+ ‘empty’ is not a (visible) method of class ‘Alternative’
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/all.T
=====================================
@@ -0,0 +1,5 @@
+test('T24452a', normal, compile, [''])
+test('T24452b', normal, compile_fail, [''])
+test('T24452c', normal, compile_fail, [''])
+test('T24452d', normal, compile_fail, [''])
+test('T24452e', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa6b82877f19f033dc249378b8d3f1f170658fab
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa6b82877f19f033dc249378b8d3f1f170658fab
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240621/21ea8b27/attachment-0001.html>
More information about the ghc-commits
mailing list