summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsheaf <sam.derbyshire@gmail.com>2023-04-29 01:48:33 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2023-05-03 20:18:16 -0400
commit4eafb52a26ad07b2be0af71a6896fb01ed919614 (patch)
treecf40b0a6cb0397b58acb2c545d621d9860400052
parent1e9caa1a54e149a71af2555336531425f64521af (diff)
downloadhaskell-4eafb52a26ad07b2be0af71a6896fb01ed919614.tar.gz
Don't forget to check the parent in an export list
Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318
-rw-r--r--compiler/GHC/Tc/Gen/Export.hs49
-rw-r--r--testsuite/tests/rename/should_compile/T23318.hs2
-rw-r--r--testsuite/tests/rename/should_compile/T23318.stderr3
-rw-r--r--testsuite/tests/rename/should_compile/all.T1
4 files changed, 29 insertions, 26 deletions
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index eed125e8b0..620b0a9f5e 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -356,55 +356,51 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
lookup_ie occs ie@(IEThingAll ann n')
= do
- (n, kids) <- lookup_ie_all ie n'
- let name = unLoc n
+ (par, kids) <- lookup_ie_all ie n'
+ let name = greName par
avails = map greName kids
- occs' <- check_occs occs ie kids
+ occs' <- check_occs occs ie (par:kids)
return $ Just
( occs'
- , IEThingAll ann (replaceLWrappedName n' (unLoc n))
+ , IEThingAll ann (replaceLWrappedName n' name)
, AvailTC name (name:avails))
lookup_ie occs ie@(IEThingWith ann l wc sub_rdrs)
= do
- (lname, subs, with_gres)
+ (par_gre, subs, with_gres)
<- addExportErrCtxt ie $ lookup_ie_with l sub_rdrs
- (_, wc_gres) <-
+ wc_gres <-
case wc of
- NoIEWildcard -> return (lname, [])
- IEWildcard _ -> lookup_ie_all ie l
+ NoIEWildcard -> return []
+ IEWildcard _ -> snd <$> lookup_ie_all ie l
- let name = unLoc lname
- all_names = name : map greName (with_gres ++ wc_gres)
- gres = localVanillaGRE NoParent name
- -- localVanillaGRE might not be correct here,
- -- but these GREs are only passed to check_occs
- -- which only needs the correct Name for the GREs...
- : with_gres ++ wc_gres
+ let par = greName par_gre
+ all_names = par : map greName (with_gres ++ wc_gres)
+ gres = par_gre : with_gres ++ wc_gres
occs' <- check_occs occs ie gres
return $ Just $
( occs'
- , IEThingWith ann (replaceLWrappedName l name) wc subs
- , AvailTC name all_names)
+ , IEThingWith ann (replaceLWrappedName l par) wc subs
+ , AvailTC par all_names)
lookup_ie _ _ = panic "lookup_ie" -- Other cases covered earlier
lookup_ie_with :: LIEWrappedName GhcPs -> [LIEWrappedName GhcPs]
- -> RnM (Located Name, [LIEWrappedName GhcRn], [GlobalRdrElt])
- lookup_ie_with (L l rdr) sub_rdrs =
+ -> RnM (GlobalRdrElt, [LIEWrappedName GhcRn], [GlobalRdrElt])
+ lookup_ie_with (L _ rdr) sub_rdrs =
do { gre <- lookupGlobalOccRn $ ieWrappedName rdr
; let name = greName gre
; kids <- lookupChildrenExport name sub_rdrs
; if isUnboundName name
- then return (L (locA l) name, [], [gre])
- else return (L (locA l) name, map fst kids, map snd kids) }
+ then return (gre, [], [gre])
+ else return (gre, map fst kids, map snd kids) }
lookup_ie_all :: IE GhcPs -> LIEWrappedName GhcPs
- -> RnM (Located Name, [GlobalRdrElt])
- lookup_ie_all ie (L l rdr) =
+ -> RnM (GlobalRdrElt, [GlobalRdrElt])
+ lookup_ie_all ie (L _ rdr) =
do { gre <- lookupGlobalOccRn $ ieWrappedName rdr
; let name = greName gre
gres = findChildren kids_env name
@@ -415,7 +411,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
else -- This occurs when you export T(..), but
-- only import T abstractly, or T is a synonym.
addErr (TcRnExportHiddenComponents ie)
- ; return (L (locA l) name, gres) }
+ ; return (gre, gres) }
-------------
lookup_doc_ie :: IE GhcPs -> RnM (Maybe (IE GhcRn))
@@ -663,8 +659,9 @@ checkPatSynParent parent NoParent gre
{-===========================================================================-}
--- | Check that the each of the given 'GlobalRdrElt's does not appear multiple
--- times in the 'ExportOccMap', as per Note [Exporting duplicate declarations].
+-- | Insert the given 'GlobalRdrElt's into the 'ExportOccMap', checking that
+-- each of the given 'GlobalRdrElt's does not appear multiple times in
+-- the 'ExportOccMap', as per Note [Exporting duplicate declarations].
check_occs :: ExportOccMap -> IE GhcPs -> [GlobalRdrElt] -> RnM ExportOccMap
check_occs occs ie gres
-- 'gres' are the entities specified by 'ie'
diff --git a/testsuite/tests/rename/should_compile/T23318.hs b/testsuite/tests/rename/should_compile/T23318.hs
new file mode 100644
index 0000000000..ac66912992
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T23318.hs
@@ -0,0 +1,2 @@
+module T23318 (T(), T(..)) where
+data T = A | B
diff --git a/testsuite/tests/rename/should_compile/T23318.stderr b/testsuite/tests/rename/should_compile/T23318.stderr
new file mode 100644
index 0000000000..66690c5d1e
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T23318.stderr
@@ -0,0 +1,3 @@
+
+T23318.hs:1:21: warning: [GHC-47854] [-Wduplicate-exports (in -Wdefault)]
+ ‘T’ is exported by ‘T(..)’ and ‘T()’
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 7885713c04..6e4c5ae749 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -210,3 +210,4 @@ test('GHCINullaryRecordWildcard', combined_output, ghci_script, ['GHCINullaryRec
test('GHCIImplicitImportNullaryRecordWildcard', combined_output, ghci_script, ['GHCIImplicitImportNullaryRecordWildcard.script'])
test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_compile, ['T22122', '-v0'])
test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0'])
+test('T23318', normal, compile, ['-Wduplicate-exports'])