From 0cb1db9270e11469f11a2ccf323219e032c2a312 Mon Sep 17 00:00:00 2001 From: sheaf <sam.derbyshire@gmail.com> Date: Fri, 7 Mar 2025 11:14:38 +0100 Subject: [PATCH] Don't report used duplicate record fields as unused This commit fixes the bug reported in #24035 in which the import of a duplicate record field could be erroneously reported as unused. The issue is that an import of the form "import M (fld)" can import several different 'Name's, and we should only report an error if ALL of those 'Name's are unused, not if ANY are. Note [Reporting unused imported duplicate record fields] in GHC.Rename.Names explains the solution to this problem. Fixes #24035 --- compiler/GHC/Hs/ImpExp.hs | 1 - compiler/GHC/Rename/Names.hs | 152 +++++++++++++++--- .../deriving/should_compile/T17324.stderr | 4 +- testsuite/tests/module/T11970A.stderr | 4 +- testsuite/tests/module/mod176.stderr | 4 +- .../overloadedrecfldsfail06.stderr | 10 +- .../tests/rename/should_compile/T14881.stderr | 4 +- .../tests/rename/should_compile/T24035.hs | 9 ++ .../tests/rename/should_compile/T24035_aux.hs | 5 + .../tests/rename/should_compile/T24035b.hs | 14 ++ .../rename/should_compile/T24035b.stderr | 3 + testsuite/tests/rename/should_compile/all.T | 2 + 12 files changed, 173 insertions(+), 39 deletions(-) create mode 100644 testsuite/tests/rename/should_compile/T24035.hs create mode 100644 testsuite/tests/rename/should_compile/T24035_aux.hs create mode 100644 testsuite/tests/rename/should_compile/T24035b.hs create mode 100644 testsuite/tests/rename/should_compile/T24035b.stderr diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs index f64eb59bcbaa..3db8fe5c617e 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 79a74337fe98..24ca18f5f013 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 0ae00ce62d2e..5bde5f993679 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 c717ebf00ada..2f47328475d3 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 a8b51c1a4b40..90eea4907483 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 d58443045650..dc7bfce2c3c5 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 2e3ff2b406f8..f048cc7b71e0 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 000000000000..a281c16cfa40 --- /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 000000000000..9f9a7af90589 --- /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 000000000000..6b1fae254d4b --- /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 000000000000..ccdaafaf65f0 --- /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 3901eef9970b..08b3ed48de8d 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']) -- GitLab