diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index f64eb59bcbaab7bc42e0994576a78c1021273277..3db8fe5c617edd5ffea36aaae75755e3595a6486 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -259,7 +259,6 @@ ieNames (IEVar _ (L _ n) _) = [ieWrappedName n]
ieNames (IEThingAbs _ (L _ n) _) = [ieWrappedName n]
ieNames (IEThingAll _ (L _ n) _) = [ieWrappedName n]
ieNames (IEThingWith _ (L _ n) _ ns _) = ieWrappedName n : map (ieWrappedName . unLoc) ns
--- NB the above case does not include names of field selectors
ieNames (IEModuleContents {}) = []
ieNames (IEGroup {}) = []
ieNames (IEDoc {}) = []
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 79a74337fe987a1b909e42086b7f08627379edb4..24ca18f5f013d7b7ed382f707c6e6e96cd1bb2bb 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -93,6 +93,7 @@ import GHC.Data.FastString.Env
import GHC.Data.Maybe
import GHC.Data.List.SetOps ( removeDups )
+import Control.Arrow ( second )
import Control.Monad
import Data.Foldable ( for_ )
import Data.IntMap ( IntMap )
@@ -100,6 +101,8 @@ import qualified Data.IntMap as IntMap
import Data.Map ( Map )
import qualified Data.Map as Map
import Data.Ord ( comparing )
+import Data.Semigroup ( Any(..) )
+import qualified Data.Semigroup as S
import Data.List ( partition, find, sortBy )
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
@@ -108,6 +111,7 @@ import qualified Data.Set as S
import System.FilePath ((</>))
import System.IO
+
{-
************************************************************************
* *
@@ -1842,21 +1846,21 @@ findImportUsage imports used_gres
-- srcSpanEnd: see Note [The ImportMap]
`orElse` []
- used_names = mkNameSet (map greName used_gres)
+ used_gre_env = mkGlobalRdrEnv used_gres
used_parents = mkNameSet (mapMaybe greParent_maybe used_gres)
unused_imps -- Not trivial; see eg #7454
= case imps of
Just (Exactly, L _ imp_ies) ->
- foldr (add_unused . unLoc) emptyNameSet imp_ies
+ let unused = foldr (add_unused . unLoc) (UnusedNames emptyNameSet emptyFsEnv) imp_ies
+ in collectUnusedNames unused
_other -> emptyNameSet -- No explicit import list => no unused-name list
- add_unused :: IE GhcRn -> NameSet -> NameSet
- add_unused (IEVar _ n _) acc = add_unused_name (lieWrappedName n) acc
- add_unused (IEThingAbs _ n _) acc = add_unused_name (lieWrappedName n) acc
+ add_unused :: IE GhcRn -> UnusedNames -> UnusedNames
+ add_unused (IEVar _ n _) acc = add_unused_name (lieWrappedName n) True acc
+ add_unused (IEThingAbs _ n _) acc = add_unused_name (lieWrappedName n) False acc
add_unused (IEThingAll _ n _) acc = add_unused_all (lieWrappedName n) acc
- add_unused (IEThingWith _ p wc ns _) acc =
- add_wc_all (add_unused_with pn xs acc)
+ add_unused (IEThingWith _ p wc ns _) acc = add_wc_all (add_unused_with pn xs acc)
where pn = lieWrappedName p
xs = map lieWrappedName ns
add_wc_all = case wc of
@@ -1864,21 +1868,115 @@ findImportUsage imports used_gres
IEWildcard _ -> add_unused_all pn
add_unused _ acc = acc
- add_unused_name n acc
- | n `elemNameSet` used_names = acc
- | otherwise = acc `extendNameSet` n
- add_unused_all n acc
- | n `elemNameSet` used_names = acc
- | n `elemNameSet` used_parents = acc
- | otherwise = acc `extendNameSet` n
+ add_unused_name :: Name -> Bool -> UnusedNames -> UnusedNames
+ add_unused_name n is_ie_var acc@(UnusedNames acc_ns acc_fs)
+ | is_ie_var
+ , isFieldName n
+ -- See Note [Reporting unused imported duplicate record fields]
+ = let
+ fs = getOccFS n
+ (flds, flds_used) = lookupFsEnv acc_fs fs `orElse` (emptyNameSet, Any False)
+ acc_fs' = extendFsEnv acc_fs fs (extendNameSet flds n, Any used S.<> flds_used)
+ in UnusedNames acc_ns acc_fs'
+ | used
+ = acc
+ | otherwise
+ = UnusedNames (acc_ns `extendNameSet` n) acc_fs
+ where
+ used = isJust $ lookupGRE_Name used_gre_env n
+
+ add_unused_all :: Name -> UnusedNames -> UnusedNames
+ add_unused_all n (UnusedNames acc_ns acc_fs)
+ | Just {} <- lookupGRE_Name used_gre_env n = UnusedNames acc_ns acc_fs
+ | n `elemNameSet` used_parents = UnusedNames acc_ns acc_fs
+ | otherwise = UnusedNames (acc_ns `extendNameSet` n) acc_fs
+
+ add_unused_with :: Name -> [Name] -> UnusedNames -> UnusedNames
add_unused_with p ns acc
- | all (`elemNameSet` acc1) ns = add_unused_name p acc1
- | otherwise = acc1
+ | all (`elemNameSet` acc1_ns) ns = add_unused_name p False acc1
+ | otherwise = acc1
where
- acc1 = foldr add_unused_name acc ns
- -- If you use 'signum' from Num, then the user may well have
- -- imported Num(signum). We don't want to complain that
- -- Num is not itself mentioned. Hence the two cases in add_unused_with.
+ acc1@(UnusedNames acc1_ns _acc1_fs) = foldr (\n acc' -> add_unused_name n False acc') acc ns
+ -- If you use 'signum' from Num, then the user may well have
+ -- imported Num(signum). We don't want to complain that
+ -- Num is not itself mentioned. Hence the two cases in add_unused_with.
+
+
+-- | An accumulator for unused names in an import list.
+--
+-- See Note [Reporting unused imported duplicate record fields].
+data UnusedNames =
+ UnusedNames
+ { unused_names :: NameSet
+ -- ^ Unused 'Name's in an import list, not including record fields
+ -- that are plain 'IEVar' imports
+ , rec_fld_uses :: FastStringEnv (NameSet, Any)
+ -- ^ Record fields imported without a parent (i.e. an 'IEVar' import).
+ --
+ -- The 'Any' value records whether any of the record fields
+ -- sharing the same underlying 'FastString' have been used.
+ }
+instance Outputable UnusedNames where
+ ppr (UnusedNames nms flds) =
+ text "UnusedNames" <+>
+ braces (ppr nms <+> ppr (fmap (second getAny) flds))
+
+-- | Collect all unused names from a 'UnusedNames' value.
+collectUnusedNames :: UnusedNames -> NameSet
+collectUnusedNames (UnusedNames { unused_names = nms, rec_fld_uses = flds })
+ = nms S.<> unused_flds
+ where
+ unused_flds = nonDetFoldFsEnv collect_unused emptyNameSet flds
+ collect_unused :: (NameSet, Any) -> NameSet -> NameSet
+ collect_unused (nms, Any at_least_one_name_is_used) acc
+ | at_least_one_name_is_used = acc
+ | otherwise = unionNameSet nms acc
+
+{- Note [Reporting unused imported duplicate record fields]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we have (#24035):
+
+ {-# LANGUAGE DuplicateRecordFields #-}
+ module M1 (R1(..), R2(..)) where
+ data R1 = MkR1 { fld :: Int }
+ data R2 = MkR2 { fld :: Int }
+
+ {-# LANGUAGE DuplicateRecordFields #-}
+ module M2 where
+ import M1 (R1(MkR1), R2, fld)
+ f :: R1 -> Int
+ f (MkR1 { fld = x }) = x
+ g :: R2 -> Int
+ g _ = 3
+
+In the import of 'M1' in 'M2', the 'fld' import resolves to two separate GREs,
+namely R1(fld) and R2(fld). From the perspective of the renamer, and in particular
+the 'findImportUsage' function, it's as if the user had imported the two names
+separately (even though no source syntax allows that).
+
+This means that we need to be careful when reporting unused imports: the R2(fld)
+import is indeed unused, but because R1(fld) is used, we should not report
+fld as unused altogether.
+
+To achieve this, we keep track of record field imports without a parent (i.e.
+using the IEVar constructor) separately from other import items, using the
+UnusedNames datatype.
+Once we have accumulated usages, we emit warnings for unused record fields
+without parents one whole group (of record fields sharing the same textual name)
+at a time, and only if *all* of the record fields in the group are unused;
+see 'collectUnusedNames'.
+
+Note that this only applies to record fields imported without a parent. If we
+had:
+
+ import M1 (R1(MkR1, fld), R2(fld))
+ f :: R1 -> Int
+ f (MkR1 { fld = x }) = x
+ g :: R2 -> Int
+ g _ = 3
+
+then of course we should report the second 'fld' as unused.
+-}
{- Note [The ImportMap]
@@ -1945,12 +2043,15 @@ warnUnusedImport rdr_env (L loc decl, used, unused)
| null unused
= return ()
- -- Only one import is unused, with `SrcSpan` covering only the unused item instead of
- -- the whole import statement
+ -- Some imports are unused: make the `SrcSpan` cover only the unused
+ -- items instead of the whole import statement
| Just (_, L _ imports) <- ideclImportList decl
- , length unused == 1
- , Just (L loc _) <- find (\(L _ ie) -> ((ieName ie) :: Name) `elem` unused) imports
- = addDiagnosticAt (locA loc) (TcRnUnusedImport decl (UnusedImportSome sort_unused))
+ , let unused_locs = [ locA loc | L loc ie <- imports
+ , name <- ieNames ie
+ , name `elem` unused ]
+ , loc1 : locs <- unused_locs
+ , let span = foldr1 combineSrcSpans ( loc1 NE.:| locs )
+ = addDiagnosticAt span (TcRnUnusedImport decl (UnusedImportSome sort_unused))
-- Some imports are unused
| otherwise
@@ -2263,3 +2364,4 @@ addDupDeclErr gres@(gre :| _)
checkConName :: RdrName -> TcRn ()
checkConName name
= checkErr (isRdrDataCon name || isRdrTc name) (TcRnIllegalDataCon name)
+
diff --git a/testsuite/tests/deriving/should_compile/T17324.stderr b/testsuite/tests/deriving/should_compile/T17324.stderr
index 0ae00ce62d2e05d67ab5d6902c6ca3bb440d7c8f..5bde5f99367919bf14ee26f94f82de3e73ec4043 100644
--- a/testsuite/tests/deriving/should_compile/T17324.stderr
+++ b/testsuite/tests/deriving/should_compile/T17324.stderr
@@ -1,4 +1,4 @@
-
-T17324.hs:8:1: warning: [GHC-38856] [-Wunused-imports (in -Wextra)]
+T17324.hs:8:21: warning: [GHC-38856] [-Wunused-imports (in -Wextra)]
The import of ‘Dual, Product, Sum’
from module ‘Data.Monoid’ is redundant
+
diff --git a/testsuite/tests/module/T11970A.stderr b/testsuite/tests/module/T11970A.stderr
index c717ebf00ada2de3702ef1218a8091c4a9e43458..2f47328475d304b9f59ea5f9d037041d1a8cedcb 100644
--- a/testsuite/tests/module/T11970A.stderr
+++ b/testsuite/tests/module/T11970A.stderr
@@ -1,5 +1,5 @@
[1 of 2] Compiling T11970A1 ( T11970A1.hs, T11970A1.o )
[2 of 2] Compiling T11970A ( T11970A.hs, T11970A.o )
-
-T11970A.hs:3:1: warning: [GHC-38856] [-Wunused-imports (in -Wextra)]
+T11970A.hs:3:19: warning: [GHC-38856] [-Wunused-imports (in -Wextra)]
The import of ‘Fail(b)’ from module ‘T11970A1’ is redundant
+
diff --git a/testsuite/tests/module/mod176.stderr b/testsuite/tests/module/mod176.stderr
index a8b51c1a4b40049ecd4c7646e5f54fc53df781cd..90eea49074838add4c61df74c76e366dbe93f402 100644
--- a/testsuite/tests/module/mod176.stderr
+++ b/testsuite/tests/module/mod176.stderr
@@ -1,4 +1,4 @@
-
-mod176.hs:4:1: warning: [GHC-38856] [-Wunused-imports (in -Wextra)]
+mod176.hs:4:23: warning: [GHC-38856] [-Wunused-imports (in -Wextra)]
The import of ‘Monad, return’
from module ‘Control.Monad’ is redundant
+
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr
index d58443045650dafd008c2c24d4c626b8865a8a27..dc7bfce2c3c5f52e0311250b1a9b71a7a74fba2d 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr
@@ -1,5 +1,4 @@
[1 of 3] Compiling OverloadedRecFldsFail06_A ( OverloadedRecFldsFail06_A.hs, OverloadedRecFldsFail06_A.o )
-
OverloadedRecFldsFail06_A.hs:9:15: warning: [GHC-40910] [-Wunused-top-binds (in -Wextra, -Wunused-binds)]
Defined but not used: data constructor ‘MkUnused’
@@ -8,9 +7,9 @@ OverloadedRecFldsFail06_A.hs:9:42: warning: [GHC-40910] [-Wunused-top-binds (in
OverloadedRecFldsFail06_A.hs:9:59: warning: [GHC-40910] [-Wunused-top-binds (in -Wextra, -Wunused-binds)]
Defined but not used: record field of MkUnused ‘used_locally’
-[2 of 3] Compiling Main ( overloadedrecfldsfail06.hs, overloadedrecfldsfail06.o )
-overloadedrecfldsfail06.hs:7:1: error: [GHC-38856] [-Wunused-imports (in -Wextra), Werror=unused-imports]
+[2 of 3] Compiling Main ( overloadedrecfldsfail06.hs, overloadedrecfldsfail06.o )
+overloadedrecfldsfail06.hs:7:35: error: [GHC-38856] [-Wunused-imports (in -Wextra), Werror=unused-imports]
The import of ‘MkV, Unused, Unused(unused), V(x), U(y)’
from module ‘OverloadedRecFldsFail06_A’ is redundant
@@ -19,11 +18,11 @@ overloadedrecfldsfail06.hs:8:1: error: [GHC-66111] [-Wunused-imports (in -Wextra
except perhaps to import instances from ‘OverloadedRecFldsFail06_A’
To import instances alone, use: import OverloadedRecFldsFail06_A()
-overloadedrecfldsfail06.hs:9:1: error: [GHC-38856] [-Wunused-imports (in -Wextra), Werror=unused-imports]
+overloadedrecfldsfail06.hs:9:50: error: [GHC-38856] [-Wunused-imports (in -Wextra), Werror=unused-imports]
The qualified import of ‘V(y)’
from module ‘OverloadedRecFldsFail06_A’ is redundant
-overloadedrecfldsfail06.hs:10:1: error: [GHC-38856] [-Wunused-imports (in -Wextra), Werror=unused-imports]
+overloadedrecfldsfail06.hs:10:50: error: [GHC-38856] [-Wunused-imports (in -Wextra), Werror=unused-imports]
The qualified import of ‘U, U(x)’
from module ‘OverloadedRecFldsFail06_A’ is redundant
@@ -36,3 +35,4 @@ overloadedrecfldsfail06.hs:18:28: error: [GHC-02256] [-Wambiguous-fields (in -Wd
Ambiguous record update with parent type constructor ‘V’.
This type-directed disambiguation mechanism will not be supported by -XDuplicateRecordFields in future releases of GHC.
Consider disambiguating using module qualification instead.
+
diff --git a/testsuite/tests/rename/should_compile/T14881.stderr b/testsuite/tests/rename/should_compile/T14881.stderr
index 2e3ff2b406f8bf3ff75b605f77603c974216a60d..f048cc7b71e01c6a6b09df62c807e8870f84af4f 100644
--- a/testsuite/tests/rename/should_compile/T14881.stderr
+++ b/testsuite/tests/rename/should_compile/T14881.stderr
@@ -1,6 +1,6 @@
[1 of 2] Compiling T14881Aux ( T14881Aux.hs, T14881Aux.o )
[2 of 2] Compiling T14881 ( T14881.hs, T14881.o )
-
-T14881.hs:3:1: warning: [GHC-38856] [-Wunused-imports (in -Wextra)]
+T14881.hs:3:45: warning: [GHC-38856] [-Wunused-imports (in -Wextra)]
The qualified import of ‘adjust, length, L(tail), L(x)’
from module ‘T14881Aux’ is redundant
+
diff --git a/testsuite/tests/rename/should_compile/T24035.hs b/testsuite/tests/rename/should_compile/T24035.hs
new file mode 100644
index 0000000000000000000000000000000000000000..a281c16cfa400ab686d3bba4bf0850f00a94f86c
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T24035.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+module T24035 where
+import T24035_aux (R1 (MkR1, ra), rb)
+
+x :: R1 -> Bool
+x (MkR1 { rb = x0 }) = x0
+
+y :: R1 -> Int
+y (MkR1 { ra = y0 }) = y0
diff --git a/testsuite/tests/rename/should_compile/T24035_aux.hs b/testsuite/tests/rename/should_compile/T24035_aux.hs
new file mode 100644
index 0000000000000000000000000000000000000000..9f9a7af90589695fe3f52cb6f624d72d9d0e6dc9
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T24035_aux.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+module T24035_aux (R1(..), R2(..)) where
+
+data R1 = MkR1 {ra :: Int, rb :: Bool}
+data R2 = MkR2 {ra :: Int, rb :: Bool}
diff --git a/testsuite/tests/rename/should_compile/T24035b.hs b/testsuite/tests/rename/should_compile/T24035b.hs
new file mode 100644
index 0000000000000000000000000000000000000000..6b1fae254d4ba39f0ed90513124075a4b5ba4397
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T24035b.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module T24035b where
+import T24035_aux (R1 (MkR1, ra, rb), R2(rb))
+
+x :: R1 -> Bool
+x (MkR1 { rb = x0 }) = x0
+
+y :: R1 -> Int
+y (MkR1 { ra = y0 }) = y0
+
+-- Use R2 to avoid unused import warning for R2
+useR2 :: R2 -> Int
+useR2 _ = 42
diff --git a/testsuite/tests/rename/should_compile/T24035b.stderr b/testsuite/tests/rename/should_compile/T24035b.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..ccdaafaf65f0858c09a6a524807389b55a833c85
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T24035b.stderr
@@ -0,0 +1,3 @@
+T24035b.hs:4:39: warning: [GHC-38856] [-Wunused-imports (in -Wextra)]
+ The import of ‘R2(rb)’ from module ‘T24035_aux’ is redundant
+
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 3901eef9970bbc13a8e3efef8c5d1088d976dbbd..08b3ed48de8d472d2d7eecf6670af5b83ffa84b9 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -210,6 +210,8 @@ test('T23434', normal, compile, [''])
test('T23510b', normal, compile, [''])
test('T23512b', normal, compile, [''])
test('T23664', normal, compile, [''])
+test('T24035', [extra_files(['T24035_aux.hs'])], multimod_compile, ['T24035', '-v0 -Wunused-imports'])
+test('T24035b', [extra_files(['T24035_aux.hs'])], multimod_compile, ['T24035b', '-v0 -Wunused-imports'])
test('T24037', normal, compile, [''])
test('T24084', [extra_files(['T24084_A.hs', 'T24084_B.hs'])], multimod_compile, ['T24084', '-v0'])
test('ExportWarnings1', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs']), multimod_compile, ['ExportWarnings1', '-v0 -Wno-duplicate-exports -Wx-custom'])