- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/loop-backtrace] Throw nontermination exceptions via `throw`
by Ben Gamari (＠bgamari) 21 Jun '26

21 Jun '26

Ben Gamari pushed to branch wip/loop-backtrace at Glasgow Haskell Compiler / GHC Commits: b709d077 by Ben Gamari at 2026-06-21T17:01:08-04:00 Throw nontermination exceptions via `throw` This ensures that the exception that results gets the usual backtrace annotations. This is a first step to #21878. - - - - - 9 changed files: - + changelog.d/builtin-exception-backtraces - 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.stderr - testsuite/tests/rts/T2783.stderr Changes: ===================================== changelog.d/builtin-exception-backtraces ===================================== @@ -0,0 +1,10 @@ +section: rts +synopsis: Non-termination exceptions now have backtrace annotations +issues: #21878 +mrs: !16158 +description: { + The `NonTermination` exception (manifesting in printed exception output as + `<<loop>>`) now include `Backtrace` `ExceptionAnnotations`, like exceptions + thrown from user-written Haskell. +} + ===================================== 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,9 @@ module GHC.Internal.Control.Exception.Base ( impossibleError, impossibleConstraintError, nonExhaustiveGuardsError, patError, noMethodBindingError, typeError, - nonTermination, nestedAtomically, noMatchingContinuationPrompt, + nonTermination, nonTerminationError, + nestedAtomically, + noMatchingContinuationPrompt, ) where import GHC.Internal.Base ( @@ -448,6 +450,9 @@ impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s) -- GHC's RTS calls this +nonTerminationError :: IO () +nonTerminationError = throwIO NonTermination + nonTermination :: SomeException nonTermination = toException NonTermination ===================================== 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.stderr ===================================== @@ -3,19 +3,19 @@ LoopBacktrace: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Ba <<loop>> IPE backtrace: - Cmm$rts/StgStartup.cmm. (:) - Cmm$rts/Exception.cmm. (:) - GHC.Internal.Base.thenIO (libraries/ghc-internal/src/GHC/Internal/Base.hs:2336:1-72) - GHC.Internal.IO.Handle.Text. (:) - GHC.Internal.Show. (:) - Main.x (LoopBacktrace.hs:6:1-9) - Cmm$rts/Updates.cmm. (:) - GHC.Num.Integer. (:) - Cmm$rts/HeapStackCheck.cmm. (:) - GHC.Internal.IO.throwIO (libraries/ghc-internal/src/GHC/Internal/IO.hs:285:36) - GHC.Internal.Exception.bindIO (libraries/ghc-internal/src/GHC/Internal/Base.hs:2333:1-76) - GHC.Internal.Exception.Backtrace.bindIO (libraries/ghc-internal/src/GHC/Internal/Base.hs:2333:1-76) - GHC.Internal.Exception.Backtrace.$ (libraries/ghc-internal/src/GHC/Internal/Base.hs:2267:1-9) + 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:446:23 in ghc-internal:GHC.Internal.Control.Exception.Base + 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/T2783.stderr ===================================== @@ -1,3 +1,7 @@ T2783: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.NonTermination: <<loop>> + +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 + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b709d07758de0315cfa9022662305b6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b709d07758de0315cfa9022662305b6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/decode-orig-update-frames] ghc-heap: Expose OrigThunkInfo frames
by Ben Gamari (＠bgamari) 21 Jun '26

21 Jun '26

Ben Gamari pushed to branch wip/decode-orig-update-frames at Glasgow Haskell Compiler / GHC Commits: 34df124f by Ben Gamari at 2026-06-21T16:56:59-04:00 ghc-heap: Expose OrigThunkInfo frames Introduce a new constructor to StgStackFrame which exposes orig_update_frames, allowing better backtraces when this feature is enabled. - - - - - 4 changed files: - + changelog.d/T24812 - libraries/ghc-internal/cbits/Stack.cmm - libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs Changes: ===================================== changelog.d/T24812 ===================================== @@ -0,0 +1,7 @@ +section: ghc-heap +issues: #24812 +mrs: !16228 +synopsis: + Introduce a `OrigThunkInfo` frame type in `StackFrame`, exposing frames + produced by `-forig-thunk-info`. + ===================================== libraries/ghc-internal/cbits/Stack.cmm ===================================== @@ -3,6 +3,10 @@ #include "Cmm.h" +#if !defined(UnregisterisedCompiler) +import CLOSURE stg_orig_thunk_info_frame_info; +#endif + // StgStack_marking was not available in the Stage0 compiler at the time of // writing. Because, it has been added to derivedConstants when Stack.cmm was // developed. @@ -168,6 +172,18 @@ getStackInfoTableAddrzh(P_ stack) { return (info); } +// (StgInfoTable*) getOrigThunkInfoPtrzh(StgStack* stack, StgWord offsetWords) +getOrigThunkInfoPtrzh(P_ stack, W_ offsetWords) { + P_ p; + p = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + if (%INFO_PTR(UNTAG(p)) == stg_orig_thunk_info_frame_info) { + return (StgOrigThunkInfoFrame_info_ptr(UNTAG(p))); + } else { + return (NULL); + } +} + // (StgClosure*) getStackClosurezh(StgStack* stack, StgWord offsetWords) getStackClosurezh(P_ stack, W_ offsetWords) { P_ ptr; ===================================== libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs ===================================== @@ -568,6 +568,17 @@ data GenStackFrame b = , stack_payload :: ![GenStackField b] } + -- | An @stg_orig_thunk_info_frame@ pushed by @-forig-thunk-info@. It records + -- the original info table of the thunk being updated (in 'orig_info_tbl'), + -- which is otherwise lost when the thunk is blackholed. + -- See @Note [Original thunk info table frames]@ in "GHC.StgToCmm.Bind". + | OrigThunkInfo + { info_tbl :: !StgInfoTable + -- ^ the frame's own (RTS) info table + , orig_info_tbl :: !(Ptr StgInfoTable) + -- ^ the original info table of the thunk being updated + } + | RetFun { info_tbl :: !StgInfoTable , retFunSize :: !Word ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs ===================================== @@ -192,6 +192,16 @@ foreign import prim "getInfoTableAddrszh" getInfoTableAddrs# :: StackSnapshot# - foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSnapshot# -> Addr# +foreign import prim "getOrigThunkInfoPtrzh" getOrigThunkInfoPtr# :: StackSnapshot# -> Word# -> Addr# + +-- | @'Just' itbl@ if the frame at the given offset is an +-- @stg_orig_thunk_info_frame@ (where @itbl@ is the recorded original thunk +-- info table), otherwise 'Nothing'. +origThunkInfoFrame :: StackSnapshot# -> WordOffset -> Maybe (Ptr StgInfoTable) +origThunkInfoFrame stackSnapshot# index = + let p = Ptr (getOrigThunkInfoPtr# stackSnapshot# (wordOffsetToWord# index)) + in if p == nullPtr then Nothing else Just p + -- | Get the 'StgInfoTable' of the stack frame. -- Additionally, provides 'InfoProv' for the 'StgInfoTable' if there is any. getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO (StgInfoTable, Maybe InfoProv) @@ -380,6 +390,15 @@ unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame fi bco = bco', bcoArgs = bcoArgs' } + RET_SMALL + | Just orig_itbl <- origThunkInfoFrame stackSnapshot# index -> do + orig_info_prov <- lookupIPE (castPtr orig_itbl) + finaliseStackFrame + OrigThunkInfo + { info_tbl = info, + orig_info_tbl = orig_itbl + } + orig_info_prov RET_SMALL -> let payload' = decodeSmallBitmap getSmallBitmap# stackSnapshot# index offsetStgClosurePayload in View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34df124f2b8bc16ed2c61fb61634c68… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34df124f2b8bc16ed2c61fb61634c68… 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

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

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

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

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

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

[Git][ghc/ghc] Pushed new branch wip/sol/reexported-error-message
by Simon Hengel (＠sol) 21 Jun '26

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

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

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