Commit ccd8ce40 authored by Adam Gundry's avatar Adam Gundry Committed by Ben Gamari
Browse files

Handle DuplicateRecordFields correctly in filterImports (fixes #14487)

filterImports needed a small adjustment to correctly handle record field
definitions arising from modules with DuplicateRecordFields enabled.

Previously hiding fields was not possible with DuplicateRecordFields enabled.

Test Plan: new test rename/should_compile/T14487

Reviewers: bgamari

Subscribers: simonpj, rwbarton, thomie, carter

GHC Trac Issues: #14487

Differential Revision: https://phabricator.haskell.org/D4805
parent 9897440e
......@@ -16,6 +16,8 @@ module Avail (
availName, availNames, availNonFldNames,
availNamesWithSelectors,
availFlds,
availsNamesWithOccs,
availNamesWithOccs,
stableAvailCmp,
plusAvail,
trimAvail,
......@@ -175,6 +177,22 @@ availFlds :: AvailInfo -> [FieldLabel]
availFlds (AvailTC _ _ fs) = fs
availFlds _ = []
availsNamesWithOccs :: [AvailInfo] -> [(Name, OccName)]
availsNamesWithOccs = concatMap availNamesWithOccs
-- | 'Name's made available by the availability information, paired with
-- the 'OccName' used to refer to each one.
--
-- When @DuplicateRecordFields@ is in use, the 'Name' may be the
-- mangled name of a record selector (e.g. @$sel:foo:MkT@) while the
-- 'OccName' will be the label of the field (e.g. @foo@).
--
-- See Note [Representing fields in AvailInfo].
availNamesWithOccs :: AvailInfo -> [(Name, OccName)]
availNamesWithOccs (Avail n) = [(n, nameOccName n)]
availNamesWithOccs (AvailTC _ ns fs)
= [ (n, nameOccName n) | n <- ns ] ++
[ (flSelector fl, mkVarOccFS (flLabel fl)) | fl <- fs ]
-- -----------------------------------------------------------------------------
-- Utility
......
......@@ -863,7 +863,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
-- NB the AvailInfo may have duplicates, and several items
-- for the same parent; e.g N(x) and N(y)
names = availsToNameSet (map snd items2)
names = availsToNameSetWithSelectors (map snd items2)
keep n = not (n `elemNameSet` names)
pruned_avails = filterAvails keep all_avails
hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
......@@ -879,8 +879,9 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
imp_occ_env :: OccEnv (Name, -- the name
AvailInfo, -- the export item providing the name
Maybe Name) -- the parent of associated types
imp_occ_env = mkOccEnv_C combine [ (nameOccName n, (n, a, Nothing))
| a <- all_avails, n <- availNames a]
imp_occ_env = mkOccEnv_C combine [ (occ, (n, a, Nothing))
| a <- all_avails
, (n, occ) <- availNamesWithOccs a]
where
-- See Note [Dealing with imports]
-- 'combine' is only called for associated data types which appear
......
......@@ -225,7 +225,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
exports_from_item :: ExportAccum -> LIE GhcPs -> RnM ExportAccum
exports_from_item acc@(ExportAccum ie_avails occs)
(L loc (IEModuleContents _ (L lm mod)))
(L loc ie@(IEModuleContents _ (L lm mod)))
| let earlier_mods
= [ mod
| ((L _ (IEModuleContents _ (L _ mod))), _) <- ie_avails ]
......@@ -239,9 +239,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
|| (moduleName this_mod == mod)
; gre_prs = pickGREsModExp mod (globalRdrEnvElts rdr_env)
; new_exports = map (availFromGRE . fst) gre_prs
; (names, fls)= classifyGREs (map fst gre_prs)
; all_gres = foldr (\(gre1,gre2) gres -> gre1 : gre2 : gres) [] gre_prs
}
}
; checkErr exportValid (moduleNotImported mod)
; warnIfFlag Opt_WarnDodgyExports
......@@ -251,8 +250,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
; traceRn "efa" (ppr mod $$ ppr all_gres)
; addUsedGREs all_gres
; occs' <- check_occs (IEModuleContents noExt (noLoc mod)) occs
names fls
; occs' <- check_occs ie occs new_exports
-- This check_occs not only finds conflicts
-- between this item and others, but also
-- internally within this item. That is, if
......@@ -278,8 +276,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
then return acc -- Avoid error cascade
else do
occs' <- check_occs ie occs (availNonFldNames avail)
(availFlds avail)
occs' <- check_occs ie occs [avail]
return (ExportAccum ((L loc new_ie, [avail]) : lie_avails) occs')
......@@ -586,19 +583,19 @@ checkPatSynParent parent NoParent mpat_syn
{-===========================================================================-}
check_occs :: IE GhcPs -> ExportOccMap -> [Name] -> [FieldLabel]
check_occs :: IE GhcPs -> ExportOccMap -> [AvailInfo]
-> RnM ExportOccMap
check_occs ie occs names fls
check_occs ie occs avails
-- 'names' and 'fls' are the entities specified by 'ie'
= foldlM check occs names_with_occs
where
-- Each Name specified by 'ie', paired with the OccName used to
-- refer to it in the GlobalRdrEnv
-- (see Note [Parents for record fields] in RdrName). We check for export
-- clashes using the selector Name, but need the field label OccName in
-- order to look up the right GRE later.
names_with_occs = map (\name -> (name, nameOccName name)) names
++ map (\fl -> (flSelector fl, mkVarOccFS (flLabel fl))) fls
-- (see Note [Representing fields in AvailInfo] in Avail).
--
-- We check for export clashes using the selector Name, but need
-- the field label OccName for presenting error messages.
names_with_occs = availsNamesWithOccs avails
check occs (name, occ)
= case lookupOccEnv occs name_occ of
......@@ -610,7 +607,7 @@ check_occs ie occs names fls
-- by two different module exports. See ticket #4478.
-> do { warnIfFlag Opt_WarnDuplicateExports
(not (dupExport_ok name ie ie'))
(dupExportWarn name_occ ie ie')
(dupExportWarn occ ie ie')
; return occs }
| otherwise -- Same occ name but different names: an error
......
{-# LANGUAGE DuplicateRecordFields #-}
{-# OPTIONS_GHC -Werror=duplicate-exports #-}
-- This should warn about the duplicate export of foo, but not the
-- exports of the two different bar fields.
module Export (T(foo, bar), foo, S(bar)) where
data T = MkT { foo :: Int, bar :: Int }
data S = MkS { bar :: Int }
DuplicateExports.hs:6:29: error: [-Wduplicate-exports (in -Wdefault), -Werror=duplicate-exports]
‘foo’ is exported by ‘foo’ and ‘T(foo, bar)’
......@@ -31,3 +31,4 @@ test('hasfieldfail02', normal, compile_fail, [''])
test('hasfieldfail03', normal, compile_fail, [''])
test('T14953', [extra_files(['T14953_A.hs', 'T14953_B.hs'])],
multimod_compile_fail, ['T14953', ''])
test('DuplicateExports', normal, compile_fail, [''])
module T14487 where
import T14487A hiding (duplicateName)
test = X duplicateName
duplicateName = 5
{-# LANGUAGE DuplicateRecordFields #-}
module T14487A where
data X = X {
duplicateName :: Int
}
......@@ -154,5 +154,6 @@ test('T13132', normal, compile, [''])
test('T13646', normal, compile, [''])
test('LookupSub', [], multimod_compile, ['LookupSub', '-v0'])
test('T14881', [], multimod_compile, ['T14881', '-W'])
test('T14487', [], multimod_compile, ['T14487', '-v0'])
test('T14747', [], multimod_compile, ['T14747', '-v0'])
test('T15149', [], multimod_compile, ['T15149', '-v0'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment