Simon Jakobi pushed to branch wip/sjakobi/multi-caret at Glasgow Haskell Compiler / GHC Commits: a1a2259b by Simon Jakobi at 2026-06-02T03:23:22+02:00 Add related locations to duplicate-declaration and duplicate-export errors Attach diagnosticRelatedLocations (multi-caret) to: * TcRnDuplicateDecls * TcRnDuplicateExport * TcRnDuplicateNamedDefaultExport Enable -fdiagnostics-show-caret for the DuplicateExports and T25857 tests to exercise the new caret sections. check_occs now threads LIE GhcPs so these export items can carry their source spans. TcRnConflictingExports and TcRnDuplicateFieldExport were also tried but reverted to IE GhcPs: their export items already appear in the message text and name provenance is rendered too, so the carets only duplicated the primary span. Assisted-by: Claude Opus 4.8 - - - - - 9 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - testsuite/tests/default/T25857.stderr - testsuite/tests/default/all.T - testsuite/tests/overloadedrecflds/should_fail/DuplicateExports.stderr - testsuite/tests/overloadedrecflds/should_fail/all.T - testsuite/tests/rename/should_fail/T7164.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -660,16 +660,16 @@ instance Diagnostic TcRnMessage where $ formatExportItemError (ppr export_item) "attempts to export a default class declaration that is not visible here" - TcRnDuplicateExport gre ie1 ie2 + TcRnDuplicateExport gre lie1 lie2 -> mkSimpleDecorated $ hsep [ quotes (ppr $ greName gre) - , text "is exported by", quotes (ppr ie1) - , text "and", quotes (ppr ie2) ] - TcRnDuplicateNamedDefaultExport nm ie1 ie2 - -> mkSimpleDecorated $ - hsep [ text "The named default declaration for" <+> quotes (ppr nm) - , text "is exported by", quotes (ppr ie1) - , text "and", quotes (ppr ie2) ] + , text "is exported by", quotes (ppr lie1) + , text "and", quotes (ppr lie2) ] + TcRnDuplicateNamedDefaultExport nm lie1 lie2 + -> mkSimpleDecorated $ + hsep [ text "The named default declaration for" <+> quotes (ppr nm) + , text "is exported by", quotes (ppr lie1) + , text "and", quotes (ppr lie2) ] TcRnExportedParentChildMismatch parent_name ty_thing child parent_names -> mkSimpleDecorated $ text "The type constructor" <+> quotes (ppr parent_name) @@ -3464,6 +3464,12 @@ instance Diagnostic TcRnMessage where -> diagnosticRelatedLocations msg' TcRnBindingNameConflict _ locs -> NE.tail locs + TcRnDuplicateDecls _ names + -> map nameSrcSpan (NE.init names) + TcRnDuplicateExport _ _lie1 lie2 + -> [getLocA lie2] + TcRnDuplicateNamedDefaultExport _ _lie1 lie2 + -> [getLocA lie2] _ -> [] ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -1607,14 +1607,14 @@ data TcRnMessage where overloadedrecflds/should_fail/DuplicateExports patsyn/should_compile/T11959 -} - TcRnDuplicateExport :: GlobalRdrElt -> IE GhcPs -> IE GhcPs -> TcRnMessage + TcRnDuplicateExport :: GlobalRdrElt -> LIE GhcPs -> LIE GhcPs -> TcRnMessage {-| TcRnDuplicateNamedDefaultExport is a warning (controlled by -Wduplicate-exports) that occurs when a named default declaration appears in an export list more than once. -} - TcRnDuplicateNamedDefaultExport :: TyCon -> IE GhcPs -> IE GhcPs -> TcRnMessage + TcRnDuplicateNamedDefaultExport :: TyCon -> LIE GhcPs -> LIE GhcPs -> TcRnMessage {-| TcRnExportedParentChildMismatch is an error that occurs when an export is bundled with a parent that it does not belong to ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -47,7 +47,7 @@ import GHC.Types.Id.Info import GHC.Types.Name.Reader import GHC.Types.Hint -import Control.Arrow ( first ) +import Control.Arrow ( first, second ) import Control.Monad ( when ) import qualified Data.List.NonEmpty as NE import Data.Traversable ( for ) @@ -142,7 +142,7 @@ data ExportAccum -- The type of the accumulating parameter of = ExportAccum { expacc_exp_occs :: ExportOccMap, -- ^ Tracks exported occurrence names - expacc_exp_dflts :: NameEnv (ClassDefaults, IE GhcPs), + expacc_exp_dflts :: NameEnv (ClassDefaults, LIE GhcPs), -- ^ Tracks exported named default declarations expacc_mods :: UniqMap ModuleName [Name], -- ^ Tracks (re-)exported module names @@ -186,7 +186,7 @@ accumExports f xs = do where f' acc x = fromMaybe (acc, Nothing) <$> attemptM (f acc x) -type ExportOccMap = OccEnv (Name, IE GhcPs) +type ExportOccMap = OccEnv (Name, LIE GhcPs) -- Tracks what a particular exported OccName -- in an export list refers to, and which item -- it came from. It's illegal to export two distinct things @@ -414,7 +414,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod ; traceRn "efa" (ppr mod $$ ppr all_gres) ; addUsedGREs ExportDeprecationWarnings all_gres - ; occs' <- check_occs occs ie new_gres + ; occs' <- check_occs occs (L loc ie) new_gres -- This check_occs not only finds conflicts -- between this item and others, but also -- internally within this item. That is, if @@ -484,7 +484,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod ; traceRn "efa" (ppr mod $$ ppr all_gres) ; addUsedGREs ExportDeprecationWarnings all_gres - ; occs' <- check_occs occs ie new_gres + ; occs' <- check_occs occs (L loc ie) new_gres -- This check_occs not only finds conflicts -- between this item and others, but also -- internally within this item. That is, if @@ -541,7 +541,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod name = greName gre checkThLocalNameNoLift (ieLWrappedUserRdrName l name) - occs' <- check_occs occs ie [gre] + occs' <- check_occs occs (L loc ie) [gre] (export_warn_spans', dont_warn_export', warn_txt_rn) <- process_warning export_warn_spans dont_warn_export @@ -579,14 +579,14 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod Just cls_dflts -> do let cls = cd_class cls_dflts case lookupNameEnv exp_dflts (className cls) of - Just (_, ie') -> do + Just (_, lie') -> do addDiagnostic $ - TcRnDuplicateNamedDefaultExport (classTyCon cls) ie ie' + TcRnDuplicateNamedDefaultExport (classTyCon cls) (L loc ie) lie' return (Nothing, occs, exp_dflts) Nothing -> - return $ (Nothing, occs, extendNameEnv exp_dflts (className cls) (cls_dflts, ie)) + return $ (Nothing, occs, extendNameEnv exp_dflts (className cls) (cls_dflts, L loc ie)) _ -> do - occs' <- check_occs occs ie [gre] + occs' <- check_occs occs (L loc ie) [gre] return (Just avail, occs', exp_dflts) checkThLocalNameNoLift (ieLWrappedUserRdrName l name) @@ -618,7 +618,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod all_names = map greName all_gres checkThLocalNameNoLift (ieLWrappedUserRdrName l name) - occs' <- check_occs occs ie all_gres + occs' <- check_occs occs (L loc ie) all_gres (export_warn_spans', dont_warn_export', warn_txt_rn) <- process_warning export_warn_spans dont_warn_export @@ -657,7 +657,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod all_names = map greName all_gres checkThLocalNameNoLift (ieLWrappedUserRdrName l name) - occs' <- check_occs occs ie all_gres + occs' <- check_occs occs (L loc ie) all_gres (export_warn_spans', dont_warn_export', warn_txt_rn) <- process_warning export_warn_spans dont_warn_export @@ -1044,12 +1044,13 @@ checkPatSynParent parent NoParent nm -- | 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 +check_occs :: ExportOccMap -> LIE GhcPs -> [GlobalRdrElt] -> RnM ExportOccMap +check_occs occs lie gres -- 'gres' are the entities specified by 'ie' = do { drf <- xoptM LangExt.DuplicateRecordFields ; foldlM (check drf) occs gres } where + ie = unLoc lie -- Check for distinct children exported with the same OccName (an error) or -- for duplicate exports of the same child (a warning). @@ -1067,20 +1068,21 @@ check_occs occs ie gres | drf_enabled || not (isFieldOcc child_occ) -> return occs' | otherwise - -> do { let flds = filter (\(_,ie') -> not $ dupFieldExport_ok ie ie') + -> do { let flds = filter (\(_,lie') -> not $ dupFieldExport_ok ie (unLoc lie')) $ lookupFieldsOccEnv occs (occNameFS child_occ) ; case flds of { [] -> return occs'; clash1:clashes -> - do { addDuplicateFieldExportErr (gre,ie) (clash1 NE.:| clashes) + do { addDuplicateFieldExportErr (gre, unLoc lie) + (fmap (second unLoc) (clash1 NE.:| clashes)) ; return occs } } } - Left (child', ie') + Left (child', lie') | child == child' -- Duplicate export of a single Name: a warning. - -> do { warnIf (not (dupExport_ok child ie ie')) (TcRnDuplicateExport gre ie ie') + -> do { warnIf (not (dupExport_ok child ie (unLoc lie'))) (TcRnDuplicateExport gre lie lie') ; return occs } | otherwise -- Same OccName but different Name: an error. -> do { global_env <- getGlobalRdrEnv - ; addErr (exportClashErr global_env child' child ie' ie) + ; addErr (exportClashErr global_env child' child (unLoc lie') (unLoc lie)) ; return occs } where child = greName gre @@ -1088,10 +1090,10 @@ check_occs occs ie gres -- Try to insert a child into the map, returning Left if there is something -- already exported with the same OccName. - try_insert :: ExportOccMap -> GlobalRdrElt -> Either (Name, IE GhcPs) ExportOccMap + try_insert :: ExportOccMap -> GlobalRdrElt -> Either (Name, LIE GhcPs) ExportOccMap try_insert occs child = case lookupOccEnv occs occ of - Nothing -> Right (extendOccEnv occs occ (greName child, ie)) + Nothing -> Right (extendOccEnv occs occ (greName child, lie)) Just x -> Left x where occ = greOccName child ===================================== testsuite/tests/default/T25857.stderr ===================================== @@ -1,3 +1,9 @@ T25857.hs:4:33: warning: [GHC-31584] [-Wduplicate-exports (in -Wdefault)] The named default declaration for ‘IsString’ is exported by ‘default IsString’ and ‘default IsString’ + | +4 | IsString, default IsString, default IsString + | ^^^^^^^^^^^^^^^^ + | +4 | IsString, default IsString, default IsString + | ^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/default/all.T ===================================== @@ -32,7 +32,7 @@ test('default-fail07', normal, compile_fail, ['']) test('default-fail08', normal, compile_fail, ['']) test('T25775', normal, compile_fail, ['']) test('T25825', normal, compile, ['']) -test('T25857', normal, compile, ['']) +test('T25857', normal, compile, ['-fdiagnostics-show-caret']) test('T25206', [extra_files(['T25206_helper.hs'])], multimod_compile, ['T25206', '']) test('T25858', normal, compile_and_run, ['']) test('T25858v1', [extra_files(['T25858v1_helper.hs'])], multimod_compile_and_run, ['T25858v1', '']) ===================================== testsuite/tests/overloadedrecflds/should_fail/DuplicateExports.stderr ===================================== @@ -1,3 +1,9 @@ - DuplicateExports.hs:6:29: error: [GHC-47854] [-Wduplicate-exports (in -Wdefault), Werror=duplicate-exports] ‘foo’ is exported by ‘foo’ and ‘T(foo, bar)’ + | +6 | module Export (T(foo, bar), foo, S(bar)) where + | ^^^^^^^^^^^ + | +6 | module Export (T(foo, bar), foo, S(bar)) where + | ^^^ + ===================================== testsuite/tests/overloadedrecflds/should_fail/all.T ===================================== @@ -35,7 +35,7 @@ test('T14953', [extra_files(['T14953_A.hs', 'T14953_B.hs'])], multimod_compile_fail, ['T14953', '']) test('T26480', extra_files(['T26480_aux1.hs', 'T26480_aux2.hs']), multimod_compile_fail, ['T26480', '-v0']) test('T26480b', normal, compile_fail, ['']) -test('DuplicateExports', normal, compile_fail, ['']) +test('DuplicateExports', normal, compile_fail, ['-fdiagnostics-show-caret']) test('T17420', [extra_files(['T17420A.hs'])], multimod_compile_fail, ['T17420', '']) test('T17469', [extra_files(['T17469A.hs'])], multimod_compile_fail, ===================================== testsuite/tests/rename/should_fail/T7164.stderr ===================================== @@ -1,5 +1,11 @@ - -T7164.hs:8:1: [GHC-29916] +T7164.hs:8:1: error: [GHC-29916] Multiple declarations of ‘derp’ Declared at: T7164.hs:5:5 T7164.hs:8:1 + | +5 | derp :: m a + | ^^^^^^^^^^^ + | +8 | derp = 123 + | ^^^^ + ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -91,7 +91,7 @@ test('T6148a', normal, compile_fail, ['']) test('T6148b', normal, compile_fail, ['']) test('T6148c', normal, compile_fail, ['']) test('T6148d', normal, compile_fail, ['']) -test('T7164', normal, compile_fail, ['']) +test('T7164', normal, compile_fail, ['-fdiagnostics-show-caret']) test('T7338', normal, compile_fail, ['']) test('T7338a', normal, compile_fail, ['']) test('T7454', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1a2259b9a4cab30faa471a2060cb9ad... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1a2259b9a4cab30faa471a2060cb9ad... You're receiving this email because of your account on gitlab.haskell.org.