[Git][ghc/ghc][master] Don't forget to check the parent in an export list

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu May 4 00:18:34 UTC 2023



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
4eafb52a by sheaf at 2023-05-03T20:18:16-04:00
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

- - - - -


4 changed files:

- compiler/GHC/Tc/Gen/Export.hs
- + testsuite/tests/rename/should_compile/T23318.hs
- + testsuite/tests/rename/should_compile/T23318.stderr
- testsuite/tests/rename/should_compile/all.T


Changes:

=====================================
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'


=====================================
testsuite/tests/rename/should_compile/T23318.hs
=====================================
@@ -0,0 +1,2 @@
+module T23318 (T(), T(..)) where
+data T = A | 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()’


=====================================
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'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4eafb52a26ad07b2be0af71a6896fb01ed919614

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4eafb52a26ad07b2be0af71a6896fb01ed919614
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230503/0036c9f5/attachment-0001.html>


More information about the ghc-commits mailing list