From c7bbad9a0aab2d7b4336ae411e13d9450d8483a7 Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Mon, 10 Jul 2023 16:06:22 +0200
Subject: [PATCH] rnImports: var shouldn't import NoFldSelectors
In an import declaration such as
import M ( var )
the import of the variable "var" should **not** bring into scope record
fields named "var" which are defined with NoFieldSelectors.
Doing so can cause spurious "unused import" warnings, as reported in
ticket #23557.
Fixes #23557
---
compiler/GHC/Rename/Names.hs | 21 +++++++++++++++++--
compiler/GHC/Tc/Errors/Ppr.hs | 4 ++--
compiler/GHC/Types/Name/Reader.hs | 8 +++----
.../should_compile/T23557.hs | 11 ++++++++++
.../should_compile/T23557_aux.hs | 10 +++++++++
.../overloadedrecflds/should_compile/all.T | 2 +-
6 files changed, 47 insertions(+), 9 deletions(-)
create mode 100644 testsuite/tests/overloadedrecflds/should_compile/T23557.hs
create mode 100644 testsuite/tests/overloadedrecflds/should_compile/T23557_aux.hs
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 1e0d2f834fd2..af426dd1804a 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -308,7 +308,7 @@ Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in
--
-- 4. A boolean 'AnyHpcUsage' which is true if the imported module
-- used HPC.
-rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc)
+rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc)
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl this_mod
(L loc decl@(ImportDecl { ideclName = loc_imp_mod_name
@@ -1232,7 +1232,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
item:items -> return $ item :| items
where
lookups = concatMap nonDetNameEnvElts
- $ lookupOccEnv_WithFields imp_occ_env (rdrNameOcc rdr)
+ $ lookupImpOccEnv (RelevantGREsFOS WantNormal) imp_occ_env (rdrNameOcc rdr)
lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, [GlobalRdrElt])]
lookup_lie (L loc ieRdr)
@@ -1486,6 +1486,23 @@ mkImportOccEnv hsc_env decl_spec all_avails =
else item1
-- Discard standalone pattern P in favour of T(P).
+-- | Essentially like @lookupGRE env (LookupOccName occ which_gres)@,
+-- but working with 'ImpOccItem's instead of 'GlobalRdrElt's.
+lookupImpOccEnv :: WhichGREs GREInfo
+ -> OccEnv (NameEnv ImpOccItem) -> OccName -> [NameEnv ImpOccItem]
+lookupImpOccEnv which_gres env occ =
+ mapMaybe relevant_items $ lookupOccEnv_AllNameSpaces env occ
+ where
+ is_relevant :: ImpOccItem -> Bool
+ is_relevant (ImpOccItem { imp_item = gre }) =
+ greIsRelevant which_gres (occNameSpace occ) gre
+ relevant_items :: NameEnv ImpOccItem -> Maybe (NameEnv ImpOccItem)
+ relevant_items nms
+ | let nms' = filterNameEnv is_relevant nms
+ = if isEmptyNameEnv nms'
+ then Nothing
+ else Just nms'
+
{-
************************************************************************
* *
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 332d7963f61d..002b1e7fc73e 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -62,9 +62,11 @@ import GHC.Driver.Backend
import GHC.Hs
import GHC.Tc.Errors.Types
+import GHC.Tc.Types.BasicTypes
import GHC.Tc.Types.Constraint
import GHC.Tc.Types.Origin
import GHC.Tc.Types.Rank (Rank(..))
+import GHC.Tc.Types.TH
import GHC.Tc.Utils.TcType
import GHC.Types.Error
@@ -116,8 +118,6 @@ import Data.List ( groupBy, sortBy, tails
, partition, unfoldr )
import Data.Ord ( comparing )
import Data.Bifunctor
-import GHC.Tc.Types.TH
-import GHC.Tc.Types.BasicTypes
defaultTcRnMessageOpts :: TcRnMessageOpts
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index 92cf4ac9b972..f048c4b0747c 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -1313,19 +1313,19 @@ lookupGRE env = \case
--
-- This allows us to first look in e.g. the data 'NameSpace', and then fall back
-- to the type/class 'NameSpace'.
-highestPriorityGREs :: forall info prio
+highestPriorityGREs :: forall gre prio
. Ord prio
- => (GlobalRdrEltX info -> Maybe prio)
+ => (gre -> Maybe prio)
-- ^ priority function
-- lower value <=> higher priority
- -> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
+ -> [gre] -> [gre]
highestPriorityGREs priority gres =
take_highest_prio $ NE.group $ sort
[ S.Arg prio gre
| gre <- gres
, prio <- maybeToList $ priority gre ]
where
- take_highest_prio :: [NE.NonEmpty (S.Arg prio (GlobalRdrEltX info))] -> [GlobalRdrEltX info]
+ take_highest_prio :: [NE.NonEmpty (S.Arg prio gre)] -> [gre]
take_highest_prio [] = []
take_highest_prio (fs:_) = map (\ (S.Arg _ gre) -> gre) $ NE.toList fs
{-# INLINEABLE highestPriorityGREs #-}
diff --git a/testsuite/tests/overloadedrecflds/should_compile/T23557.hs b/testsuite/tests/overloadedrecflds/should_compile/T23557.hs
new file mode 100644
index 000000000000..fb6ab1690cae
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_compile/T23557.hs
@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -Werror=unused-imports #-}
+
+module T23557 (main) where
+
+import T23557_aux (foo)
+
+main :: IO ()
+main = print foo
+
+-- We should not get an unused import for the import of the field selector "foo",
+-- because the module we are importing from uses NoFieldSelectors.
diff --git a/testsuite/tests/overloadedrecflds/should_compile/T23557_aux.hs b/testsuite/tests/overloadedrecflds/should_compile/T23557_aux.hs
new file mode 100644
index 000000000000..dcc11feec2b2
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_compile/T23557_aux.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE NoFieldSelectors #-}
+
+module T23557_aux where
+
+foo :: Int
+foo = 23
+
+data Foo = Foo {
+ foo :: Int
+}
diff --git a/testsuite/tests/overloadedrecflds/should_compile/all.T b/testsuite/tests/overloadedrecflds/should_compile/all.T
index 538e0d01c26f..40dcded023ef 100644
--- a/testsuite/tests/overloadedrecflds/should_compile/all.T
+++ b/testsuite/tests/overloadedrecflds/should_compile/all.T
@@ -50,9 +50,9 @@ test('BootFldReexport'
test('T23220'
, [req_th, extra_files(['T23220_aux.hs'])]
, multimod_compile, ['T23220_aux.hs T23220.hs', '-v0'])
-
test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A', '-v0'])
test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0'])
test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0'])
test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0'])
test('T23279', [extra_files(['T23279_aux.hs'])], multimod_compile, ['T23279', '-v0'])
+test('T23557', [extra_files(['T23557_aux.hs'])], multimod_compile, ['T23557', '-v0'])
--
GitLab