[Git][ghc/ghc][wip/sol/reexported-error-message] Reference correct package in error messages for reexported modules
by Simon Hengel (＠sol) 21 Jun '26
by Simon Hengel (＠sol) 21 Jun '26
21 Jun '26
Simon Hengel pushed to branch wip/sol/reexported-error-message at Glasgow Haskell Compiler / GHC
Commits:
26cc1e97 by Simon Hengel at 2026-06-22T03:47:11+07:00
Reference correct package in error messages for reexported modules
(fixes #27417)
- - - - -
11 changed files:
- + changelog.d/reexported-module-errors
- compiler/GHC/Iface/Errors.hs
- compiler/GHC/Iface/Errors/Ppr.hs
- compiler/GHC/Iface/Errors/Types.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- compiler/GHC/Unit/State.hs
- ghc/GHCi/UI/Exception.hs
- + testsuite/tests/package/ImportReexport.hs
- + testsuite/tests/package/ImportReexport.stderr
- testsuite/tests/package/all.T
Changes:
=====================================
changelog.d/reexported-module-errors
=====================================
@@ -0,0 +1,4 @@
+section: compiler
+synopsis: Reference the correct package in error messages when trying to import a reexported module from a hidden package.
+issues: #27417
+mrs: !16229
=====================================
compiler/GHC/Iface/Errors.hs
=====================================
@@ -128,7 +128,7 @@ cantFindErr unit_env profile mod_name find_result
| otherwise
-> GenericMissing
- (map ((\uid -> (uid, lookupUnit (ue_homeUnitState unit_env) uid))) pkg_hiddens)
+ pkg_hiddens
mod_hiddens unusables files
_ -> panic "cantFindErr"
=====================================
compiler/GHC/Iface/Errors/Ppr.hs
=====================================
@@ -261,13 +261,13 @@ cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInst
.ppr.mkUnit) res ++
if f then [text "a package flag"] else []
)
- pkg_hidden :: (Unit, Maybe UnitInfo) -> SDoc
- pkg_hidden (uid, uif) =
+ pkg_hidden :: UnitInfo -> SDoc
+ pkg_hidden unit =
text "It is a member of the hidden package"
- <+> quotes (ppr uid)
+ <+> quotes (ppr $ unitId unit)
--FIXME: we don't really want to show the unit id here we should
-- show the source package id or installed package id if it's ambiguous
- <> dot $$ maybe empty pkg_hidden_hint uif
+ <> dot $$ pkg_hidden_hint unit
mod_hidden pkg =
=====================================
compiler/GHC/Iface/Errors/Types.hs
=====================================
@@ -73,7 +73,7 @@ data CantFindInstalledReason
| NotAModule
| CouldntFindInFiles [FilePath]
| GenericMissing
- [(Unit, Maybe UnitInfo)] [Unit]
+ [UnitInfo] [Unit]
[UnusableUnit] [FilePath]
| MultiplePackages [(Module, ModuleOrigin)]
deriving Generic
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -510,9 +510,9 @@ findLookupResult fc fopts r = case r of
, fr_suggestions = []})
LookupMultiple rs ->
return (FoundMultiple rs)
- LookupHidden pkg_hiddens mod_hiddens ->
+ LookupHidden fr_pkgs_hidden mod_hiddens ->
return (NotFound{ fr_paths = [], fr_pkg = Nothing
- , fr_pkgs_hidden = map (moduleUnit.fst) pkg_hiddens
+ , fr_pkgs_hidden
, fr_mods_hidden = map (moduleUnit.fst) mod_hiddens
, fr_unusables = []
, fr_suggestions = [] })
=====================================
compiler/GHC/Unit/Finder/Types.hs
=====================================
@@ -70,7 +70,7 @@ data FindResult
, fr_mods_hidden :: [Unit] -- ^ Module is in these units,
-- but the *module* is hidden
- , fr_pkgs_hidden :: [Unit] -- ^ Module is in these units,
+ , fr_pkgs_hidden :: [UnitInfo] -- ^ Module is in these units,
-- but the *unit* is hidden
-- | Module is in these units, but it is unusable
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -1905,7 +1905,7 @@ data LookupResult =
-- | No modules found, but there were some hidden ones with
-- an exact name match. First is due to package hidden, second
-- is due to module being hidden
- | LookupHidden [(Module, ModuleOrigin)] [(Module, ModuleOrigin)]
+ | LookupHidden [UnitInfo] [(Module, ModuleOrigin)]
-- | No modules found, but there were some unusable ones with
-- an exact name match
| LookupUnusable [(Module, ModuleOrigin)]
@@ -1954,8 +1954,8 @@ lookupModuleWithSuggestions' :: UnitState
-> ModuleName
-> PkgQual
-> LookupResult
-lookupModuleWithSuggestions' pkgs mod_map m mb_pn
- = case lookupUniqMap mod_map m of
+lookupModuleWithSuggestions' pkgs mod_map name mb_pn
+ = case lookupUniqMap mod_map name of
Nothing -> LookupNotFound suggestions
Just xs ->
case foldl' classify ([],[],[], []) (sortOn fst $ nonDetUniqMapToList xs) of
@@ -1969,19 +1969,26 @@ lookupModuleWithSuggestions' pkgs mod_map m mb_pn
classify (hidden_pkg, hidden_mod, unusable, exposed) (m, origin0) =
let origin = filterOrigin mb_pn (mod_unit m) origin0
x = (m, origin)
+
+ originUnit :: [UnitInfo] -> [UnitInfo]
+ originUnit
+ | moduleName m == name, Just pkg <- lookupUnit pkgs (moduleUnit m) = (pkg :)
+ | otherwise = id
+
in case origin of
ModHidden
-> (hidden_pkg, x:hidden_mod, unusable, exposed)
ModUnusable _
-> (hidden_pkg, hidden_mod, x:unusable, exposed)
- _ | originEmpty origin
+ ModOrigin _ _ reexports _
+ | originEmpty origin
-> (hidden_pkg, hidden_mod, unusable, exposed)
| originVisible origin
-> (hidden_pkg, hidden_mod, unusable, x:exposed)
| otherwise
- -> (x:hidden_pkg, hidden_mod, unusable, exposed)
+ -> (reexports ++ originUnit hidden_pkg, hidden_mod, unusable, exposed)
- unit_lookup p = lookupUnit pkgs p `orElse` pprPanic "lookupModuleWithSuggestions" (ppr p <+> ppr m)
+ unit_lookup p = lookupUnit pkgs p `orElse` pprPanic "lookupModuleWithSuggestions" (ppr p <+> ppr name)
mod_unit = unit_lookup . moduleUnit
-- Filters out origins which are not associated with the given package
@@ -2011,7 +2018,7 @@ lookupModuleWithSuggestions' pkgs mod_map m mb_pn
, fromPackageFlag = False -- always excluded
}
- suggestions = fuzzyLookup (moduleNameString m) all_mods
+ suggestions = fuzzyLookup (moduleNameString name) all_mods
all_mods :: [(String, ModuleSuggestion)] -- All modules
all_mods = sortBy (comparing fst) $
=====================================
ghc/GHCi/UI/Exception.hs
=====================================
@@ -222,11 +222,13 @@ ghciDiagnosticMessage ghc_opts msg =
Just (pprWithUnitState us $ cantFindErrorX pkg_hidden_hint may_show_locations module_or_interface cfi)
_ -> Nothing
where
-
+ may_show_locations :: [String] -> SDoc
may_show_locations = mayShowLocations ":set -v" (ifaceShowTriedFiles opts)
+ pkg_hidden_hint :: UnitInfo -> SDoc
pkg_hidden_hint = pkgHiddenHint hidden_msg (ifaceBuildingCabalPackage opts)
where
+ hidden_msg :: UnitInfo -> SDoc
hidden_msg pkg =
text "You can run" <+>
quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
=====================================
testsuite/tests/package/ImportReexport.hs
=====================================
@@ -0,0 +1,2 @@
+module ImportReexport where
+import GHC.Types -- reexported by ghc-prim from ghc-internal
=====================================
testsuite/tests/package/ImportReexport.stderr
=====================================
@@ -0,0 +1,5 @@
+ImportReexport.hs:2:1: error: [GHC-87110]
+ Could not load module ‘GHC.Types’.
+ It is a member of the hidden package ‘ghc-prim-0.14.0’.
+ Use -v to see a list of the files searched for.
+
=====================================
testsuite/tests/package/all.T
=====================================
@@ -13,6 +13,7 @@ test('package04', normal, compile, [incr_containers])
test('package05', normal, compile, [incr_ghc + inc_ghc])
test('package06', normal, compile, [incr_ghc])
test('package06e', normalise_version('ghc'), compile_fail, [incr_ghc])
+test('ImportReexport', normalise_version('ghc'), compile_fail, ['-hide-all-packages -XNoImplicitPrelude'])
test('package07e', normalise_version('ghc'), compile_fail, [incr_ghc + inc_ghc + hide_ghc])
test('package08e', normalise_version('ghc'), compile_fail, [incr_ghc + hide_ghc])
test('package09e', normal, compile_fail, ['-package "containers (Data.Map as M, Data.Set as M)"'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26cc1e979319c1827c2418af2819a5f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26cc1e979319c1827c2418af2819a5f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/az/exactprint-annotation-rationalisation] 9 commits: EPA: remove LocatedL / SrcSpanAnnL and LocatedLI / SrcSpanAnnLI
by Alan Zimmerman (＠alanz) 21 Jun '26
by Alan Zimmerman (＠alanz) 21 Jun '26
21 Jun '26
Alan Zimmerman pushed to branch wip/az/exactprint-annotation-rationalisation at Glasgow Haskell Compiler / GHC
Commits:
2fc3fe40 by Alan Zimmerman at 2026-06-21T20:08:52+01:00
EPA: remove LocatedL / SrcSpanAnnL and LocatedLI / SrcSpanAnnLI
This is part of a refactor towards only having LocatedA / SrcSpanAnnA
It removes the stated items, but has to add back one for BooleanFormula,
LocatedBF / SrcSpanAnnBF
This commit also use the HsConDetails RecCon extension point to
capture the braces in a record constructor
- - - - -
2f274bbd by Alan Zimmerman at 2026-06-21T20:08:52+01:00
EPA: Remove LocatedC / SrcSpanAnnC
Used for contexts
- - - - -
880fa55a by Alan Zimmerman at 2026-06-21T20:08:52+01:00
EPA: Harmonise HsQual/HsQualTy TTG extension annotations
- - - - -
87e0d0e2 by Alan Zimmerman at 2026-06-21T20:08:52+01:00
EPA Remove LocatedLC / LocatedLS
LocatedLC/LocatedLS were unused
- - - - -
5edf983d by Alan Zimmerman at 2026-06-21T21:41:38+01:00
EPA: Remove LocatedLW from LStmtLR
- - - - -
41d493ec by Alan Zimmerman at 2026-06-21T21:41:38+01:00
EPA: Remove LocatedLW from MatchGroup
This is the last usage of LocatedLW / SrcSpanAnnLW
- - - - -
5cf22470 by Alan Zimmerman at 2026-06-21T21:41:38+01:00
EPA: Move the 'where' annotation for PatSynBind
This allows us to move it out of the MatchGroup exact print annotation
too
- - - - -
5eee5d98 by Alan Zimmerman at 2026-06-21T21:41:38+01:00
EPA: Replace AnnListItem with simply [TrailingAnn]
Remove the unnecessary wrapper around a single field.
- - - - -
27747cee by Alan Zimmerman at 2026-06-21T21:41:38+01:00
Keep binds and sigs together in HsValBindsLR
TBD
- - - - -
95 changed files:
- compiler/GHC/Data/BooleanFormula.hs
- compiler/GHC/Hs.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Stats.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Parser/Types.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Arrow.hs
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/ThToHs.hs
- compiler/Language/Haskell/Syntax.hs
- compiler/Language/Haskell/Syntax/Binds.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/ImpExp.hs
- compiler/Language/Haskell/Syntax/Type.hs
- ghc/GHCi/UI.hs
- testsuite/tests/ghc-api/T25121_status.stdout
- testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr
- testsuite/tests/module/mod185.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- testsuite/tests/parser/should_compile/T15279.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- testsuite/tests/parser/should_compile/T20718.stderr
- testsuite/tests/parser/should_compile/T20718b.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/parser/should_compile/T23315/T23315.stderr
- testsuite/tests/parser/should_compile/all.T
- testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
- testsuite/tests/printer/T18791.stderr
- testsuite/tests/printer/Test10309.hs
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/printer/Test24533.stdout
- testsuite/tests/typecheck/should_compile/T15242.stderr
- testsuite/tests/typecheck/should_compile/all.T
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Interface/RenameType.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb1f5a2da19d4ba9c25db8b4ad2238…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb1f5a2da19d4ba9c25db8b4ad2238…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/az/epa-tidy-locatedxxx-1] EPA: remove LocatedL / SrcSpanAnnL and LocatedLI / SrcSpanAnnLI
by Alan Zimmerman (＠alanz) 21 Jun '26
by Alan Zimmerman (＠alanz) 21 Jun '26
21 Jun '26
Alan Zimmerman pushed to branch wip/az/epa-tidy-locatedxxx-1 at Glasgow Haskell Compiler / GHC
Commits:
2fc3fe40 by Alan Zimmerman at 2026-06-21T20:08:52+01:00
EPA: remove LocatedL / SrcSpanAnnL and LocatedLI / SrcSpanAnnLI
This is part of a refactor towards only having LocatedA / SrcSpanAnnA
It removes the stated items, but has to add back one for BooleanFormula,
LocatedBF / SrcSpanAnnBF
This commit also use the HsConDetails RecCon extension point to
capture the braces in a record constructor
- - - - -
62 changed files:
- compiler/GHC/Data/BooleanFormula.hs
- compiler/GHC/Hs.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Stats.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/ThToHs.hs
- compiler/Language/Haskell/Syntax.hs
- compiler/Language/Haskell/Syntax/ImpExp.hs
- ghc/GHCi/UI.hs
- testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr
- testsuite/tests/module/mod185.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- testsuite/tests/parser/should_compile/T20718.stderr
- testsuite/tests/parser/should_compile/T20718b.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/parser/should_compile/T23315/T23315.stderr
- testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
- testsuite/tests/printer/T18791.stderr
- testsuite/tests/printer/Test10309.hs
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/printer/Test24533.stdout
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2fc3fe408286c22e575fca2a2db3e89…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2fc3fe408286c22e575fca2a2db3e89…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sol/reexported-error-message] Edit reexported-module-errors
by Simon Hengel (＠sol) 21 Jun '26
by Simon Hengel (＠sol) 21 Jun '26
21 Jun '26
Simon Hengel pushed to branch wip/sol/reexported-error-message at Glasgow Haskell Compiler / GHC
Commits:
2703acce by Simon Hengel at 2026-06-21T20:40:11+00:00
Edit reexported-module-errors
- - - - -
1 changed file:
- changelog.d/reexported-module-errors
Changes:
=====================================
changelog.d/reexported-module-errors
=====================================
@@ -1,4 +1,4 @@
section: compiler
-synopsis: Reference correct package in error messages for reexported modules from hidden packages.
+synopsis: Reference the correct package in error messages when trying to import a reexported module from a hidden package.
issues: #27417
mrs: !16229
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2703acce0896f5376735c5c0f209668…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2703acce0896f5376735c5c0f209668…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sol/reexported-error-message] Reference correct package in error messages for reexported modules
by Simon Hengel (＠sol) 21 Jun '26
by Simon Hengel (＠sol) 21 Jun '26
21 Jun '26
Simon Hengel pushed to branch wip/sol/reexported-error-message at Glasgow Haskell Compiler / GHC
Commits:
a8522246 by Simon Hengel at 2026-06-22T03:36:43+07:00
Reference correct package in error messages for reexported modules
(fixes #27417)
- - - - -
11 changed files:
- + changelog.d/reexported-module-errors
- compiler/GHC/Iface/Errors.hs
- compiler/GHC/Iface/Errors/Ppr.hs
- compiler/GHC/Iface/Errors/Types.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- compiler/GHC/Unit/State.hs
- ghc/GHCi/UI/Exception.hs
- testsuite/tests/package/all.T
- + testsuite/tests/package/reexport.hs
- + testsuite/tests/package/reexport.stderr
Changes:
=====================================
changelog.d/reexported-module-errors
=====================================
@@ -0,0 +1,4 @@
+section: compiler
+synopsis: Reference correct package in error messages for reexported modules from hidden packages.
+issues: #27417
+mrs: !16229
=====================================
compiler/GHC/Iface/Errors.hs
=====================================
@@ -128,7 +128,7 @@ cantFindErr unit_env profile mod_name find_result
| otherwise
-> GenericMissing
- (map ((\uid -> (uid, lookupUnit (ue_homeUnitState unit_env) uid))) pkg_hiddens)
+ pkg_hiddens
mod_hiddens unusables files
_ -> panic "cantFindErr"
=====================================
compiler/GHC/Iface/Errors/Ppr.hs
=====================================
@@ -261,13 +261,13 @@ cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInst
.ppr.mkUnit) res ++
if f then [text "a package flag"] else []
)
- pkg_hidden :: (Unit, Maybe UnitInfo) -> SDoc
- pkg_hidden (uid, uif) =
+ pkg_hidden :: UnitInfo -> SDoc
+ pkg_hidden unit =
text "It is a member of the hidden package"
- <+> quotes (ppr uid)
+ <+> quotes (ppr $ unitId unit)
--FIXME: we don't really want to show the unit id here we should
-- show the source package id or installed package id if it's ambiguous
- <> dot $$ maybe empty pkg_hidden_hint uif
+ <> dot $$ pkg_hidden_hint unit
mod_hidden pkg =
=====================================
compiler/GHC/Iface/Errors/Types.hs
=====================================
@@ -73,7 +73,7 @@ data CantFindInstalledReason
| NotAModule
| CouldntFindInFiles [FilePath]
| GenericMissing
- [(Unit, Maybe UnitInfo)] [Unit]
+ [UnitInfo] [Unit]
[UnusableUnit] [FilePath]
| MultiplePackages [(Module, ModuleOrigin)]
deriving Generic
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -510,9 +510,9 @@ findLookupResult fc fopts r = case r of
, fr_suggestions = []})
LookupMultiple rs ->
return (FoundMultiple rs)
- LookupHidden pkg_hiddens mod_hiddens ->
+ LookupHidden fr_pkgs_hidden mod_hiddens ->
return (NotFound{ fr_paths = [], fr_pkg = Nothing
- , fr_pkgs_hidden = map (moduleUnit.fst) pkg_hiddens
+ , fr_pkgs_hidden
, fr_mods_hidden = map (moduleUnit.fst) mod_hiddens
, fr_unusables = []
, fr_suggestions = [] })
=====================================
compiler/GHC/Unit/Finder/Types.hs
=====================================
@@ -70,7 +70,7 @@ data FindResult
, fr_mods_hidden :: [Unit] -- ^ Module is in these units,
-- but the *module* is hidden
- , fr_pkgs_hidden :: [Unit] -- ^ Module is in these units,
+ , fr_pkgs_hidden :: [UnitInfo] -- ^ Module is in these units,
-- but the *unit* is hidden
-- | Module is in these units, but it is unusable
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -1905,7 +1905,7 @@ data LookupResult =
-- | No modules found, but there were some hidden ones with
-- an exact name match. First is due to package hidden, second
-- is due to module being hidden
- | LookupHidden [(Module, ModuleOrigin)] [(Module, ModuleOrigin)]
+ | LookupHidden [UnitInfo] [(Module, ModuleOrigin)]
-- | No modules found, but there were some unusable ones with
-- an exact name match
| LookupUnusable [(Module, ModuleOrigin)]
@@ -1954,8 +1954,8 @@ lookupModuleWithSuggestions' :: UnitState
-> ModuleName
-> PkgQual
-> LookupResult
-lookupModuleWithSuggestions' pkgs mod_map m mb_pn
- = case lookupUniqMap mod_map m of
+lookupModuleWithSuggestions' pkgs mod_map name mb_pn
+ = case lookupUniqMap mod_map name of
Nothing -> LookupNotFound suggestions
Just xs ->
case foldl' classify ([],[],[], []) (sortOn fst $ nonDetUniqMapToList xs) of
@@ -1969,19 +1969,26 @@ lookupModuleWithSuggestions' pkgs mod_map m mb_pn
classify (hidden_pkg, hidden_mod, unusable, exposed) (m, origin0) =
let origin = filterOrigin mb_pn (mod_unit m) origin0
x = (m, origin)
+
+ originUnit :: [UnitInfo] -> [UnitInfo]
+ originUnit
+ | moduleName m == name, Just pkg <- lookupUnit pkgs (moduleUnit m) = (pkg :)
+ | otherwise = id
+
in case origin of
ModHidden
-> (hidden_pkg, x:hidden_mod, unusable, exposed)
ModUnusable _
-> (hidden_pkg, hidden_mod, x:unusable, exposed)
- _ | originEmpty origin
+ ModOrigin _ _ reexports _
+ | originEmpty origin
-> (hidden_pkg, hidden_mod, unusable, exposed)
| originVisible origin
-> (hidden_pkg, hidden_mod, unusable, x:exposed)
| otherwise
- -> (x:hidden_pkg, hidden_mod, unusable, exposed)
+ -> (reexports ++ originUnit hidden_pkg, hidden_mod, unusable, exposed)
- unit_lookup p = lookupUnit pkgs p `orElse` pprPanic "lookupModuleWithSuggestions" (ppr p <+> ppr m)
+ unit_lookup p = lookupUnit pkgs p `orElse` pprPanic "lookupModuleWithSuggestions" (ppr p <+> ppr name)
mod_unit = unit_lookup . moduleUnit
-- Filters out origins which are not associated with the given package
@@ -2011,7 +2018,7 @@ lookupModuleWithSuggestions' pkgs mod_map m mb_pn
, fromPackageFlag = False -- always excluded
}
- suggestions = fuzzyLookup (moduleNameString m) all_mods
+ suggestions = fuzzyLookup (moduleNameString name) all_mods
all_mods :: [(String, ModuleSuggestion)] -- All modules
all_mods = sortBy (comparing fst) $
=====================================
ghc/GHCi/UI/Exception.hs
=====================================
@@ -222,11 +222,13 @@ ghciDiagnosticMessage ghc_opts msg =
Just (pprWithUnitState us $ cantFindErrorX pkg_hidden_hint may_show_locations module_or_interface cfi)
_ -> Nothing
where
-
+ may_show_locations :: [String] -> SDoc
may_show_locations = mayShowLocations ":set -v" (ifaceShowTriedFiles opts)
+ pkg_hidden_hint :: UnitInfo -> SDoc
pkg_hidden_hint = pkgHiddenHint hidden_msg (ifaceBuildingCabalPackage opts)
where
+ hidden_msg :: UnitInfo -> SDoc
hidden_msg pkg =
text "You can run" <+>
quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
=====================================
testsuite/tests/package/all.T
=====================================
@@ -13,6 +13,7 @@ test('package04', normal, compile, [incr_containers])
test('package05', normal, compile, [incr_ghc + inc_ghc])
test('package06', normal, compile, [incr_ghc])
test('package06e', normalise_version('ghc'), compile_fail, [incr_ghc])
+test('reexport', normalise_version('ghc'), compile_fail, ['-hide-all-packages -XNoImplicitPrelude'])
test('package07e', normalise_version('ghc'), compile_fail, [incr_ghc + inc_ghc + hide_ghc])
test('package08e', normalise_version('ghc'), compile_fail, [incr_ghc + hide_ghc])
test('package09e', normal, compile_fail, ['-package "containers (Data.Map as M, Data.Set as M)"'])
=====================================
testsuite/tests/package/reexport.hs
=====================================
@@ -0,0 +1,2 @@
+module Reexport where
+import GHC.Types -- reexported by ghc-prim from ghc-internal
=====================================
testsuite/tests/package/reexport.stderr
=====================================
@@ -0,0 +1,5 @@
+reexport.hs:2:1: error: [GHC-87110]
+ Could not load module ‘GHC.Types’.
+ It is a member of the hidden package ‘ghc-prim-0.14.0’.
+ Use -v to see a list of the files searched for.
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a852224647bdfd4a21e054721e86964…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a852224647bdfd4a21e054721e86964…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
21 Jun '26
Simon Hengel pushed new branch wip/sol/reexported-error-message at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sol/reexported-error-message
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/stm-mvar-deadlock-backtrace] 4 commits: testsuite: Add LoopBacktrace test
by Ben Gamari (＠bgamari) 21 Jun '26
by Ben Gamari (＠bgamari) 21 Jun '26
21 Jun '26
Ben Gamari pushed to branch wip/stm-mvar-deadlock-backtrace at Glasgow Haskell Compiler / GHC
Commits:
57e9a132 by Ben Gamari at 2026-06-21T11:49:24-04:00
testsuite: Add LoopBacktrace test
- - - - -
c126d27d by Ben Gamari at 2026-06-21T11:49:24-04:00
Throw nontermination exceptions via `throw`
This ensures that the exception that results gets the usual backtrace
annotations.
- - - - -
6ce60aca by Ben Gamari at 2026-06-21T11:49:24-04:00
compiler: Report backtraces in MVar and STM dealocks
Apply the same treatment previously given to Nontermination exceptions
to MVar and STM deadlock exceptions, using `throw` instead of ad-hoc
throwing with `throwToSingleThread` to ensure that the usual backtrace
machinery is involved.
- - - - -
82c1e8b9 by Ben Gamari at 2026-06-21T11:49:24-04:00
testsuite: Add tests for deadlock backtraces
- - - - -
19 changed files:
- libraries/base/src/Control/Exception/Base.hs
- libraries/base/src/GHC/IO/Exception.hs
- libraries/ghc-internal/include/RtsIfaceSymbols.h
- libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- rts/Prelude.h
- rts/RaiseAsync.c
- rts/RaiseAsync.h
- rts/RtsStartup.c
- rts/Schedule.c
- rts/include/rts/RtsToHsIface.h
- + testsuite/tests/rts/LoopBacktrace.hs
- + testsuite/tests/rts/LoopBacktrace.stderr
- + testsuite/tests/rts/LoopBacktrace.stdout
- + testsuite/tests/rts/MVarDeadlockBacktrace.hs
- + testsuite/tests/rts/MVarDeadlockBacktrace.stderr
- + testsuite/tests/rts/STMDeadlockBacktrace.hs
- + testsuite/tests/rts/STMDeadlockBacktrace.stderr
- testsuite/tests/rts/all.T
Changes:
=====================================
libraries/base/src/Control/Exception/Base.hs
=====================================
@@ -85,7 +85,6 @@ module Control.Exception.Base
patError,
noMethodBindingError,
typeError,
- nonTermination,
nestedAtomically,
noMatchingContinuationPrompt
) where
=====================================
libraries/base/src/GHC/IO/Exception.hs
=====================================
@@ -19,8 +19,8 @@
--
module GHC.IO.Exception (
- BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
- BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
+ BlockedIndefinitelyOnMVar(..),
+ BlockedIndefinitelyOnSTM(..),
Deadlock(..),
AllocationLimitExceeded(..), allocationLimitExceeded,
AssertionFailed(..),
=====================================
libraries/ghc-internal/include/RtsIfaceSymbols.h
=====================================
@@ -15,12 +15,12 @@ CLOSURE(GHCziInternalziWeakziFinalizze, runFinalizzerBatch_closure)
CLOSURE(GHCziInternalziIOziException, stackOverflow_closure)
CLOSURE(GHCziInternalziIOziException, heapOverflow_closure)
CLOSURE(GHCziInternalziIOziException, allocationLimitExceeded_closure)
-CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnMVar_closure)
-CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTM_closure)
+CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnMVarError_closure)
+CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTMError_closure)
CLOSURE(GHCziInternalziIOziException, cannotCompactFunction_closure)
CLOSURE(GHCziInternalziIOziException, cannotCompactPinned_closure)
CLOSURE(GHCziInternalziIOziException, cannotCompactMutable_closure)
-CLOSURE(GHCziInternalziControlziExceptionziBase, nonTermination_closure)
+CLOSURE(GHCziInternalziControlziExceptionziBase, nonTerminationError_closure)
CLOSURE(GHCziInternalziControlziExceptionziBase, nestedAtomically_closure)
CLOSURE(GHCziInternalziControlziExceptionziBase, noMatchingContinuationPrompt_closure)
#if defined(mingw32_HOST_OS)
=====================================
libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
=====================================
@@ -108,7 +108,7 @@ module GHC.Internal.Control.Exception.Base (
impossibleError, impossibleConstraintError,
nonExhaustiveGuardsError, patError, noMethodBindingError,
typeError,
- nonTermination, nestedAtomically, noMatchingContinuationPrompt,
+ nonTerminationError, nestedAtomically, noMatchingContinuationPrompt,
) where
import GHC.Internal.Base (
@@ -448,8 +448,9 @@ impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s)
-- GHC's RTS calls this
-nonTermination :: SomeException
-nonTermination = toException NonTermination
+nonTerminationError :: IO ()
+nonTerminationError = throwIO NonTermination
+
-- GHC's RTS calls this
nestedAtomically :: SomeException
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
=====================================
@@ -24,8 +24,8 @@
-----------------------------------------------------------------------------
module GHC.Internal.IO.Exception (
- BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
- BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
+ BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVarError,
+ BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTMError,
Deadlock(..),
AllocationLimitExceeded(..), allocationLimitExceeded,
AssertionFailed(..),
@@ -84,8 +84,8 @@ instance Exception BlockedIndefinitelyOnMVar
instance Show BlockedIndefinitelyOnMVar where
showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation"
-blockedIndefinitelyOnMVar :: SomeException -- for the RTS
-blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar
+blockedIndefinitelyOnMVarError :: IO () -- for the RTS
+blockedIndefinitelyOnMVarError = throwIO BlockedIndefinitelyOnMVar
-----
@@ -100,8 +100,8 @@ instance Exception BlockedIndefinitelyOnSTM
instance Show BlockedIndefinitelyOnSTM where
showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction"
-blockedIndefinitelyOnSTM :: SomeException -- for the RTS
-blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM
+blockedIndefinitelyOnSTMError :: IO () -- for the RTS
+blockedIndefinitelyOnSTMError = throwIO BlockedIndefinitelyOnSTM
-----
=====================================
rts/Prelude.h
=====================================
@@ -53,12 +53,12 @@ extern StgClosure ZCMain_main_closure;
#define stackOverflow_closure ghc_hs_iface->stackOverflow_closure
#define heapOverflow_closure ghc_hs_iface->heapOverflow_closure
#define allocationLimitExceeded_closure ghc_hs_iface->allocationLimitExceeded_closure
-#define blockedIndefinitelyOnMVar_closure ghc_hs_iface->blockedIndefinitelyOnMVar_closure
-#define blockedIndefinitelyOnSTM_closure ghc_hs_iface->blockedIndefinitelyOnSTM_closure
+#define blockedIndefinitelyOnMVarError_closure ghc_hs_iface->blockedIndefinitelyOnMVarError_closure
+#define blockedIndefinitelyOnSTMError_closure ghc_hs_iface->blockedIndefinitelyOnSTMError_closure
#define cannotCompactFunction_closure ghc_hs_iface->cannotCompactFunction_closure
#define cannotCompactPinned_closure ghc_hs_iface->cannotCompactPinned_closure
#define cannotCompactMutable_closure ghc_hs_iface->cannotCompactMutable_closure
-#define nonTermination_closure ghc_hs_iface->nonTermination_closure
+#define nonTerminationError_closure ghc_hs_iface->nonTerminationError_closure
#define nestedAtomically_closure ghc_hs_iface->nestedAtomically_closure
#define absentSumFieldError_closure ghc_hs_iface->absentSumFieldError_closure
#define underflowException_closure ghc_hs_iface->underflowException_closure
=====================================
rts/RaiseAsync.c
=====================================
@@ -87,6 +87,55 @@ suspendComputation (Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here)
throwToSingleThreaded__ (cap, tso, NULL, false, stop_here);
}
+/* -----------------------------------------------------------------------------
+ scheduleRaiseViaIO
+
+ Schedule `tso` to raise an exception by running `io_action`, an IO () that
+ performs `throwIO`. Unlike throwToSingleThreaded (which injects an exception
+ *value* via raiseAsync), the exception is raised by throwIO *within* the
+ thread, so it acquires a backtrace of the thread's stack. This is used by
+ resurrectThreads to deliver the "blocked indefinitely" exceptions
+ (BlockedIndefinitelyOnMVar, BlockedIndefinitelyOnSTM, NonTermination).
+
+ We push a "run this IO action" frame on top of the thread's existing
+ (suspended) stack and make it runnable; when the thread runs, throwIO raises
+ the exception and its own stack unwinding handles any CATCH_FRAME /
+ ATOMICALLY_FRAME (e.g. aborting a blocked STM transaction).
+
+ removeFromQueues takes care of unlinking the thread from any blocking queue
+ (notably the MVar blocked queue) and appends it to the run queue. As with
+ throwToSingleThreaded, the caller must own the TSO (e.g. hold all
+ capabilities during GC); in particular this relies on the thread not being
+ scheduled between removeFromQueues' enqueue and our stack push.
+ -------------------------------------------------------------------------- */
+
+void
+scheduleRaiseViaIO (Capability *cap, StgTSO *tso, StgClosure *io_action)
+{
+ // Thread already dead?
+ if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
+ return;
+ }
+
+ // Unlink from any blocking queues; sets why_blocked = NotBlocked and
+ // appends the thread to the run queue.
+ removeFromQueues(cap, tso);
+
+ StgStack *stack = tso->stackobj;
+
+ // We are about to mutate the stack, so dirty it for the GC write barrier
+ // (resurrectThreads runs right after GC).
+ dirty_TSO(cap, tso);
+ dirty_STACK(cap, stack);
+
+ // Push a frame that enters `io_action` and applies the resulting IO action
+ // to the void (RealWorld) argument: [stg_enter_info, io_action, stg_ap_v_info]
+ stack->sp -= 3;
+ stack->sp[0] = (W_)&stg_enter_info;
+ stack->sp[1] = (W_)io_action;
+ stack->sp[2] = (W_)&stg_ap_v_info;
+}
+
/* -----------------------------------------------------------------------------
throwToSelf
=====================================
rts/RaiseAsync.h
=====================================
@@ -38,6 +38,10 @@ void suspendComputation (Capability *cap,
StgTSO *tso,
StgUpdateFrame *stop_here);
+void scheduleRaiseViaIO (Capability *cap,
+ StgTSO *tso,
+ StgClosure *io_action);
+
MessageThrowTo *throwTo (Capability *cap, // the Capability we hold
StgTSO *source,
StgTSO *target,
=====================================
rts/RtsStartup.c
=====================================
@@ -192,9 +192,9 @@ static void initBuiltinGcRoots(void)
getStablePtr((StgPtr)stackOverflow_closure);
getStablePtr((StgPtr)heapOverflow_closure);
getStablePtr((StgPtr)unpackCString_closure);
- getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure);
- getStablePtr((StgPtr)nonTermination_closure);
- getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure);
+ getStablePtr((StgPtr)blockedIndefinitelyOnMVarError_closure);
+ getStablePtr((StgPtr)nonTerminationError_closure);
+ getStablePtr((StgPtr)blockedIndefinitelyOnSTMError_closure);
getStablePtr((StgPtr)allocationLimitExceeded_closure);
getStablePtr((StgPtr)cannotCompactFunction_closure);
getStablePtr((StgPtr)cannotCompactPinned_closure);
=====================================
rts/Schedule.c
=====================================
@@ -3309,16 +3309,16 @@ resurrectThreads (StgTSO *threads)
case BlockedOnMVar:
case BlockedOnMVarRead:
/* Called by GC - sched_mutex lock is currently held. */
- throwToSingleThreaded(cap, tso,
- (StgClosure *)blockedIndefinitelyOnMVar_closure);
+ scheduleRaiseViaIO(cap, tso,
+ (StgClosure *)blockedIndefinitelyOnMVarError_closure);
break;
case BlockedOnBlackHole:
- throwToSingleThreaded(cap, tso,
- (StgClosure *)nonTermination_closure);
+ scheduleRaiseViaIO(cap, tso,
+ (StgClosure *)nonTerminationError_closure);
break;
case BlockedOnSTM:
- throwToSingleThreaded(cap, tso,
- (StgClosure *)blockedIndefinitelyOnSTM_closure);
+ scheduleRaiseViaIO(cap, tso,
+ (StgClosure *)blockedIndefinitelyOnSTMError_closure);
break;
case NotBlocked:
/* This might happen if the thread was blocked on a black hole
=====================================
rts/include/rts/RtsToHsIface.h
=====================================
@@ -20,12 +20,12 @@ typedef struct {
StgClosure *stackOverflow_closure; // GHC.Internal.IO.Exception.stackOverflow_closure
StgClosure *heapOverflow_closure; // GHC.Internal.IO.Exception.heapOverflow_closure
StgClosure *allocationLimitExceeded_closure; // GHC.Internal.IO.Exception.allocationLimitExceeded_closure
- StgClosure *blockedIndefinitelyOnMVar_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnMVar_closure
- StgClosure *blockedIndefinitelyOnSTM_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnSTM_closure
+ StgClosure *blockedIndefinitelyOnMVarError_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnMVarError_closure
+ StgClosure *blockedIndefinitelyOnSTMError_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnSTMError_closure
StgClosure *cannotCompactFunction_closure; // GHC.Internal.IO.Exception.cannotCompactFunction_closure
StgClosure *cannotCompactPinned_closure; // GHC.Internal.IO.Exception.cannotCompactPinned_closure
StgClosure *cannotCompactMutable_closure; // GHC.Internal.IO.Exception.cannotCompactMutable_closure
- StgClosure *nonTermination_closure; // GHC.Internal.Control.Exception.Base.nonTermination_closure
+ StgClosure *nonTerminationError_closure; // GHC.Internal.Control.Exception.Base.nonTerminationError_closure
StgClosure *nestedAtomically_closure; // GHC.Internal.Control.Exception.Base.nestedAtomically_closure
StgClosure *noMatchingContinuationPrompt_closure; // GHC.Internal.Control.Exception.Base.noMatchingContinuationPrompt_closure
StgClosure *blockedOnBadFD_closure; // GHC.Internal.Event.Thread.blockedOnBadFD_closure
=====================================
testsuite/tests/rts/LoopBacktrace.hs
=====================================
@@ -0,0 +1,17 @@
+{-# OPTIONS_GHC -finfo-table-map -forig-thunk-info #-}
+
+import GHC.Exception.Backtrace.Experimental
+
+x :: Integer
+x = x + 1
+
+testing :: IO ()
+testing = do
+ putStrLn "hello"
+ print x
+ putStrLn "world"
+
+main :: IO ()
+main = do
+ setBacktraceMechanismState IPEBacktrace True
+ testing
=====================================
testsuite/tests/rts/LoopBacktrace.stderr
=====================================
@@ -0,0 +1,21 @@
+LoopBacktrace: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.NonTermination:
+
+<<loop>>
+
+IPE backtrace:
+ GHC.Internal.Exception.Backtrace.collectBacktraces' (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:(179,1)-(202,25))
+ GHC.Internal.Exception.Backtrace.collectBacktraces (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:174:39-56)
+ GHC.Internal.Exception.toExceptionWithBacktrace (libraries/ghc-internal/src/GHC/Internal/Exception.hs:(179,26)-(181,53))
+ GHC.Internal.IO.throwIO (libraries/ghc-internal/src/GHC/Internal/IO.hs:293:36)
+ Cmm$rts/HeapStackCheck.cmm. (:)
+ GHC.Internal.Bignum.Integer.integerAdd (libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs:(547,1)-(571,52))
+ Cmm$rts/Updates.cmm. (:)
+ Main.x (LoopBacktrace.hs:6:1-9)
+ GHC.Internal.Show.show (libraries/ghc-internal/src/GHC/Internal/Show.hs:497:10-21)
+ GHC.Internal.IO.Handle.Text.hPutStr' (libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs:667:29-37)
+ GHC.Internal.Base.thenIO (libraries/ghc-internal/src/GHC/Internal/Base.hs:2337:1-72)
+ Cmm$rts/Exception.cmm. (:)
+ Cmm$rts/StgStartup.cmm. (:)
+HasCallStack backtrace:
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:452:23 in ghc-internal:GHC.Internal.Control.Exception.Base
+
=====================================
testsuite/tests/rts/LoopBacktrace.stdout
=====================================
@@ -0,0 +1 @@
+hello
=====================================
testsuite/tests/rts/MVarDeadlockBacktrace.hs
=====================================
@@ -0,0 +1,13 @@
+{-# OPTIONS_GHC -finfo-table-map #-}
+
+-- | Check that a @BlockedIndefinitelyOnMVar@ deadlock exception carries a
+-- backtrace mentioning the blocking site in this module.
+import Control.Concurrent.MVar
+import GHC.Exception.Backtrace.Experimental
+
+main :: IO ()
+main = do
+ setBacktraceMechanismState IPEBacktrace True
+ mv <- newEmptyMVar :: IO (MVar ())
+ x <- takeMVar mv
+ print x
=====================================
testsuite/tests/rts/MVarDeadlockBacktrace.stderr
=====================================
@@ -0,0 +1,2 @@
+MVarDeadlockBacktrace: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnMVar:
+ Main.main (MVarDeadlockBacktrace.hs:16:3-36)
=====================================
testsuite/tests/rts/STMDeadlockBacktrace.hs
=====================================
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -finfo-table-map #-}
+
+-- | Check that a @BlockedIndefinitelyOnSTM@ deadlock exception carries a
+-- backtrace mentioning the blocking site in this module.
+import GHC.Conc (atomically, retry)
+import GHC.Exception.Backtrace.Experimental
+
+main :: IO ()
+main = do
+ setBacktraceMechanismState IPEBacktrace True
+ x <- atomically retry :: IO ()
+ print x
=====================================
testsuite/tests/rts/STMDeadlockBacktrace.stderr
=====================================
@@ -0,0 +1,2 @@
+STMDeadlockBacktrace: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnSTM:
+ Main.main (STMDeadlockBacktrace.hs:16:3-32)
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -687,3 +687,11 @@ test('ClosureTable',
['-debug -O0 ClosureTable_c.c -I{top}/../rts -I{top}/../rts/include'])
test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']), only_ways(['optasm', 'sanity'])], compile_and_run, [''])
+
+test('LoopBacktrace', [exit_code(1)], compile_and_run, [''])
+
+deadlock_backtrace_norm = grep_errmsg(r'(Uncaught exception|Main\.)')
+test('MVarDeadlockBacktrace', [exit_code(1), only_ways(['normal']), deadlock_backtrace_norm],
+ compile_and_run, ['-O'])
+test('STMDeadlockBacktrace', [exit_code(1), only_ways(['normal']), deadlock_backtrace_norm],
+ compile_and_run, ['-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fadf9d48162e32184c1d7c83c916a6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fadf9d48162e32184c1d7c83c916a6…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/loop-backtrace] 2 commits: testsuite: Add LoopBacktrace test
by Ben Gamari (＠bgamari) 21 Jun '26
by Ben Gamari (＠bgamari) 21 Jun '26
21 Jun '26
Ben Gamari pushed to branch wip/loop-backtrace at Glasgow Haskell Compiler / GHC
Commits:
57e9a132 by Ben Gamari at 2026-06-21T11:49:24-04:00
testsuite: Add LoopBacktrace test
- - - - -
c126d27d by Ben Gamari at 2026-06-21T11:49:24-04:00
Throw nontermination exceptions via `throw`
This ensures that the exception that results gets the usual backtrace
annotations.
- - - - -
11 changed files:
- libraries/base/src/Control/Exception/Base.hs
- libraries/ghc-internal/include/RtsIfaceSymbols.h
- libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
- rts/Prelude.h
- rts/RtsStartup.c
- rts/Schedule.c
- rts/include/rts/RtsToHsIface.h
- + testsuite/tests/rts/LoopBacktrace.hs
- + testsuite/tests/rts/LoopBacktrace.stderr
- + testsuite/tests/rts/LoopBacktrace.stdout
- testsuite/tests/rts/all.T
Changes:
=====================================
libraries/base/src/Control/Exception/Base.hs
=====================================
@@ -85,7 +85,6 @@ module Control.Exception.Base
patError,
noMethodBindingError,
typeError,
- nonTermination,
nestedAtomically,
noMatchingContinuationPrompt
) where
=====================================
libraries/ghc-internal/include/RtsIfaceSymbols.h
=====================================
@@ -20,7 +20,7 @@ CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTM_closure)
CLOSURE(GHCziInternalziIOziException, cannotCompactFunction_closure)
CLOSURE(GHCziInternalziIOziException, cannotCompactPinned_closure)
CLOSURE(GHCziInternalziIOziException, cannotCompactMutable_closure)
-CLOSURE(GHCziInternalziControlziExceptionziBase, nonTermination_closure)
+CLOSURE(GHCziInternalziControlziExceptionziBase, nonTerminationError_closure)
CLOSURE(GHCziInternalziControlziExceptionziBase, nestedAtomically_closure)
CLOSURE(GHCziInternalziControlziExceptionziBase, noMatchingContinuationPrompt_closure)
#if defined(mingw32_HOST_OS)
=====================================
libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
=====================================
@@ -108,7 +108,7 @@ module GHC.Internal.Control.Exception.Base (
impossibleError, impossibleConstraintError,
nonExhaustiveGuardsError, patError, noMethodBindingError,
typeError,
- nonTermination, nestedAtomically, noMatchingContinuationPrompt,
+ nonTerminationError, nestedAtomically, noMatchingContinuationPrompt,
) where
import GHC.Internal.Base (
@@ -448,8 +448,9 @@ impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s)
-- GHC's RTS calls this
-nonTermination :: SomeException
-nonTermination = toException NonTermination
+nonTerminationError :: IO ()
+nonTerminationError = throwIO NonTermination
+
-- GHC's RTS calls this
nestedAtomically :: SomeException
=====================================
rts/Prelude.h
=====================================
@@ -58,7 +58,7 @@ extern StgClosure ZCMain_main_closure;
#define cannotCompactFunction_closure ghc_hs_iface->cannotCompactFunction_closure
#define cannotCompactPinned_closure ghc_hs_iface->cannotCompactPinned_closure
#define cannotCompactMutable_closure ghc_hs_iface->cannotCompactMutable_closure
-#define nonTermination_closure ghc_hs_iface->nonTermination_closure
+#define nonTerminationError_closure ghc_hs_iface->nonTerminationError_closure
#define nestedAtomically_closure ghc_hs_iface->nestedAtomically_closure
#define absentSumFieldError_closure ghc_hs_iface->absentSumFieldError_closure
#define underflowException_closure ghc_hs_iface->underflowException_closure
=====================================
rts/RtsStartup.c
=====================================
@@ -193,7 +193,7 @@ static void initBuiltinGcRoots(void)
getStablePtr((StgPtr)heapOverflow_closure);
getStablePtr((StgPtr)unpackCString_closure);
getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure);
- getStablePtr((StgPtr)nonTermination_closure);
+ getStablePtr((StgPtr)nonTerminationError_closure);
getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure);
getStablePtr((StgPtr)allocationLimitExceeded_closure);
getStablePtr((StgPtr)cannotCompactFunction_closure);
=====================================
rts/Schedule.c
=====================================
@@ -3276,6 +3276,17 @@ findAtomicallyFrameHelper (Capability *cap, StgTSO *tso)
}
}
+static void throwNontermination(Capability *cap, StgTSO *tso) {
+ StgStack *stack = tso->stackobj;
+ stack->sp -= 3;
+ stack->sp[0] = (W_)&stg_enter_info;
+ stack->sp[1] = (W_)nonTerminationError_closure;
+ stack->sp[2] = (W_)&stg_ap_v_info;
+ tso->why_blocked = NotBlocked;
+ appendToRunQueue(cap,tso);
+}
+
+
/* -----------------------------------------------------------------------------
resurrectThreads is called after garbage collection on the list of
threads found to be garbage. Each of these threads will be woken
@@ -3313,8 +3324,7 @@ resurrectThreads (StgTSO *threads)
(StgClosure *)blockedIndefinitelyOnMVar_closure);
break;
case BlockedOnBlackHole:
- throwToSingleThreaded(cap, tso,
- (StgClosure *)nonTermination_closure);
+ throwNontermination(cap, tso);
break;
case BlockedOnSTM:
throwToSingleThreaded(cap, tso,
=====================================
rts/include/rts/RtsToHsIface.h
=====================================
@@ -25,7 +25,7 @@ typedef struct {
StgClosure *cannotCompactFunction_closure; // GHC.Internal.IO.Exception.cannotCompactFunction_closure
StgClosure *cannotCompactPinned_closure; // GHC.Internal.IO.Exception.cannotCompactPinned_closure
StgClosure *cannotCompactMutable_closure; // GHC.Internal.IO.Exception.cannotCompactMutable_closure
- StgClosure *nonTermination_closure; // GHC.Internal.Control.Exception.Base.nonTermination_closure
+ StgClosure *nonTerminationError_closure; // GHC.Internal.Control.Exception.Base.nonTerminationError_closure
StgClosure *nestedAtomically_closure; // GHC.Internal.Control.Exception.Base.nestedAtomically_closure
StgClosure *noMatchingContinuationPrompt_closure; // GHC.Internal.Control.Exception.Base.noMatchingContinuationPrompt_closure
StgClosure *blockedOnBadFD_closure; // GHC.Internal.Event.Thread.blockedOnBadFD_closure
=====================================
testsuite/tests/rts/LoopBacktrace.hs
=====================================
@@ -0,0 +1,17 @@
+{-# OPTIONS_GHC -finfo-table-map -forig-thunk-info #-}
+
+import GHC.Exception.Backtrace.Experimental
+
+x :: Integer
+x = x + 1
+
+testing :: IO ()
+testing = do
+ putStrLn "hello"
+ print x
+ putStrLn "world"
+
+main :: IO ()
+main = do
+ setBacktraceMechanismState IPEBacktrace True
+ testing
=====================================
testsuite/tests/rts/LoopBacktrace.stderr
=====================================
@@ -0,0 +1,21 @@
+LoopBacktrace: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.NonTermination:
+
+<<loop>>
+
+IPE backtrace:
+ GHC.Internal.Exception.Backtrace.collectBacktraces' (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:(179,1)-(202,25))
+ GHC.Internal.Exception.Backtrace.collectBacktraces (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:174:39-56)
+ GHC.Internal.Exception.toExceptionWithBacktrace (libraries/ghc-internal/src/GHC/Internal/Exception.hs:(179,26)-(181,53))
+ GHC.Internal.IO.throwIO (libraries/ghc-internal/src/GHC/Internal/IO.hs:293:36)
+ Cmm$rts/HeapStackCheck.cmm. (:)
+ GHC.Internal.Bignum.Integer.integerAdd (libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs:(547,1)-(571,52))
+ Cmm$rts/Updates.cmm. (:)
+ Main.x (LoopBacktrace.hs:6:1-9)
+ GHC.Internal.Show.show (libraries/ghc-internal/src/GHC/Internal/Show.hs:497:10-21)
+ GHC.Internal.IO.Handle.Text.hPutStr' (libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs:667:29-37)
+ GHC.Internal.Base.thenIO (libraries/ghc-internal/src/GHC/Internal/Base.hs:2337:1-72)
+ Cmm$rts/Exception.cmm. (:)
+ Cmm$rts/StgStartup.cmm. (:)
+HasCallStack backtrace:
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:452:23 in ghc-internal:GHC.Internal.Control.Exception.Base
+
=====================================
testsuite/tests/rts/LoopBacktrace.stdout
=====================================
@@ -0,0 +1 @@
+hello
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -687,3 +687,5 @@ test('ClosureTable',
['-debug -O0 ClosureTable_c.c -I{top}/../rts -I{top}/../rts/include'])
test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']), only_ways(['optasm', 'sanity'])], compile_and_run, [''])
+
+test('LoopBacktrace', [exit_code(1)], compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4010d1929d506335de6895408bed71…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4010d1929d506335de6895408bed71…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ipe-return-prefer-current-mod] compiler/ipe: Prefer source ticks in current module for return frames
by Ben Gamari (＠bgamari) 21 Jun '26
by Ben Gamari (＠bgamari) 21 Jun '26
21 Jun '26
Ben Gamari pushed to branch wip/ipe-return-prefer-current-mod at Glasgow Haskell Compiler / GHC
Commits:
8fbf9c06 by Ben Gamari at 2026-06-21T08:23:11-04:00
compiler/ipe: Prefer source ticks in current module for return frames
Previously we would simply attribute return frames to the nearest
enclosing tick in the calling frame. However, this will very frequently
produce unhelpful results (e.g. pointing to `(>>)` rather than the
calling function).
- - - - -
5 changed files:
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Main/Compile.hs
- + testsuite/tests/rts/ipe/T27408.hs
- + testsuite/tests/rts/ipe/T27408.stdout
- testsuite/tests/rts/ipe/all.T
Changes:
=====================================
compiler/GHC/Driver/GenerateCgIPEStub.hs
=====================================
@@ -1,7 +1,9 @@
module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks) where
+import Control.Applicative ((<|>))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
+import Data.Maybe (listToMaybe)
import Data.Semigroup ((<>))
import GHC.Cmm
import GHC.Cmm.CLabel (CLabel, mkAsmTempLabel)
@@ -10,6 +12,7 @@ import GHC.Cmm.Dataflow.Block (blockSplit, blockToList)
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Info.Build (emptySRT)
import GHC.Cmm.Pipeline (cmmPipeline)
+import GHC.Data.FastString (FastString, mkFastString)
import GHC.Data.Stream (liftIO, liftEff)
import qualified GHC.Data.Stream as Stream
import GHC.Driver.Env (hsc_dflags, hsc_logger)
@@ -28,9 +31,10 @@ import GHC.StgToCmm.Utils
import GHC.StgToCmm.CgUtils (CgStream)
import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation)
import GHC.Types.Name.Set (NonCaffySet)
+import GHC.Types.SrcLoc (srcSpanFile)
import GHC.Types.Tickish (GenTickish (SourceNote))
import GHC.Unit.Types (Module, moduleName)
-import GHC.Unit.Module (moduleNameString)
+import GHC.Unit.Module (moduleNameString, ModLocation, ml_hs_file)
import qualified GHC.Utils.Logger as Logger
import GHC.Utils.Outputable (ppr)
import GHC.Types.Unique.DSM
@@ -257,11 +261,12 @@ generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesW
-- performance suffered considerably as a result (see #23103).
lookupEstimatedTicks
:: HscEnv
+ -> ModLocation -- ^ location of the module being compiled, for IPE provenance
-> Map CmmInfoTable (Maybe IpeSourceLocation)
-> IPEStats
-> CmmGroupSRTs
-> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-lookupEstimatedTicks hsc_env ipes stats cmm_group_srts =
+lookupEstimatedTicks hsc_env mod_location ipes stats cmm_group_srts =
-- Pass 2: Create an entry in the IPE map for every info table listed in
-- this CmmGroupSRTs. If the info table is a stack info table and
-- -finfo-table-map-with-stack is enabled, look up its estimated source
@@ -276,19 +281,24 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts =
dflags = hsc_dflags hsc_env
platform = targetPlatform dflags
- -- Pass 1: Map every label meeting the conditions described in Note
- -- [Stacktraces from Info Table Provenance Entries (IPE based stack
- -- unwinding)] to the estimated source location (also as described in the
- -- aformentioned note)
+ -- Source file of the module being compiled, used to prefer current-module
+ -- source ticks for return frames. See Note [Prefer current-module source
+ -- ticks for return frames].
+ mb_src_file = mkFastString <$> ml_hs_file mod_location
+
+ -- Pass 1: Map every label meeting the conditions described in
+ -- Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
+ -- to the estimated source location (also as described in the aformentioned
+ -- note).
--
-- Note: It's important that this remains a thunk so we do not compute this
-- map if -fno-info-table-with-stack is given
labelsToSources :: Map CLabel IpeSourceLocation
labelsToSources =
if platformTablesNextToCode platform then
- foldl' labelsToSourcesWithTNTC Map.empty cmm_group_srts
+ foldl' (labelsToSourcesWithTNTC mb_src_file) Map.empty cmm_group_srts
else
- foldl' labelsToSourcesSansTNTC Map.empty cmm_group_srts
+ foldl' (labelsToSourcesSansTNTC mb_src_file) Map.empty cmm_group_srts
collectInfoTables
:: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
@@ -331,15 +341,16 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts =
-- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
labelsToSourcesWithTNTC
- :: Map CLabel IpeSourceLocation
+ :: Maybe FastString -- ^ source file of the module being compiled
+ -> Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
-labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) =
+labelsToSourcesWithTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) =
foldl' go acc (toBlockList cmm_graph)
where
go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation
go acc block =
- case (,) <$> returnFrameLabel <*> lastTickInBlock of
+ case (,) <$> returnFrameLabel <*> bestTickInBlock of
Just (clabel, src_loc) -> Map.insert clabel src_loc acc
Nothing -> acc
where
@@ -351,36 +362,135 @@ labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) =
(CmmCall _ (Just l) _ _ _ _) -> Just $ mkAsmTempLabel l
_ -> Nothing
- lastTickInBlock = foldr maybeTick Nothing (blockToList middleBlock)
+ -- All SourceNotes in the block, in block order.
+ -- See Note [Prefer current-module source ticks for return frames].
+ bestTickInBlock = preferThisFile mb_src_file procFallback (blockToList middleBlock)
+
+ -- Enclosing current-module note for the whole proc (its function's own
+ -- span), used when a return frame's own block has no current-module tick.
+ procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph)
+labelsToSourcesWithTNTC _ acc _ = acc
+
+{-
+Note [Prefer current-module source ticks for return frames]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A return frame's source location is taken from the `SourceNote`s of the block
+that *ends* in the frame's call (see
+Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding]
+above and `labelsToSourcesWithTNTC`). At `-O`, inlining means such a
+block frequently carries `SourceNote`s for inlined library glue (`>>`, `>>=`,
+`threadDelay`, ...) and the *nearest* note — the one historically chosen — is
+often a library note rather than the user's code. The resulting IPE entry then
+points at the library (its file and label; see `toCgIPE` in
+GHC.StgToCmm.InfoTableProv, which takes the file from the note's own span), so a
+backtrace of a thread blocked in such a primop shows no user frames.
+
+For a concrete example, compile (at -O1)
+
+ -- Scan.hs
+ f3 :: IO ()
+ f3 = threadDelay 1000000 >> putStrLn "done"
+
+The body of `f3` reaches the inlined `threadDelay`'s internal `delay#` in a
+block whose notes are *all* from `Conc.IO`/`Base` — the user's `Scan.hs` tick
+for `f3` sits only in the proc's entry block:
+
+ entry: -- the proc's entry block
+ //tick src<.../Base.hs:2306:5-18>
+ //tick src<Scan.hs:13:1-43> -- the enclosing `f3` span
+ //tick src<.../Conc/IO.hs:(223,1)-(235,10)>
+ ...
+ delayBlk: -- no Scan.hs note here:
+ //tick src<.../Conc/IO.hs:232:5-13>
+ //tick src<.../Base.hs:2268:1-9>
+ //tick src<.../Conc/IO.hs:(232,25)-(235,10)> -- nearest note
+ call stg_delay#(R1) returns to delayCont, args: 8, res: 8, upd: 8;
+
+Naively taking the nearest note attributes `delayCont` to `Conc/IO.hs:232`,
+i.e. an internal of `threadDelay`, rather than `f3`.
+
+To fix this we attribute a return frame's source location in the following
+preference order:
+
+ 1. the nearest tick in the frame's block whose file is that of the module
+ being compiled - the precise user call site. (When the user makes a
+ blocking call directly, e.g. `f v = takeMVar v`, such a note is present in
+ the call's block and this rule suffices; the `delayBlk` above has none.)
+ 2. failing that, the proc's *enclosing* current-module note (the outermost
+ current-module `SourceNote` in the proc, i.e. its function's own span).
+ For `f3` this is `src<Scan.hs:13:1-43>`, so `delayCont` is attributed to
+ `f3` rather than to `threadDelay`'s internals.
+ 3. failing that, the nearest note of any module (the historical behaviour).
+
+This mirrors the same-file preference the DWARF path uses in
+`GHC.Cmm.DebugBlock.bestSrcTick` and that `GHC.Stg.Debug.quickSourcePos` uses
+for closures.
+-}
- maybeTick :: CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation
- maybeTick _ s@(Just _) = s
- maybeTick (CmmTick (SourceNote span name)) Nothing = Just (span, name)
- maybeTick _ _ = Nothing
-labelsToSourcesWithTNTC acc _ = acc
+-- | Pick the 'IpeSourceLocation' to attribute to a return frame from the
+-- source-note-bearing nodes of its block (in block order).
+--
+-- See Note [Prefer current-module source ticks for return frames].
+preferThisFile :: Maybe FastString -> Maybe IpeSourceLocation -> [CmmNode O O] -> Maybe IpeSourceLocation
+preferThisFile mb_src_file procFallback nodes =
+ nearest fromThisFile <|> procFallback <|> nearest sourceNotes
+ where
+ sourceNotes = [ (span, name) | CmmTick (SourceNote span name) <- nodes ]
+ fromThisFile = case mb_src_file of
+ Just f -> filter ((== f) . srcSpanFile . fst) sourceNotes
+ Nothing -> []
+ nearest = listToMaybe . reverse
+
+-- | The outermost 'SourceNote' from the module being compiled across a proc's
+-- blocks (in 'toBlockList' order, so the entry block's note — the function's own
+-- span — comes first). Used as a fallback so inlined cross-module code is still
+-- labelled with the enclosing user function. 'Nothing' when the proc has no
+-- current-module note (e.g. when compiling the library itself).
+enclosingThisFileTick :: Maybe FastString -> [CmmBlock] -> Maybe IpeSourceLocation
+enclosingThisFileTick mb_src_file blocks =
+ listToMaybe
+ [ (span, name)
+ | b <- blocks
+ , let (_, mid, _) = blockSplit b
+ , CmmTick (SourceNote span name) <- blockToList mid
+ , Just (srcSpanFile span) == mb_src_file ]
-- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
labelsToSourcesSansTNTC
- :: Map CLabel IpeSourceLocation
+ :: Maybe FastString -- ^ source file of the module being compiled
+ -> Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
-labelsToSourcesSansTNTC acc (CmmProc _ _ _ cmm_graph) =
+labelsToSourcesSansTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) =
foldl' go acc (toBlockList cmm_graph)
where
+ -- See 'enclosingThisFileTick'.
+ procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph)
+
go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation
- go acc block = fst $ foldl' collectLabels (acc, Nothing) (blockToList middleBlock)
+ go acc block = fst $ foldl' collectLabels (acc, (Nothing, Nothing)) (blockToList middleBlock)
where
(_, middleBlock, _) = blockSplit block
+ -- We track the nearest preceding SourceNote from the module being
+ -- compiled and the nearest of any module, and prefer the former (then
+ -- the proc's enclosing current-module note) when attributing a return
+ -- frame. See Note [Prefer current-module source ticks for return frames].
collectLabels
- :: (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
+ :: (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation))
-> CmmNode O O
- -> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
- collectLabels (!acc, lastTick) b =
- case (b, lastTick) of
- (CmmStore _ (CmmLit (CmmLabel l)) _, Just src_loc) ->
- (Map.insert l src_loc acc, Nothing)
- (CmmTick (SourceNote span name), _) ->
- (acc, Just (span, name))
- _ -> (acc, lastTick)
-labelsToSourcesSansTNTC acc _ = acc
+ -> (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation))
+ collectLabels (!acc, st@(lastThis, lastAny)) b =
+ case b of
+ CmmStore _ (CmmLit (CmmLabel l)) _ ->
+ case lastThis <|> procFallback <|> lastAny of
+ Just src_loc -> (Map.insert l src_loc acc, (Nothing, Nothing))
+ Nothing -> (acc, st)
+ CmmTick (SourceNote span name) ->
+ let tick = (span, name)
+ lastThis'
+ | Just (srcSpanFile span) == mb_src_file = Just tick
+ | otherwise = lastThis
+ in (acc, (lastThis', Just tick))
+ _ -> (acc, st)
+labelsToSourcesSansTNTC _ acc _ = acc
=====================================
compiler/GHC/Driver/Main/Compile.hs
=====================================
@@ -699,7 +699,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do
_ ->
do
cmms <- {-# SCC "StgToCmm" #-}
- doCodeGen hsc_env this_mod denv tycons
+ doCodeGen hsc_env this_mod mod_loc denv tycons
cost_centre_info
stg_binds
@@ -956,14 +956,17 @@ This reduces residency towards the end of the CodeGen phase significantly
(5-10%).
-}
-doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon]
+doCodeGen :: HscEnv -> Module
+ -> ModLocation -- ^ location of the module being compiled, used to
+ -- prefer current-module IPE source locations
+ -> InfoTableProvMap -> [TyCon]
-> CollectedCCs
-> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs
-> IO (CgStream CmmGroupSRTs CmmCgInfos)
-- Note we produce a 'Stream' of CmmGroups, so that the
-- backend can be run incrementally. Otherwise it generates all
-- the C-- up front, which has a significant space cost.
-doCodeGen hsc_env this_mod denv tycons
+doCodeGen hsc_env this_mod mod_location denv tycons
cost_centre_info stg_binds_w_fvs = do
let dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
@@ -1032,7 +1035,7 @@ doCodeGen hsc_env this_mod denv tycons
-- Positions] in GHC.Stg.Debug.
(ipes', stats') <-
if (gopt Opt_InfoTableMap dflags) then
- liftIO $ lookupEstimatedTicks hsc_env ipes stats cmm_srts
+ liftIO $ lookupEstimatedTicks hsc_env mod_location ipes stats cmm_srts
else
return (ipes, stats)
=====================================
testsuite/tests/rts/ipe/T27408.hs
=====================================
@@ -0,0 +1,18 @@
+module Main where
+
+import GHC.Stack.CloneStack (StackEntry(..), cloneMyStack, decode)
+
+userFunction :: IO [StackEntry]
+userFunction = do
+ putStr ""
+ stk <- cloneMyStack
+ putStr ""
+ es <- decode stk
+ putStr ""
+ return es
+
+main :: IO ()
+main = do
+ entries <- userFunction
+ let ours = filter ((== "Main") . moduleName) entries
+ mapM_ (\e -> putStrLn (moduleName e ++ "\t" ++ functionName e)) ours
=====================================
testsuite/tests/rts/ipe/T27408.stdout
=====================================
@@ -0,0 +1,3 @@
+Main
+Main main
+Main userFunction
=====================================
testsuite/tests/rts/ipe/all.T
=====================================
@@ -4,6 +4,16 @@ def noCapabilityOutputFilter(s):
test('ipeMap', [extra_files(['ipe_lib.c', 'ipe_lib.h']), c_src, omit_ghci], compile_and_run, ['ipe_lib.c'])
+# Return frames whose Cmm block is dominated by inlined library ticks (e.g. the
+# (>>)/(>>=) of a user do-block at -O) should still be attributed to the user's
+# module. See Note [Prefer current-module source ticks for return frames] in
+# GHC.Driver.GenerateCgIPEStub.
+test('T27408',
+ [ omit_ghci # cloneMyStack# is not available in ghci
+ , js_broken(22261) # cloneMyStack# not yet implemented in the JS backend
+ ],
+ compile_and_run, ['-O1 -finfo-table-map -g3'])
+
# Manually create IPE entries and dump them to event log (stderr).
test('ipeEventLog',
[ c_src,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8fbf9c06a3e27491e9b783450cc7eba…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8fbf9c06a3e27491e9b783450cc7eba…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/stm-mvar-deadlock-backtrace] 5 commits: compiler/ipe: Prefer source ticks in current module for return frames
by Ben Gamari (＠bgamari) 21 Jun '26
by Ben Gamari (＠bgamari) 21 Jun '26
21 Jun '26
Ben Gamari pushed to branch wip/stm-mvar-deadlock-backtrace at Glasgow Haskell Compiler / GHC
Commits:
8fbf9c06 by Ben Gamari at 2026-06-21T08:23:11-04:00
compiler/ipe: Prefer source ticks in current module for return frames
Previously we would simply attribute return frames to the nearest
enclosing tick in the calling frame. However, this will very frequently
produce unhelpful results (e.g. pointing to `(>>)` rather than the
calling function).
- - - - -
abd9dc0e by Ben Gamari at 2026-06-21T11:20:56-04:00
testsuite: Add LoopBacktrace test
- - - - -
4010d192 by Ben Gamari at 2026-06-21T11:20:56-04:00
Throw nontermination exceptions via `throw`
This ensures that the exception that results gets the usual backtrace
annotations.
- - - - -
f8b70be2 by Ben Gamari at 2026-06-21T11:38:17-04:00
compiler: Report backtraces in MVar and STM dealocks
Apply the same treatment previously given to Nontermination exceptions
to MVar and STM deadlock exceptions, using `throw` instead of ad-hoc
throwing with `throwToSingleThread` to ensure that the usual backtrace
machinery is involved.
- - - - -
fadf9d48 by Ben Gamari at 2026-06-21T11:38:17-04:00
testsuite: Add tests for deadlock backtraces
- - - - -
24 changed files:
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Main/Compile.hs
- libraries/base/src/Control/Exception/Base.hs
- libraries/base/src/GHC/IO/Exception.hs
- libraries/ghc-internal/include/RtsIfaceSymbols.h
- libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- rts/Prelude.h
- rts/RaiseAsync.c
- rts/RaiseAsync.h
- rts/RtsStartup.c
- rts/Schedule.c
- rts/include/rts/RtsToHsIface.h
- + testsuite/tests/rts/LoopBacktrace.hs
- + testsuite/tests/rts/LoopBacktrace.stderr
- + testsuite/tests/rts/LoopBacktrace.stdout
- + testsuite/tests/rts/MVarDeadlockBacktrace.hs
- + testsuite/tests/rts/MVarDeadlockBacktrace.stderr
- + testsuite/tests/rts/STMDeadlockBacktrace.hs
- + testsuite/tests/rts/STMDeadlockBacktrace.stderr
- testsuite/tests/rts/all.T
- + testsuite/tests/rts/ipe/T27408.hs
- + testsuite/tests/rts/ipe/T27408.stdout
- testsuite/tests/rts/ipe/all.T
Changes:
=====================================
compiler/GHC/Driver/GenerateCgIPEStub.hs
=====================================
@@ -1,7 +1,9 @@
module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks) where
+import Control.Applicative ((<|>))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
+import Data.Maybe (listToMaybe)
import Data.Semigroup ((<>))
import GHC.Cmm
import GHC.Cmm.CLabel (CLabel, mkAsmTempLabel)
@@ -10,6 +12,7 @@ import GHC.Cmm.Dataflow.Block (blockSplit, blockToList)
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Info.Build (emptySRT)
import GHC.Cmm.Pipeline (cmmPipeline)
+import GHC.Data.FastString (FastString, mkFastString)
import GHC.Data.Stream (liftIO, liftEff)
import qualified GHC.Data.Stream as Stream
import GHC.Driver.Env (hsc_dflags, hsc_logger)
@@ -28,9 +31,10 @@ import GHC.StgToCmm.Utils
import GHC.StgToCmm.CgUtils (CgStream)
import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation)
import GHC.Types.Name.Set (NonCaffySet)
+import GHC.Types.SrcLoc (srcSpanFile)
import GHC.Types.Tickish (GenTickish (SourceNote))
import GHC.Unit.Types (Module, moduleName)
-import GHC.Unit.Module (moduleNameString)
+import GHC.Unit.Module (moduleNameString, ModLocation, ml_hs_file)
import qualified GHC.Utils.Logger as Logger
import GHC.Utils.Outputable (ppr)
import GHC.Types.Unique.DSM
@@ -257,11 +261,12 @@ generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesW
-- performance suffered considerably as a result (see #23103).
lookupEstimatedTicks
:: HscEnv
+ -> ModLocation -- ^ location of the module being compiled, for IPE provenance
-> Map CmmInfoTable (Maybe IpeSourceLocation)
-> IPEStats
-> CmmGroupSRTs
-> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-lookupEstimatedTicks hsc_env ipes stats cmm_group_srts =
+lookupEstimatedTicks hsc_env mod_location ipes stats cmm_group_srts =
-- Pass 2: Create an entry in the IPE map for every info table listed in
-- this CmmGroupSRTs. If the info table is a stack info table and
-- -finfo-table-map-with-stack is enabled, look up its estimated source
@@ -276,19 +281,24 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts =
dflags = hsc_dflags hsc_env
platform = targetPlatform dflags
- -- Pass 1: Map every label meeting the conditions described in Note
- -- [Stacktraces from Info Table Provenance Entries (IPE based stack
- -- unwinding)] to the estimated source location (also as described in the
- -- aformentioned note)
+ -- Source file of the module being compiled, used to prefer current-module
+ -- source ticks for return frames. See Note [Prefer current-module source
+ -- ticks for return frames].
+ mb_src_file = mkFastString <$> ml_hs_file mod_location
+
+ -- Pass 1: Map every label meeting the conditions described in
+ -- Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
+ -- to the estimated source location (also as described in the aformentioned
+ -- note).
--
-- Note: It's important that this remains a thunk so we do not compute this
-- map if -fno-info-table-with-stack is given
labelsToSources :: Map CLabel IpeSourceLocation
labelsToSources =
if platformTablesNextToCode platform then
- foldl' labelsToSourcesWithTNTC Map.empty cmm_group_srts
+ foldl' (labelsToSourcesWithTNTC mb_src_file) Map.empty cmm_group_srts
else
- foldl' labelsToSourcesSansTNTC Map.empty cmm_group_srts
+ foldl' (labelsToSourcesSansTNTC mb_src_file) Map.empty cmm_group_srts
collectInfoTables
:: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
@@ -331,15 +341,16 @@ lookupEstimatedTicks hsc_env ipes stats cmm_group_srts =
-- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
labelsToSourcesWithTNTC
- :: Map CLabel IpeSourceLocation
+ :: Maybe FastString -- ^ source file of the module being compiled
+ -> Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
-labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) =
+labelsToSourcesWithTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) =
foldl' go acc (toBlockList cmm_graph)
where
go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation
go acc block =
- case (,) <$> returnFrameLabel <*> lastTickInBlock of
+ case (,) <$> returnFrameLabel <*> bestTickInBlock of
Just (clabel, src_loc) -> Map.insert clabel src_loc acc
Nothing -> acc
where
@@ -351,36 +362,135 @@ labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) =
(CmmCall _ (Just l) _ _ _ _) -> Just $ mkAsmTempLabel l
_ -> Nothing
- lastTickInBlock = foldr maybeTick Nothing (blockToList middleBlock)
+ -- All SourceNotes in the block, in block order.
+ -- See Note [Prefer current-module source ticks for return frames].
+ bestTickInBlock = preferThisFile mb_src_file procFallback (blockToList middleBlock)
+
+ -- Enclosing current-module note for the whole proc (its function's own
+ -- span), used when a return frame's own block has no current-module tick.
+ procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph)
+labelsToSourcesWithTNTC _ acc _ = acc
+
+{-
+Note [Prefer current-module source ticks for return frames]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A return frame's source location is taken from the `SourceNote`s of the block
+that *ends* in the frame's call (see
+Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding]
+above and `labelsToSourcesWithTNTC`). At `-O`, inlining means such a
+block frequently carries `SourceNote`s for inlined library glue (`>>`, `>>=`,
+`threadDelay`, ...) and the *nearest* note — the one historically chosen — is
+often a library note rather than the user's code. The resulting IPE entry then
+points at the library (its file and label; see `toCgIPE` in
+GHC.StgToCmm.InfoTableProv, which takes the file from the note's own span), so a
+backtrace of a thread blocked in such a primop shows no user frames.
+
+For a concrete example, compile (at -O1)
+
+ -- Scan.hs
+ f3 :: IO ()
+ f3 = threadDelay 1000000 >> putStrLn "done"
+
+The body of `f3` reaches the inlined `threadDelay`'s internal `delay#` in a
+block whose notes are *all* from `Conc.IO`/`Base` — the user's `Scan.hs` tick
+for `f3` sits only in the proc's entry block:
+
+ entry: -- the proc's entry block
+ //tick src<.../Base.hs:2306:5-18>
+ //tick src<Scan.hs:13:1-43> -- the enclosing `f3` span
+ //tick src<.../Conc/IO.hs:(223,1)-(235,10)>
+ ...
+ delayBlk: -- no Scan.hs note here:
+ //tick src<.../Conc/IO.hs:232:5-13>
+ //tick src<.../Base.hs:2268:1-9>
+ //tick src<.../Conc/IO.hs:(232,25)-(235,10)> -- nearest note
+ call stg_delay#(R1) returns to delayCont, args: 8, res: 8, upd: 8;
+
+Naively taking the nearest note attributes `delayCont` to `Conc/IO.hs:232`,
+i.e. an internal of `threadDelay`, rather than `f3`.
+
+To fix this we attribute a return frame's source location in the following
+preference order:
+
+ 1. the nearest tick in the frame's block whose file is that of the module
+ being compiled - the precise user call site. (When the user makes a
+ blocking call directly, e.g. `f v = takeMVar v`, such a note is present in
+ the call's block and this rule suffices; the `delayBlk` above has none.)
+ 2. failing that, the proc's *enclosing* current-module note (the outermost
+ current-module `SourceNote` in the proc, i.e. its function's own span).
+ For `f3` this is `src<Scan.hs:13:1-43>`, so `delayCont` is attributed to
+ `f3` rather than to `threadDelay`'s internals.
+ 3. failing that, the nearest note of any module (the historical behaviour).
+
+This mirrors the same-file preference the DWARF path uses in
+`GHC.Cmm.DebugBlock.bestSrcTick` and that `GHC.Stg.Debug.quickSourcePos` uses
+for closures.
+-}
- maybeTick :: CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation
- maybeTick _ s@(Just _) = s
- maybeTick (CmmTick (SourceNote span name)) Nothing = Just (span, name)
- maybeTick _ _ = Nothing
-labelsToSourcesWithTNTC acc _ = acc
+-- | Pick the 'IpeSourceLocation' to attribute to a return frame from the
+-- source-note-bearing nodes of its block (in block order).
+--
+-- See Note [Prefer current-module source ticks for return frames].
+preferThisFile :: Maybe FastString -> Maybe IpeSourceLocation -> [CmmNode O O] -> Maybe IpeSourceLocation
+preferThisFile mb_src_file procFallback nodes =
+ nearest fromThisFile <|> procFallback <|> nearest sourceNotes
+ where
+ sourceNotes = [ (span, name) | CmmTick (SourceNote span name) <- nodes ]
+ fromThisFile = case mb_src_file of
+ Just f -> filter ((== f) . srcSpanFile . fst) sourceNotes
+ Nothing -> []
+ nearest = listToMaybe . reverse
+
+-- | The outermost 'SourceNote' from the module being compiled across a proc's
+-- blocks (in 'toBlockList' order, so the entry block's note — the function's own
+-- span — comes first). Used as a fallback so inlined cross-module code is still
+-- labelled with the enclosing user function. 'Nothing' when the proc has no
+-- current-module note (e.g. when compiling the library itself).
+enclosingThisFileTick :: Maybe FastString -> [CmmBlock] -> Maybe IpeSourceLocation
+enclosingThisFileTick mb_src_file blocks =
+ listToMaybe
+ [ (span, name)
+ | b <- blocks
+ , let (_, mid, _) = blockSplit b
+ , CmmTick (SourceNote span name) <- blockToList mid
+ , Just (srcSpanFile span) == mb_src_file ]
-- | See Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
labelsToSourcesSansTNTC
- :: Map CLabel IpeSourceLocation
+ :: Maybe FastString -- ^ source file of the module being compiled
+ -> Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
-labelsToSourcesSansTNTC acc (CmmProc _ _ _ cmm_graph) =
+labelsToSourcesSansTNTC mb_src_file acc (CmmProc _ _ _ cmm_graph) =
foldl' go acc (toBlockList cmm_graph)
where
+ -- See 'enclosingThisFileTick'.
+ procFallback = enclosingThisFileTick mb_src_file (toBlockList cmm_graph)
+
go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation
- go acc block = fst $ foldl' collectLabels (acc, Nothing) (blockToList middleBlock)
+ go acc block = fst $ foldl' collectLabels (acc, (Nothing, Nothing)) (blockToList middleBlock)
where
(_, middleBlock, _) = blockSplit block
+ -- We track the nearest preceding SourceNote from the module being
+ -- compiled and the nearest of any module, and prefer the former (then
+ -- the proc's enclosing current-module note) when attributing a return
+ -- frame. See Note [Prefer current-module source ticks for return frames].
collectLabels
- :: (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
+ :: (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation))
-> CmmNode O O
- -> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
- collectLabels (!acc, lastTick) b =
- case (b, lastTick) of
- (CmmStore _ (CmmLit (CmmLabel l)) _, Just src_loc) ->
- (Map.insert l src_loc acc, Nothing)
- (CmmTick (SourceNote span name), _) ->
- (acc, Just (span, name))
- _ -> (acc, lastTick)
-labelsToSourcesSansTNTC acc _ = acc
+ -> (Map CLabel IpeSourceLocation, (Maybe IpeSourceLocation, Maybe IpeSourceLocation))
+ collectLabels (!acc, st@(lastThis, lastAny)) b =
+ case b of
+ CmmStore _ (CmmLit (CmmLabel l)) _ ->
+ case lastThis <|> procFallback <|> lastAny of
+ Just src_loc -> (Map.insert l src_loc acc, (Nothing, Nothing))
+ Nothing -> (acc, st)
+ CmmTick (SourceNote span name) ->
+ let tick = (span, name)
+ lastThis'
+ | Just (srcSpanFile span) == mb_src_file = Just tick
+ | otherwise = lastThis
+ in (acc, (lastThis', Just tick))
+ _ -> (acc, st)
+labelsToSourcesSansTNTC _ acc _ = acc
=====================================
compiler/GHC/Driver/Main/Compile.hs
=====================================
@@ -699,7 +699,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do
_ ->
do
cmms <- {-# SCC "StgToCmm" #-}
- doCodeGen hsc_env this_mod denv tycons
+ doCodeGen hsc_env this_mod mod_loc denv tycons
cost_centre_info
stg_binds
@@ -956,14 +956,17 @@ This reduces residency towards the end of the CodeGen phase significantly
(5-10%).
-}
-doCodeGen :: HscEnv -> Module -> InfoTableProvMap -> [TyCon]
+doCodeGen :: HscEnv -> Module
+ -> ModLocation -- ^ location of the module being compiled, used to
+ -- prefer current-module IPE source locations
+ -> InfoTableProvMap -> [TyCon]
-> CollectedCCs
-> [CgStgTopBinding] -- ^ Bindings come already annotated with fvs
-> IO (CgStream CmmGroupSRTs CmmCgInfos)
-- Note we produce a 'Stream' of CmmGroups, so that the
-- backend can be run incrementally. Otherwise it generates all
-- the C-- up front, which has a significant space cost.
-doCodeGen hsc_env this_mod denv tycons
+doCodeGen hsc_env this_mod mod_location denv tycons
cost_centre_info stg_binds_w_fvs = do
let dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
@@ -1032,7 +1035,7 @@ doCodeGen hsc_env this_mod denv tycons
-- Positions] in GHC.Stg.Debug.
(ipes', stats') <-
if (gopt Opt_InfoTableMap dflags) then
- liftIO $ lookupEstimatedTicks hsc_env ipes stats cmm_srts
+ liftIO $ lookupEstimatedTicks hsc_env mod_location ipes stats cmm_srts
else
return (ipes, stats)
=====================================
libraries/base/src/Control/Exception/Base.hs
=====================================
@@ -85,7 +85,6 @@ module Control.Exception.Base
patError,
noMethodBindingError,
typeError,
- nonTermination,
nestedAtomically,
noMatchingContinuationPrompt
) where
=====================================
libraries/base/src/GHC/IO/Exception.hs
=====================================
@@ -19,8 +19,8 @@
--
module GHC.IO.Exception (
- BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
- BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
+ BlockedIndefinitelyOnMVar(..),
+ BlockedIndefinitelyOnSTM(..),
Deadlock(..),
AllocationLimitExceeded(..), allocationLimitExceeded,
AssertionFailed(..),
=====================================
libraries/ghc-internal/include/RtsIfaceSymbols.h
=====================================
@@ -15,12 +15,12 @@ CLOSURE(GHCziInternalziWeakziFinalizze, runFinalizzerBatch_closure)
CLOSURE(GHCziInternalziIOziException, stackOverflow_closure)
CLOSURE(GHCziInternalziIOziException, heapOverflow_closure)
CLOSURE(GHCziInternalziIOziException, allocationLimitExceeded_closure)
-CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnMVar_closure)
-CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTM_closure)
+CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnMVarError_closure)
+CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTMError_closure)
CLOSURE(GHCziInternalziIOziException, cannotCompactFunction_closure)
CLOSURE(GHCziInternalziIOziException, cannotCompactPinned_closure)
CLOSURE(GHCziInternalziIOziException, cannotCompactMutable_closure)
-CLOSURE(GHCziInternalziControlziExceptionziBase, nonTermination_closure)
+CLOSURE(GHCziInternalziControlziExceptionziBase, nonTerminationError_closure)
CLOSURE(GHCziInternalziControlziExceptionziBase, nestedAtomically_closure)
CLOSURE(GHCziInternalziControlziExceptionziBase, noMatchingContinuationPrompt_closure)
#if defined(mingw32_HOST_OS)
=====================================
libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
=====================================
@@ -108,7 +108,7 @@ module GHC.Internal.Control.Exception.Base (
impossibleError, impossibleConstraintError,
nonExhaustiveGuardsError, patError, noMethodBindingError,
typeError,
- nonTermination, nestedAtomically, noMatchingContinuationPrompt,
+ nonTerminationError, nestedAtomically, noMatchingContinuationPrompt,
) where
import GHC.Internal.Base (
@@ -448,8 +448,9 @@ impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s)
-- GHC's RTS calls this
-nonTermination :: SomeException
-nonTermination = toException NonTermination
+nonTerminationError :: IO ()
+nonTerminationError = throwIO NonTermination
+
-- GHC's RTS calls this
nestedAtomically :: SomeException
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
=====================================
@@ -24,8 +24,8 @@
-----------------------------------------------------------------------------
module GHC.Internal.IO.Exception (
- BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
- BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
+ BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVarError,
+ BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTMError,
Deadlock(..),
AllocationLimitExceeded(..), allocationLimitExceeded,
AssertionFailed(..),
@@ -84,8 +84,8 @@ instance Exception BlockedIndefinitelyOnMVar
instance Show BlockedIndefinitelyOnMVar where
showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation"
-blockedIndefinitelyOnMVar :: SomeException -- for the RTS
-blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar
+blockedIndefinitelyOnMVarError :: IO () -- for the RTS
+blockedIndefinitelyOnMVarError = throwIO BlockedIndefinitelyOnMVar
-----
@@ -100,8 +100,8 @@ instance Exception BlockedIndefinitelyOnSTM
instance Show BlockedIndefinitelyOnSTM where
showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction"
-blockedIndefinitelyOnSTM :: SomeException -- for the RTS
-blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM
+blockedIndefinitelyOnSTMError :: IO () -- for the RTS
+blockedIndefinitelyOnSTMError = throwIO BlockedIndefinitelyOnSTM
-----
=====================================
rts/Prelude.h
=====================================
@@ -53,12 +53,12 @@ extern StgClosure ZCMain_main_closure;
#define stackOverflow_closure ghc_hs_iface->stackOverflow_closure
#define heapOverflow_closure ghc_hs_iface->heapOverflow_closure
#define allocationLimitExceeded_closure ghc_hs_iface->allocationLimitExceeded_closure
-#define blockedIndefinitelyOnMVar_closure ghc_hs_iface->blockedIndefinitelyOnMVar_closure
-#define blockedIndefinitelyOnSTM_closure ghc_hs_iface->blockedIndefinitelyOnSTM_closure
+#define blockedIndefinitelyOnMVarError_closure ghc_hs_iface->blockedIndefinitelyOnMVarError_closure
+#define blockedIndefinitelyOnSTMError_closure ghc_hs_iface->blockedIndefinitelyOnSTMError_closure
#define cannotCompactFunction_closure ghc_hs_iface->cannotCompactFunction_closure
#define cannotCompactPinned_closure ghc_hs_iface->cannotCompactPinned_closure
#define cannotCompactMutable_closure ghc_hs_iface->cannotCompactMutable_closure
-#define nonTermination_closure ghc_hs_iface->nonTermination_closure
+#define nonTerminationError_closure ghc_hs_iface->nonTerminationError_closure
#define nestedAtomically_closure ghc_hs_iface->nestedAtomically_closure
#define absentSumFieldError_closure ghc_hs_iface->absentSumFieldError_closure
#define underflowException_closure ghc_hs_iface->underflowException_closure
=====================================
rts/RaiseAsync.c
=====================================
@@ -87,6 +87,55 @@ suspendComputation (Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here)
throwToSingleThreaded__ (cap, tso, NULL, false, stop_here);
}
+/* -----------------------------------------------------------------------------
+ scheduleRaiseViaIO
+
+ Schedule `tso` to raise an exception by running `io_action`, an IO () that
+ performs `throwIO`. Unlike throwToSingleThreaded (which injects an exception
+ *value* via raiseAsync), the exception is raised by throwIO *within* the
+ thread, so it acquires a backtrace of the thread's stack. This is used by
+ resurrectThreads to deliver the "blocked indefinitely" exceptions
+ (BlockedIndefinitelyOnMVar, BlockedIndefinitelyOnSTM, NonTermination).
+
+ We push a "run this IO action" frame on top of the thread's existing
+ (suspended) stack and make it runnable; when the thread runs, throwIO raises
+ the exception and its own stack unwinding handles any CATCH_FRAME /
+ ATOMICALLY_FRAME (e.g. aborting a blocked STM transaction).
+
+ removeFromQueues takes care of unlinking the thread from any blocking queue
+ (notably the MVar blocked queue) and appends it to the run queue. As with
+ throwToSingleThreaded, the caller must own the TSO (e.g. hold all
+ capabilities during GC); in particular this relies on the thread not being
+ scheduled between removeFromQueues' enqueue and our stack push.
+ -------------------------------------------------------------------------- */
+
+void
+scheduleRaiseViaIO (Capability *cap, StgTSO *tso, StgClosure *io_action)
+{
+ // Thread already dead?
+ if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
+ return;
+ }
+
+ // Unlink from any blocking queues; sets why_blocked = NotBlocked and
+ // appends the thread to the run queue.
+ removeFromQueues(cap, tso);
+
+ StgStack *stack = tso->stackobj;
+
+ // We are about to mutate the stack, so dirty it for the GC write barrier
+ // (resurrectThreads runs right after GC).
+ dirty_TSO(cap, tso);
+ dirty_STACK(cap, stack);
+
+ // Push a frame that enters `io_action` and applies the resulting IO action
+ // to the void (RealWorld) argument: [stg_enter_info, io_action, stg_ap_v_info]
+ stack->sp -= 3;
+ stack->sp[0] = (W_)&stg_enter_info;
+ stack->sp[1] = (W_)io_action;
+ stack->sp[2] = (W_)&stg_ap_v_info;
+}
+
/* -----------------------------------------------------------------------------
throwToSelf
=====================================
rts/RaiseAsync.h
=====================================
@@ -38,6 +38,10 @@ void suspendComputation (Capability *cap,
StgTSO *tso,
StgUpdateFrame *stop_here);
+void scheduleRaiseViaIO (Capability *cap,
+ StgTSO *tso,
+ StgClosure *io_action);
+
MessageThrowTo *throwTo (Capability *cap, // the Capability we hold
StgTSO *source,
StgTSO *target,
=====================================
rts/RtsStartup.c
=====================================
@@ -192,9 +192,9 @@ static void initBuiltinGcRoots(void)
getStablePtr((StgPtr)stackOverflow_closure);
getStablePtr((StgPtr)heapOverflow_closure);
getStablePtr((StgPtr)unpackCString_closure);
- getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure);
- getStablePtr((StgPtr)nonTermination_closure);
- getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure);
+ getStablePtr((StgPtr)blockedIndefinitelyOnMVarError_closure);
+ getStablePtr((StgPtr)nonTerminationError_closure);
+ getStablePtr((StgPtr)blockedIndefinitelyOnSTMError_closure);
getStablePtr((StgPtr)allocationLimitExceeded_closure);
getStablePtr((StgPtr)cannotCompactFunction_closure);
getStablePtr((StgPtr)cannotCompactPinned_closure);
=====================================
rts/Schedule.c
=====================================
@@ -3309,16 +3309,16 @@ resurrectThreads (StgTSO *threads)
case BlockedOnMVar:
case BlockedOnMVarRead:
/* Called by GC - sched_mutex lock is currently held. */
- throwToSingleThreaded(cap, tso,
- (StgClosure *)blockedIndefinitelyOnMVar_closure);
+ scheduleRaiseViaIO(cap, tso,
+ (StgClosure *)blockedIndefinitelyOnMVarError_closure);
break;
case BlockedOnBlackHole:
- throwToSingleThreaded(cap, tso,
- (StgClosure *)nonTermination_closure);
+ scheduleRaiseViaIO(cap, tso,
+ (StgClosure *)nonTerminationError_closure);
break;
case BlockedOnSTM:
- throwToSingleThreaded(cap, tso,
- (StgClosure *)blockedIndefinitelyOnSTM_closure);
+ scheduleRaiseViaIO(cap, tso,
+ (StgClosure *)blockedIndefinitelyOnSTMError_closure);
break;
case NotBlocked:
/* This might happen if the thread was blocked on a black hole
=====================================
rts/include/rts/RtsToHsIface.h
=====================================
@@ -20,12 +20,12 @@ typedef struct {
StgClosure *stackOverflow_closure; // GHC.Internal.IO.Exception.stackOverflow_closure
StgClosure *heapOverflow_closure; // GHC.Internal.IO.Exception.heapOverflow_closure
StgClosure *allocationLimitExceeded_closure; // GHC.Internal.IO.Exception.allocationLimitExceeded_closure
- StgClosure *blockedIndefinitelyOnMVar_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnMVar_closure
- StgClosure *blockedIndefinitelyOnSTM_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnSTM_closure
+ StgClosure *blockedIndefinitelyOnMVarError_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnMVarError_closure
+ StgClosure *blockedIndefinitelyOnSTMError_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnSTMError_closure
StgClosure *cannotCompactFunction_closure; // GHC.Internal.IO.Exception.cannotCompactFunction_closure
StgClosure *cannotCompactPinned_closure; // GHC.Internal.IO.Exception.cannotCompactPinned_closure
StgClosure *cannotCompactMutable_closure; // GHC.Internal.IO.Exception.cannotCompactMutable_closure
- StgClosure *nonTermination_closure; // GHC.Internal.Control.Exception.Base.nonTermination_closure
+ StgClosure *nonTerminationError_closure; // GHC.Internal.Control.Exception.Base.nonTerminationError_closure
StgClosure *nestedAtomically_closure; // GHC.Internal.Control.Exception.Base.nestedAtomically_closure
StgClosure *noMatchingContinuationPrompt_closure; // GHC.Internal.Control.Exception.Base.noMatchingContinuationPrompt_closure
StgClosure *blockedOnBadFD_closure; // GHC.Internal.Event.Thread.blockedOnBadFD_closure
=====================================
testsuite/tests/rts/LoopBacktrace.hs
=====================================
@@ -0,0 +1,17 @@
+{-# OPTIONS_GHC -finfo-table-map -forig-thunk-info #-}
+
+import GHC.Exception.Backtrace.Experimental
+
+x :: Integer
+x = x + 1
+
+testing :: IO ()
+testing = do
+ putStrLn "hello"
+ print x
+ putStrLn "world"
+
+main :: IO ()
+main = do
+ setBacktraceMechanismState IPEBacktrace True
+ testing
=====================================
testsuite/tests/rts/LoopBacktrace.stderr
=====================================
@@ -0,0 +1,21 @@
+LoopBacktrace: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.NonTermination:
+
+<<loop>>
+
+IPE backtrace:
+ GHC.Internal.Exception.Backtrace.collectBacktraces' (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:(179,1)-(202,25))
+ GHC.Internal.Exception.Backtrace.collectBacktraces (libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs:174:39-56)
+ GHC.Internal.Exception.toExceptionWithBacktrace (libraries/ghc-internal/src/GHC/Internal/Exception.hs:(179,26)-(181,53))
+ GHC.Internal.IO.throwIO (libraries/ghc-internal/src/GHC/Internal/IO.hs:293:36)
+ Cmm$rts/HeapStackCheck.cmm. (:)
+ GHC.Internal.Bignum.Integer.integerAdd (libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs:(547,1)-(571,52))
+ Cmm$rts/Updates.cmm. (:)
+ Main.x (LoopBacktrace.hs:6:1-9)
+ GHC.Internal.Show.show (libraries/ghc-internal/src/GHC/Internal/Show.hs:497:10-21)
+ GHC.Internal.IO.Handle.Text.hPutStr' (libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs:667:29-37)
+ GHC.Internal.Base.thenIO (libraries/ghc-internal/src/GHC/Internal/Base.hs:2337:1-72)
+ Cmm$rts/Exception.cmm. (:)
+ Cmm$rts/StgStartup.cmm. (:)
+HasCallStack backtrace:
+ throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:452:23 in ghc-internal:GHC.Internal.Control.Exception.Base
+
=====================================
testsuite/tests/rts/LoopBacktrace.stdout
=====================================
@@ -0,0 +1 @@
+hello
=====================================
testsuite/tests/rts/MVarDeadlockBacktrace.hs
=====================================
@@ -0,0 +1,13 @@
+{-# OPTIONS_GHC -finfo-table-map #-}
+
+-- | Check that a @BlockedIndefinitelyOnMVar@ deadlock exception carries a
+-- backtrace mentioning the blocking site in this module.
+import Control.Concurrent.MVar
+import GHC.Exception.Backtrace.Experimental
+
+main :: IO ()
+main = do
+ setBacktraceMechanismState IPEBacktrace True
+ mv <- newEmptyMVar :: IO (MVar ())
+ x <- takeMVar mv
+ print x
=====================================
testsuite/tests/rts/MVarDeadlockBacktrace.stderr
=====================================
@@ -0,0 +1,2 @@
+MVarDeadlockBacktrace: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnMVar:
+ Main.main (MVarDeadlockBacktrace.hs:16:3-36)
=====================================
testsuite/tests/rts/STMDeadlockBacktrace.hs
=====================================
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -finfo-table-map #-}
+
+-- | Check that a @BlockedIndefinitelyOnSTM@ deadlock exception carries a
+-- backtrace mentioning the blocking site in this module.
+import GHC.Conc (atomically, retry)
+import GHC.Exception.Backtrace.Experimental
+
+main :: IO ()
+main = do
+ setBacktraceMechanismState IPEBacktrace True
+ x <- atomically retry :: IO ()
+ print x
=====================================
testsuite/tests/rts/STMDeadlockBacktrace.stderr
=====================================
@@ -0,0 +1,2 @@
+STMDeadlockBacktrace: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnSTM:
+ Main.main (STMDeadlockBacktrace.hs:16:3-32)
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -687,3 +687,11 @@ test('ClosureTable',
['-debug -O0 ClosureTable_c.c -I{top}/../rts -I{top}/../rts/include'])
test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']), only_ways(['optasm', 'sanity'])], compile_and_run, [''])
+
+test('LoopBacktrace', [exit_code(1)], compile_and_run, [''])
+
+deadlock_backtrace_norm = grep_errmsg(r'(Uncaught exception|Main\.)')
+test('MVarDeadlockBacktrace', [exit_code(1), only_ways(['normal']), deadlock_backtrace_norm],
+ compile_and_run, ['-O'])
+test('STMDeadlockBacktrace', [exit_code(1), only_ways(['normal']), deadlock_backtrace_norm],
+ compile_and_run, ['-O'])
=====================================
testsuite/tests/rts/ipe/T27408.hs
=====================================
@@ -0,0 +1,18 @@
+module Main where
+
+import GHC.Stack.CloneStack (StackEntry(..), cloneMyStack, decode)
+
+userFunction :: IO [StackEntry]
+userFunction = do
+ putStr ""
+ stk <- cloneMyStack
+ putStr ""
+ es <- decode stk
+ putStr ""
+ return es
+
+main :: IO ()
+main = do
+ entries <- userFunction
+ let ours = filter ((== "Main") . moduleName) entries
+ mapM_ (\e -> putStrLn (moduleName e ++ "\t" ++ functionName e)) ours
=====================================
testsuite/tests/rts/ipe/T27408.stdout
=====================================
@@ -0,0 +1,3 @@
+Main
+Main main
+Main userFunction
=====================================
testsuite/tests/rts/ipe/all.T
=====================================
@@ -4,6 +4,16 @@ def noCapabilityOutputFilter(s):
test('ipeMap', [extra_files(['ipe_lib.c', 'ipe_lib.h']), c_src, omit_ghci], compile_and_run, ['ipe_lib.c'])
+# Return frames whose Cmm block is dominated by inlined library ticks (e.g. the
+# (>>)/(>>=) of a user do-block at -O) should still be attributed to the user's
+# module. See Note [Prefer current-module source ticks for return frames] in
+# GHC.Driver.GenerateCgIPEStub.
+test('T27408',
+ [ omit_ghci # cloneMyStack# is not available in ghci
+ , js_broken(22261) # cloneMyStack# not yet implemented in the JS backend
+ ],
+ compile_and_run, ['-O1 -finfo-table-map -g3'])
+
# Manually create IPE entries and dump them to event log (stderr).
test('ipeEventLog',
[ c_src,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cba8d183b41c980df79898d76b2ad3…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cba8d183b41c980df79898d76b2ad3…
You're receiving this email because of your account on gitlab.haskell.org.
1
0