diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index aea9c46227d9163ab3f54b4531300cdf40d0c9cd..7b67c0546346ec8c17fd3d83f1493e0de6547298 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -157,14 +157,14 @@ module GHC (
-- ** The debugger
SingleStep(..),
Resume(..),
- History(historyBreakInfo, historyEnclosingDecls),
+ History(historyBreakpointId, historyEnclosingDecls),
GHC.getHistorySpan, getHistoryModule,
abandon, abandonAll,
getResumeContext,
GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
modInfoModBreaks,
ModBreaks(..), BreakIndex,
- BreakInfo(..),
+ BreakpointId(..), InternalBreakpointId(..),
GHC.Runtime.Eval.back,
GHC.Runtime.Eval.forward,
GHC.Runtime.Eval.setupBreakpoint,
@@ -392,7 +392,7 @@ import GHC.Types.TyThing
import GHC.Types.Name.Env
import GHC.Types.Name.Ppr
import GHC.Types.TypeEnv
-import GHC.Types.BreakInfo
+import GHC.Types.Breakpoint
import GHC.Types.PkgQual
import GHC.Types.Unique.FM
diff --git a/compiler/GHC/ByteCode/Asm.hs b/compiler/GHC/ByteCode/Asm.hs
index 66c88541e37e222204e1840b78fceca7301b77fa..691766b8bce46841188468d9747ff9546f14ac2c 100644
--- a/compiler/GHC/ByteCode/Asm.hs
+++ b/compiler/GHC/ByteCode/Asm.hs
@@ -514,11 +514,16 @@ assembleI platform i = case i of
CCALL off m_addr i -> do np <- addr m_addr
emit bci_CCALL [wOp off, Op np, SmallOp i]
PRIMCALL -> emit bci_PRIMCALL []
- BRK_FUN arr index mod cc -> do p1 <- ptr (BCOPtrBreakArray arr)
- m <- addr mod
+ BRK_FUN arr tick_mod tickx info_mod infox cc ->
+ do p1 <- ptr (BCOPtrBreakArray arr)
+ tick_addr <- addr tick_mod
+ info_addr <- addr info_mod
np <- addr cc
- emit bci_BRK_FUN [Op p1, SmallOp index,
- Op m, Op np]
+ emit bci_BRK_FUN [ Op p1
+ , Op tick_addr, Op info_addr
+ , SmallOp tickx, SmallOp infox
+ , Op np
+ ]
where
literal (LitLabel fs (Just sz) _)
diff --git a/compiler/GHC/ByteCode/Instr.hs b/compiler/GHC/ByteCode/Instr.hs
index f3c328c47eba78f79acf1eefd4d9330dbb0e792d..3855c0314b3e58f35209d8a83a01afce07597457 100644
--- a/compiler/GHC/ByteCode/Instr.hs
+++ b/compiler/GHC/ByteCode/Instr.hs
@@ -206,7 +206,11 @@ data BCInstr
-- Note [unboxed tuple bytecodes and tuple_BCO] in GHC.StgToByteCode
-- Breakpoints
- | BRK_FUN (ForeignRef BreakArray) !Word16 (RemotePtr ModuleName)
+ | BRK_FUN (ForeignRef BreakArray)
+ (RemotePtr ModuleName) -- breakpoint tick module
+ !Word16 -- breakpoint tick index
+ (RemotePtr ModuleName) -- breakpoint info module
+ !Word16 -- breakpoint info index
(RemotePtr CostCentre)
-- -----------------------------------------------------------------------------
@@ -358,8 +362,11 @@ instance Outputable BCInstr where
ppr ENTER = text "ENTER"
ppr (RETURN pk) = text "RETURN " <+> ppr pk
ppr (RETURN_TUPLE) = text "RETURN_TUPLE"
- ppr (BRK_FUN _ index _ _) = text "BRK_FUN" <+> text "<breakarray>"
- <+> ppr index <+> text "<module>" <+> text "<cc>"
+ ppr (BRK_FUN _ _tick_mod tickx _info_mod infox _)
+ = text "BRK_FUN" <+> text "<breakarray>"
+ <+> text "<tick_module>" <+> ppr tickx
+ <+> text "<info_module>" <+> ppr infox
+ <+> text "<cc>"
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index f6917598d7a70077981d78f95ff1a25ed3bf5ab6..9ec57121c7902cf08b4f77d7c3a46a81a27fcbda 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -107,7 +107,7 @@ import GHC.Types.Unique
import GHC.Types.Unique.Supply
import GHC.Types.Unique.DSet
import GHC.Types.TyThing
-import GHC.Types.BreakInfo
+import GHC.Types.Breakpoint
import GHC.Types.Unique.Map
import GHC.Unit
@@ -143,29 +143,27 @@ import Unsafe.Coerce ( unsafeCoerce )
getResumeContext :: GhcMonad m => m [Resume]
getResumeContext = withSession (return . ic_resume . hsc_IC)
-mkHistory :: HscEnv -> ForeignHValue -> BreakInfo -> History
-mkHistory hsc_env hval bi = History hval bi (findEnclosingDecls hsc_env bi)
+mkHistory :: HscEnv -> ForeignHValue -> InternalBreakpointId -> History
+mkHistory hsc_env hval ibi = History hval ibi (findEnclosingDecls hsc_env ibi)
getHistoryModule :: History -> Module
-getHistoryModule = breakInfo_module . historyBreakInfo
+getHistoryModule = ibi_tick_mod . historyBreakpointId
getHistorySpan :: HscEnv -> History -> SrcSpan
-getHistorySpan hsc_env History{..} =
- let BreakInfo{..} = historyBreakInfo in
- case lookupHugByModule breakInfo_module (hsc_HUG hsc_env) of
- Just hmi -> modBreaks_locs (getModBreaks hmi) ! breakInfo_number
+getHistorySpan hsc_env hist =
+ let ibi = historyBreakpointId hist in
+ case lookupHugByModule (ibi_tick_mod ibi) (hsc_HUG hsc_env) of
+ Just hmi -> modBreaks_locs (getModBreaks hmi) ! ibi_tick_index ibi
_ -> panic "getHistorySpan"
{- | Finds the enclosing top level function name -}
-- ToDo: a better way to do this would be to keep hold of the decl_path computed
-- by the coverage pass, which gives the list of lexically-enclosing bindings
-- for each tick.
-findEnclosingDecls :: HscEnv -> BreakInfo -> [String]
-findEnclosingDecls hsc_env (BreakInfo modl ix) =
- let hmi = expectJust "findEnclosingDecls" $
- lookupHugByModule modl (hsc_HUG hsc_env)
- mb = getModBreaks hmi
- in modBreaks_decls mb ! ix
+findEnclosingDecls :: HscEnv -> InternalBreakpointId -> [String]
+findEnclosingDecls hsc_env ibi =
+ let hmi = expectJust "findEnclosingDecls" $ lookupHugByModule (ibi_tick_mod ibi) (hsc_HUG hsc_env)
+ in modBreaks_decls (getModBreaks hmi) ! ibi_tick_index ibi
-- | Update fixity environment in the current interactive context.
updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
@@ -324,27 +322,24 @@ handleRunStatus step expr bindings final_ids status history
| otherwise = not_tracing
where
tracing
- | EvalBreak apStack_ref maybe_break resume_ctxt _ccs <- status
- , Just (EvalBreakpoint ix mod_name) <- maybe_break
+ | EvalBreak apStack_ref (Just eval_break) resume_ctxt _ccs <- status
= do
hsc_env <- getSession
let interp = hscInterp hsc_env
let dflags = hsc_dflags hsc_env
- let hmi = expectJust "handleRunStatus" $
- lookupHpt (hsc_HPT hsc_env) (mkModuleName mod_name)
- modl = mi_module (hm_iface hmi)
+ let ibi = evalBreakpointToId (hsc_HPT hsc_env) eval_break
+ let hmi = expectJust "handleRunStatus" $ lookupHpt (hsc_HPT hsc_env) (moduleName (ibi_tick_mod ibi))
breaks = getModBreaks hmi
b <- liftIO $
- breakpointStatus interp (modBreaks_flags breaks) ix
+ breakpointStatus interp (modBreaks_flags breaks) (ibi_tick_index ibi)
if b
then not_tracing
-- This breakpoint is explicitly enabled; we want to stop
-- instead of just logging it.
else do
apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
- let bi = BreakInfo modl ix
- !history' = mkHistory hsc_env apStack_fhv bi `consBL` history
+ let !history' = mkHistory hsc_env apStack_fhv ibi `consBL` history
-- history is strict, otherwise our BoundedList is pointless.
fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
let eval_opts = initEvalOpts dflags True
@@ -362,23 +357,27 @@ handleRunStatus step expr bindings final_ids status history
let interp = hscInterp hsc_env
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
- let bp = evalBreakInfo (hsc_HPT hsc_env) <$> maybe_break
+ let ibi = evalBreakpointToId (hsc_HPT hsc_env) <$> maybe_break
(hsc_env1, names, span, decl) <- liftIO $
- bindLocalsAtBreakpoint hsc_env apStack_fhv bp
+ bindLocalsAtBreakpoint hsc_env apStack_fhv ibi
let
resume = Resume
- { resumeStmt = expr, resumeContext = resume_ctxt_fhv
- , resumeBindings = bindings, resumeFinalIds = final_ids
+ { resumeStmt = expr
+ , resumeContext = resume_ctxt_fhv
+ , resumeBindings = bindings
+ , resumeFinalIds = final_ids
, resumeApStack = apStack_fhv
- , resumeBreakInfo = bp
- , resumeSpan = span, resumeHistory = toListBL history
+ , resumeBreakpointId = ibi
+ , resumeSpan = span
+ , resumeHistory = toListBL history
, resumeDecl = decl
, resumeCCS = ccs
- , resumeHistoryIx = 0 }
+ , resumeHistoryIx = 0
+ }
hsc_env2 = pushResume hsc_env1 resume
setSession hsc_env2
- return (ExecBreak names bp)
+ return (ExecBreak names ibi)
-- Completed successfully
| EvalComplete allocs (EvalSuccess hvals) <- status
@@ -428,16 +427,21 @@ resumeExec canLogSpan step mbCnt
liftIO $ Loader.deleteFromLoadedEnv interp new_names
case r of
- Resume { resumeStmt = expr, resumeContext = fhv
- , resumeBindings = bindings, resumeFinalIds = final_ids
- , resumeApStack = apStack, resumeBreakInfo = mb_brkpt
+ Resume { resumeStmt = expr
+ , resumeContext = fhv
+ , resumeBindings = bindings
+ , resumeFinalIds = final_ids
+ , resumeApStack = apStack
+ , resumeBreakpointId = mb_brkpt
, resumeSpan = span
, resumeHistory = hist } ->
withVirtualCWD $ do
- when (isJust mb_brkpt && isJust mbCnt) $ do
- setupBreakpoint hsc_env (fromJust mb_brkpt) (fromJust mbCnt)
- -- When the user specified a break ignore count, set it
- -- in the interpreter
+ -- When the user specified a break ignore count, set it
+ -- in the interpreter
+ case (mb_brkpt, mbCnt) of
+ (Just brkpt, Just cnt) -> setupBreakpoint hsc_env (toBreakpointId brkpt) cnt
+ _ -> return ()
+
let eval_opts = initEvalOpts dflags (isStep step)
status <- liftIO $ GHCi.resumeStmt interp eval_opts fhv
let prevHistoryLst = fromListBL 50 hist
@@ -449,16 +453,15 @@ resumeExec canLogSpan step mbCnt
fromListBL 50 hist
handleRunStatus step expr bindings final_ids status hist'
-setupBreakpoint :: GhcMonad m => HscEnv -> BreakInfo -> Int -> m () -- #19157
-setupBreakpoint hsc_env brkInfo cnt = do
- let modl :: Module = breakInfo_module brkInfo
+setupBreakpoint :: GhcMonad m => HscEnv -> BreakpointId -> Int -> m () -- #19157
+setupBreakpoint hsc_env bi cnt = do
+ let modl = bi_tick_mod bi
breaks hsc_env modl = getModBreaks $ expectJust "setupBreakpoint" $
lookupHpt (hsc_HPT hsc_env) (moduleName modl)
- ix = breakInfo_number brkInfo
modBreaks = breaks hsc_env modl
breakarray = modBreaks_flags modBreaks
interp = hscInterp hsc_env
- _ <- liftIO $ GHCi.storeBreakpoint interp breakarray ix cnt
+ _ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt
pure ()
back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan, String)
@@ -501,11 +504,11 @@ moveHist fn = do
if new_ix == 0
then case r of
Resume { resumeApStack = apStack,
- resumeBreakInfo = mb_brkpt } ->
+ resumeBreakpointId = mb_brkpt } ->
update_ic apStack mb_brkpt
else case history !! (new_ix - 1) of
History{..} ->
- update_ic historyApStack (Just historyBreakInfo)
+ update_ic historyApStack (Just historyBreakpointId)
-- -----------------------------------------------------------------------------
@@ -517,7 +520,7 @@ result_fs = fsLit "_result"
bindLocalsAtBreakpoint
:: HscEnv
-> ForeignHValue
- -> Maybe BreakInfo
+ -> Maybe InternalBreakpointId
-> IO (HscEnv, [Name], SrcSpan, String)
-- Nothing case: we stopped when an exception was raised, not at a
@@ -543,25 +546,28 @@ bindLocalsAtBreakpoint hsc_env apStack Nothing = do
-- Just case: we stopped at a breakpoint, we have information about the location
-- of the breakpoint and the free variables of the expression.
-bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
+bindLocalsAtBreakpoint hsc_env apStack_fhv (Just ibi) = do
let
- hmi = expectJust "bindLocalsAtBreakpoint" $
- lookupHpt (hsc_HPT hsc_env) (moduleName breakInfo_module)
interp = hscInterp hsc_env
- breaks = getModBreaks hmi
- info = expectJust "bindLocalsAtBreakpoint2" $
- IntMap.lookup breakInfo_number (modBreaks_breakInfo breaks)
- occs = modBreaks_vars breaks ! breakInfo_number
- span = modBreaks_locs breaks ! breakInfo_number
- decl = intercalate "." $ modBreaks_decls breaks ! breakInfo_number
+
+ info_mod = ibi_info_mod ibi
+ info_hmi = expectJust "bindLocalsAtBreakpoint" $ lookupHpt (hsc_HPT hsc_env) (moduleName info_mod)
+ info_brks = getModBreaks info_hmi
+ info = expectJust "bindLocalsAtBreakpoint2" $ IntMap.lookup (ibi_info_index ibi) (modBreaks_breakInfo info_brks)
+
+ tick_mod = ibi_tick_mod ibi
+ tick_hmi = expectJust "bindLocalsAtBreakpoint" $ lookupHpt (hsc_HPT hsc_env) (moduleName tick_mod)
+ tick_brks = getModBreaks tick_hmi
+ occs = modBreaks_vars tick_brks ! ibi_tick_index ibi
+ span = modBreaks_locs tick_brks ! ibi_tick_index ibi
+ decl = intercalate "." $ modBreaks_decls tick_brks ! ibi_tick_index ibi
-- Rehydrate to understand the breakpoint info relative to the current environment.
-- This design is critical to preventing leaks (#22530)
(mbVars, result_ty) <- initIfaceLoad hsc_env
- $ initIfaceLcl breakInfo_module (text "debugger") NotBoot
+ $ initIfaceLcl info_mod (text "debugger") NotBoot
$ hydrateCgBreakInfo info
-
let
-- Filter out any unboxed ids by changing them to Nothings;
diff --git a/compiler/GHC/Runtime/Eval/Types.hs b/compiler/GHC/Runtime/Eval/Types.hs
index 85fd1c803752403537b7cc4ceab5a224ebaacefa..e3e1e02134573aadab4631d70035d0cf3db8ae29 100644
--- a/compiler/GHC/Runtime/Eval/Types.hs
+++ b/compiler/GHC/Runtime/Eval/Types.hs
@@ -19,7 +19,7 @@ import GHCi.Message (EvalExpr, ResumeContext)
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.TyThing
-import GHC.Types.BreakInfo
+import GHC.Types.Breakpoint
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import GHC.Utils.Exception
@@ -50,8 +50,8 @@ data ExecResult
, execAllocation :: Word64
}
| ExecBreak
- { breakNames :: [Name]
- , breakInfo :: Maybe BreakInfo
+ { breakNames :: [Name]
+ , breakPointId :: Maybe InternalBreakpointId
}
-- | Essentially a GlobalRdrEnv, but with additional cached values to allow
@@ -73,11 +73,10 @@ data Resume = Resume
, resumeFinalIds :: [Id] -- [Id] to bind on completion
, resumeApStack :: ForeignHValue -- The object from which we can get
-- value of the free variables.
- , resumeBreakInfo :: Maybe BreakInfo
- -- the breakpoint we stopped at
- -- (module, index)
+ , resumeBreakpointId :: Maybe InternalBreakpointId
+ -- ^ the breakpoint we stopped at
-- (Nothing <=> exception)
- , resumeSpan :: SrcSpan -- just a copy of the SrcSpan
+ , resumeSpan :: SrcSpan -- just a copy of the SrcSpan
-- from the ModBreaks,
-- otherwise it's a pain to
-- fetch the ModDetails &
@@ -90,9 +89,8 @@ data Resume = Resume
type ResumeBindings = ([TyThing], IcGlobalRdrEnv)
-data History
- = History {
- historyApStack :: ForeignHValue,
- historyBreakInfo :: BreakInfo,
- historyEnclosingDecls :: [String] -- declarations enclosing the breakpoint
- }
+data History = History
+ { historyApStack :: ForeignHValue
+ , historyBreakpointId :: InternalBreakpointId -- ^ breakpoint identifier
+ , historyEnclosingDecls :: [String] -- ^ declarations enclosing the breakpoint
+ }
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
index 5102ce7d98cd1134206c133b9919c187ff9e522a..7004a050cd00d17834e1703bea767a2607bbe57c 100644
--- a/compiler/GHC/Runtime/Interpreter.hs
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
-- | Interacting with the iserv interpreter, whether it is running on an
@@ -28,7 +27,7 @@ module GHC.Runtime.Interpreter
, getClosure
, getModBreaks
, seqHValue
- , evalBreakInfo
+ , evalBreakpointToId
, interpreterDynamic
, interpreterProfiled
@@ -74,7 +73,7 @@ import GHCi.Message
import GHCi.RemoteTypes
import GHCi.ResolvedBCO
import GHCi.BreakArray (BreakArray)
-import GHC.Types.BreakInfo (BreakInfo(..))
+import GHC.Types.Breakpoint
import GHC.ByteCode.Types
import GHC.Linker.Types
@@ -395,14 +394,15 @@ seqHValue interp unit_env ref =
status <- interpCmd interp (Seq hval)
handleSeqHValueStatus interp unit_env status
-evalBreakInfo :: HomePackageTable -> EvalBreakpoint -> BreakInfo
-evalBreakInfo hpt (EvalBreakpoint ix mod_name) =
- BreakInfo modl ix
- where
- modl = mi_module $
- hm_iface $
- expectJust "evalBreakInfo" $
- lookupHpt hpt (mkModuleName mod_name)
+evalBreakpointToId :: HomePackageTable -> EvalBreakpoint -> InternalBreakpointId
+evalBreakpointToId hpt eval_break =
+ let load_mod x = mi_module $ hm_iface $ expectJust "evalBreakpointToId" $ lookupHpt hpt (mkModuleName x)
+ in InternalBreakpointId
+ { ibi_tick_mod = load_mod (eb_tick_mod eval_break)
+ , ibi_tick_index = eb_tick_index eval_break
+ , ibi_info_mod = load_mod (eb_info_mod eval_break)
+ , ibi_info_index = eb_info_index eval_break
+ }
-- | Process the result of a Seq or ResumeSeq message. #2950
handleSeqHValueStatus :: Interp -> UnitEnv -> EvalStatus () -> IO (EvalResult ())
@@ -412,7 +412,7 @@ handleSeqHValueStatus interp unit_env eval_status =
-- A breakpoint was hit; inform the user and tell them
-- which breakpoint was hit.
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
- let bp = evalBreakInfo (ue_hpt unit_env) <$> maybe_break
+ let bp = evalBreakpointToId (ue_hpt unit_env) <$> maybe_break
sdocBpLoc = brackets . ppr . getSeqBpSpan
putStrLn ("*** Ignoring breakpoint " ++
(showSDocUnsafe $ sdocBpLoc bp))
@@ -422,14 +422,15 @@ handleSeqHValueStatus interp unit_env eval_status =
handleSeqHValueStatus interp unit_env status
(EvalComplete _ r) -> return r
where
- getSeqBpSpan :: Maybe BreakInfo -> SrcSpan
- -- Just case: Stopped at a breakpoint, extract SrcSpan information
- -- from the breakpoint.
- getSeqBpSpan (Just BreakInfo{..}) =
- (modBreaks_locs (breaks breakInfo_module)) ! breakInfo_number
- -- Nothing case - should not occur!
- -- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
- getSeqBpSpan Nothing = mkGeneralSrcSpan (fsLit "<unknown>")
+ getSeqBpSpan :: Maybe InternalBreakpointId -> SrcSpan
+ getSeqBpSpan = \case
+ Just bi -> (modBreaks_locs (breaks (ibi_tick_mod bi))) ! ibi_tick_index bi
+ -- Just case: Stopped at a breakpoint, extract SrcSpan information
+ -- from the breakpoint.
+ Nothing -> mkGeneralSrcSpan (fsLit "<unknown>")
+ -- Nothing case - should not occur!
+ -- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
+ --
breaks mod = getModBreaks $ expectJust "getSeqBpSpan" $
lookupHpt (ue_hpt unit_env) (moduleName mod)
diff --git a/compiler/GHC/StgToByteCode.hs b/compiler/GHC/StgToByteCode.hs
index e143588de2cc7747e10889e1fc27924c889d274c..d76762877c108439b0cb734d2641e1067e0a4f6d 100644
--- a/compiler/GHC/StgToByteCode.hs
+++ b/compiler/GHC/StgToByteCode.hs
@@ -384,27 +384,40 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs mod) rhs) = do
+schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do
code <- schemeE d 0 p rhs
hsc_env <- getHscEnv
current_mod <- getCurrentModule
- current_mod_breaks <- getCurrentModBreaks
- case break_info hsc_env mod current_mod current_mod_breaks of
+ mb_current_mod_breaks <- getCurrentModBreaks
+ case mb_current_mod_breaks of
+ -- if we're not generating ModBreaks for this module for some reason, we
+ -- can't store breakpoint occurrence information.
Nothing -> pure code
- Just ModBreaks {modBreaks_flags = breaks, modBreaks_module = mod_ptr, modBreaks_ccs = cc_arr} -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
- newBreakInfo tick_no breakInfo
- let cc | Just interp <- hsc_interp hsc_env
- , interpreterProfiled interp
- = cc_arr ! tick_no
- | otherwise = toRemotePtr nullPtr
- breakInstr = BRK_FUN breaks (fromIntegral tick_no) mod_ptr cc
- return $ breakInstr `consOL` code
+ Just current_mod_breaks -> case break_info hsc_env tick_mod current_mod mb_current_mod_breaks of
+ Nothing -> pure code
+ Just ModBreaks {modBreaks_flags = breaks, modBreaks_module = tick_mod_ptr, modBreaks_ccs = cc_arr} -> do
+ platform <- profilePlatform <$> getProfile
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
+
+ let info_mod_ptr = modBreaks_module current_mod_breaks
+ infox <- newBreakInfo breakInfo
+
+ let cc | Just interp <- hsc_interp hsc_env
+ , interpreterProfiled interp
+ = cc_arr ! tick_no
+ | otherwise = toRemotePtr nullPtr
+
+ let -- cast that checks that round-tripping through Word16 doesn't change the value
+ toW16 x = let r = fromIntegral x :: Word16
+ in if fromIntegral r == x
+ then r
+ else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
+ breakInstr = BRK_FUN breaks tick_mod_ptr (toW16 tick_no) info_mod_ptr (toW16 infox) cc
+ return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
-- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module
@@ -2189,7 +2202,12 @@ data BcM_State
, ffis :: [FFIInfo] -- ffi info blocks, to free later
-- Should be free()d when it is GCd
, modBreaks :: Maybe ModBreaks -- info about breakpoints
- , breakInfo :: IntMap CgBreakInfo
+
+ , breakInfo :: IntMap CgBreakInfo -- ^ Info at breakpoint occurrence.
+ -- Indexed with breakpoint *info* index.
+ -- See Note [Breakpoint identifiers]
+ -- in GHC.Types.Breakpoint
+ , breakInfoIdx :: !Int -- ^ Next index for breakInfo array
}
newtype BcM r = BcM (BcM_State -> IO (BcM_State, r)) deriving (Functor)
@@ -2203,7 +2221,7 @@ runBc :: HscEnv -> Module -> Maybe ModBreaks
-> BcM r
-> IO (BcM_State, r)
runBc hsc_env this_mod modBreaks (BcM m)
- = m (BcM_State hsc_env this_mod 0 [] modBreaks IntMap.empty)
+ = m (BcM_State hsc_env this_mod 0 [] modBreaks IntMap.empty 0)
thenBc :: BcM a -> (a -> BcM b) -> BcM b
thenBc (BcM expr) cont = BcM $ \st0 -> do
@@ -2259,9 +2277,14 @@ getLabelsBc n
= BcM $ \st -> let ctr = nextlabel st
in return (st{nextlabel = ctr+n}, coerce [ctr .. ctr+n-1])
-newBreakInfo :: BreakIndex -> CgBreakInfo -> BcM ()
-newBreakInfo ix info = BcM $ \st ->
- return (st{breakInfo = IntMap.insert ix info (breakInfo st)}, ())
+newBreakInfo :: CgBreakInfo -> BcM Int
+newBreakInfo info = BcM $ \st ->
+ let ix = breakInfoIdx st
+ st' = st
+ { breakInfo = IntMap.insert ix info (breakInfo st)
+ , breakInfoIdx = ix + 1
+ }
+ in return (st', ix)
getCurrentModule :: BcM Module
getCurrentModule = BcM $ \st -> return (st, thisModule st)
diff --git a/compiler/GHC/Types/BreakInfo.hs b/compiler/GHC/Types/BreakInfo.hs
deleted file mode 100644
index d08ccda0bf4278d4c1114eff55abb86790d91287..0000000000000000000000000000000000000000
--- a/compiler/GHC/Types/BreakInfo.hs
+++ /dev/null
@@ -1,12 +0,0 @@
--- | A module for the BreakInfo type. Used by both the GHC.Runtime.Eval and
--- GHC.Runtime.Interpreter hierarchy, so put here to have a less deep module
--- dependency tree
-module GHC.Types.BreakInfo (BreakInfo(..)) where
-
-import GHC.Prelude
-import GHC.Unit.Module
-
-data BreakInfo = BreakInfo
- { breakInfo_module :: Module
- , breakInfo_number :: Int
- }
diff --git a/compiler/GHC/Types/Breakpoint.hs b/compiler/GHC/Types/Breakpoint.hs
new file mode 100644
index 0000000000000000000000000000000000000000..9e56148f9c77e4d9f9e9ea93c1b864fb0d4d095d
--- /dev/null
+++ b/compiler/GHC/Types/Breakpoint.hs
@@ -0,0 +1,53 @@
+-- | Breakpoint related types
+module GHC.Types.Breakpoint
+ ( BreakpointId (..)
+ , InternalBreakpointId (..)
+ , toBreakpointId
+ )
+where
+
+import GHC.Prelude
+import GHC.Unit.Module
+
+-- | Breakpoint identifier.
+--
+-- See Note [Breakpoint identifiers]
+data BreakpointId = BreakpointId
+ { bi_tick_mod :: !Module -- ^ Breakpoint tick module
+ , bi_tick_index :: !Int -- ^ Breakpoint tick index
+ }
+
+-- | Internal breakpoint identifier
+--
+-- See Note [Breakpoint identifiers]
+data InternalBreakpointId = InternalBreakpointId
+ { ibi_tick_mod :: !Module -- ^ Breakpoint tick module
+ , ibi_tick_index :: !Int -- ^ Breakpoint tick index
+ , ibi_info_mod :: !Module -- ^ Breakpoint info module
+ , ibi_info_index :: !Int -- ^ Breakpoint info index
+ }
+
+toBreakpointId :: InternalBreakpointId -> BreakpointId
+toBreakpointId ibi = BreakpointId
+ { bi_tick_mod = ibi_tick_mod ibi
+ , bi_tick_index = ibi_tick_index ibi
+ }
+
+
+-- Note [Breakpoint identifiers]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- Before optimization a breakpoint is identified uniquely with a tick module
+-- and a tick index. See BreakpointId. A tick module contains an array, indexed
+-- with the tick indexes, which indicates breakpoint status.
+--
+-- When we generate ByteCode, we collect information for every breakpoint at
+-- their *occurrence sites* (see CgBreakInfo in GHC.ByteCode.Types) and these info
+-- are stored in the ModIface of the occurrence module. Because of inlining, we
+-- can't reuse the tick index to uniquely identify an occurrence; because of
+-- cross-module inlining, we can't assume that the occurrence module is the same
+-- as the tick module (#24712).
+--
+-- So every breakpoint occurrence gets assigned a module-unique *info index* and
+-- we store it alongside the occurrence module (*info module*) in the
+-- InternalBreakpointId datatype.
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 921dd1ebfc7d358db9240e5360048d37679e1ba7..a08e1266d5e5905160d9350e9334fd7b91c5527c 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -844,7 +844,7 @@ Library
GHC.Types.Annotations
GHC.Types.Avail
GHC.Types.Basic
- GHC.Types.BreakInfo
+ GHC.Types.Breakpoint
GHC.Types.CompleteMatch
GHC.Types.CostCentre
GHC.Types.CostCentre.State
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 2037170ee99c47ab9fe4f91bed014ee715158979..99c597f4676264fc28b9fd5a8b5364c7d9e3c296 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -72,6 +72,7 @@ import GHC.Core.TyCo.Ppr
import GHC.Types.SafeHaskell ( getSafeMode )
import GHC.Types.SourceError ( SourceError )
import GHC.Types.Name
+import GHC.Types.Breakpoint
import GHC.Types.Var ( varType )
import GHC.Iface.Syntax ( showToHeader )
import GHC.Builtin.Names
@@ -1408,15 +1409,13 @@ runAllocs m = do
_ -> Nothing
toBreakIdAndLocation :: GhciMonad m
- => Maybe GHC.BreakInfo -> m (Maybe (Int, BreakLocation))
+ => Maybe GHC.InternalBreakpointId -> m (Maybe (Int, BreakLocation))
toBreakIdAndLocation Nothing = return Nothing
toBreakIdAndLocation (Just inf) = do
- let md = GHC.breakInfo_module inf
- nm = GHC.breakInfo_number inf
st <- getGHCiState
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakModule loc == md,
- breakTick loc == nm ]
+ breakModule loc == ibi_tick_mod inf,
+ breakTick loc == ibi_tick_index inf ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
@@ -1544,15 +1543,11 @@ getCallStackAtCurrentBreakpoint = do
getCurrentBreakModule :: GHC.GhcMonad m => m (Maybe Module)
getCurrentBreakModule = do
resumes <- GHC.getResumeContext
- case resumes of
- [] -> return Nothing
- (r:_) -> do
- let ix = GHC.resumeHistoryIx r
- if ix == 0
- then return (GHC.breakInfo_module `liftM` GHC.resumeBreakInfo r)
- else do
- let hist = GHC.resumeHistory r !! (ix-1)
- return $ Just $ GHC.getHistoryModule hist
+ return $ case resumes of
+ [] -> Nothing
+ (r:_) -> case GHC.resumeHistoryIx r of
+ 0 -> ibi_tick_mod <$> GHC.resumeBreakpointId r
+ ix -> Just $ GHC.getHistoryModule $ GHC.resumeHistory r !! (ix-1)
-----------------------------------------------------------------------------
--
@@ -3474,7 +3469,7 @@ pprStopped res =
<> text (GHC.resumeDecl res))
<> char ',' <+> ppr (GHC.resumeSpan res)
where
- mb_mod_name = moduleName <$> GHC.breakInfo_module <$> GHC.resumeBreakInfo res
+ mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res
showUnits :: GHC.GhcMonad m => m ()
showUnits = do
@@ -4035,8 +4030,11 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do
case result of
Left sdoc -> printForUser sdoc
Right (loc, count) -> do
- let breakInfo = GHC.BreakInfo (breakModule loc) (breakTick loc)
- setupBreakpoint breakInfo count
+ let bi = GHC.BreakpointId
+ { bi_tick_mod = breakModule loc
+ , bi_tick_index = breakTick loc
+ }
+ setupBreakpoint bi count
ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch [break, count] = do
@@ -4053,7 +4051,7 @@ getIgnoreCount str =
where
sdocIgnore = text "Ignore count" <+> quotes (text str)
-setupBreakpoint :: GhciMonad m => GHC.BreakInfo -> Int -> m()
+setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m()
setupBreakpoint loc count = do
hsc_env <- GHC.getSession
GHC.setupBreakpoint hsc_env loc count
@@ -4542,7 +4540,7 @@ setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
setBreakFlag md ix enaDisa = do
let enaDisaToCount True = breakOn
enaDisaToCount False = breakOff
- setupBreakpoint (GHC.BreakInfo md ix) $ enaDisaToCount enaDisa
+ setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa
-- ---------------------------------------------------------------------------
-- User code exception handling
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
index 8cf03d618f48898076a3c1723d124ab805416e8a..2660285660f42eae860858776271b6ecca30c750 100644
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -398,10 +398,12 @@ data EvalStatus_ a b
instance Binary a => Binary (EvalStatus_ a b)
-data EvalBreakpoint =
- EvalBreakpoint
- Int -- ^ break index
- String -- ^ ModuleName
+data EvalBreakpoint = EvalBreakpoint
+ { eb_tick_mod :: String -- ^ Breakpoint tick module
+ , eb_tick_index :: Int -- ^ Breakpoint tick index
+ , eb_info_mod :: String -- ^ Breakpoint info module
+ , eb_info_index :: Int -- ^ Breakpoint info index
+ }
deriving (Generic, Show)
instance Binary EvalBreakpoint
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs
index 18fd5e991be2b11c0cef403372402504bb5b0870..26492af2d9eb3a05c91ef5ed3647a30f3584065f 100644
--- a/libraries/ghci/GHCi/Run.hs
+++ b/libraries/ghci/GHCi/Run.hs
@@ -329,7 +329,7 @@ withBreakAction opts breakMVar statusMVar act
-- as soon as it is hit, or in resetBreakAction below.
onBreak :: BreakpointCallback
- onBreak ix# mod_name# is_exception apStack = do
+ onBreak tick_mod# tickx# info_mod# infox# is_exception apStack = do
tid <- myThreadId
let resume = ResumeContext
{ resumeBreakMVar = breakMVar
@@ -342,8 +342,9 @@ withBreakAction opts breakMVar statusMVar act
if is_exception
then pure Nothing
else do
- mod_name <- peekCString (Ptr mod_name#)
- pure (Just (EvalBreakpoint (I# ix#) mod_name))
+ tick_mod <- peekCString (Ptr tick_mod#)
+ info_mod <- peekCString (Ptr info_mod#)
+ pure (Just (EvalBreakpoint tick_mod (I# tickx#) info_mod (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
takeMVar breakMVar
@@ -392,8 +393,10 @@ resetStepFlag :: IO ()
resetStepFlag = poke stepFlag 0
type BreakpointCallback
- = Int# -- the breakpoint index
- -> Addr# -- pointer to the module name
+ = Addr# -- pointer to the breakpoint tick module name
+ -> Int# -- breakpoint tick index
+ -> Addr# -- pointer to the breakpoint info module name
+ -> Int# -- breakpoint info index
-> Bool -- exception?
-> HValue -- the AP_STACK, or exception
-> IO ()
@@ -405,8 +408,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
noBreakAction :: BreakpointCallback
-noBreakAction _ _ False _ = putStrLn "*** Ignoring breakpoint"
-noBreakAction _ _ True _ = return () -- exception: just continue
+noBreakAction _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
+noBreakAction _ _ _ _ True _ = return () -- exception: just continue
-- Malloc and copy the bytes. We don't have any way to monitor the
-- lifetime of this memory, so it just leaks.
diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index 0d19c4e6b0ef8a5b76046bc0421699b3393213f0..9852320c2776dacbe63dfccf6fac3508ac42489c 100644
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -535,15 +535,19 @@ retry_pop_stack:
// be per-thread.
CInt[rts_stop_on_exception] = 0;
("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
- Sp = Sp - WDS(9);
- Sp(8) = exception;
- Sp(7) = stg_raise_ret_info;
- Sp(6) = exception;
- Sp(5) = ghczmprim_GHCziTypes_True_closure; // True <=> an exception
- Sp(4) = stg_ap_ppv_info;
- Sp(3) = 0;
- Sp(2) = stg_ap_n_info;
- Sp(1) = 0;
+ Sp = Sp - WDS(13);
+ Sp(12) = exception;
+ Sp(11) = stg_raise_ret_info;
+ Sp(10) = exception;
+ Sp(9) = ghczmprim_GHCziTypes_True_closure; // True <=> an exception
+ Sp(8) = stg_ap_ppv_info;
+ Sp(7) = 0;
+ Sp(6) = stg_ap_n_info;
+ Sp(5) = 0;
+ Sp(4) = stg_ap_n_info;
+ Sp(3) = 0;
+ Sp(2) = stg_ap_n_info;
+ Sp(1) = 0;
R1 = ioAction;
jump RET_LBL(stg_ap_n) [R1];
}
diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index fe1cdd24d247663d5808f6ba8eea41cf21754735..9b1dc5162189c2740166226798ce5f4d89648190 100644
--- a/rts/Interpreter.c
+++ b/rts/Interpreter.c
@@ -1089,9 +1089,9 @@ run_BCO:
/* check for a breakpoint on the beginning of a let binding */
case bci_BRK_FUN:
{
- int arg1_brk_array, arg2_array_index, arg3_module_name;
+ int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_index, arg5_info_index;
#if defined(PROFILING)
- int arg4_cc;
+ int arg6_cc;
#endif
StgArrBytes *breakPoints;
int returning_from_break;
@@ -1106,10 +1106,12 @@ run_BCO:
int size_words;
arg1_brk_array = BCO_GET_LARGE_ARG;
- arg2_array_index = BCO_NEXT;
- arg3_module_name = BCO_GET_LARGE_ARG;
+ arg2_tick_mod = BCO_GET_LARGE_ARG;
+ arg3_info_mod = BCO_GET_LARGE_ARG;
+ arg4_tick_index = BCO_NEXT;
+ arg5_info_index = BCO_NEXT;
#if defined(PROFILING)
- arg4_cc = BCO_GET_LARGE_ARG;
+ arg6_cc = BCO_GET_LARGE_ARG;
#else
BCO_GET_LARGE_ARG;
#endif
@@ -1122,7 +1124,7 @@ run_BCO:
#if defined(PROFILING)
cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
- (CostCentre*)BCO_LIT(arg4_cc));
+ (CostCentre*)BCO_LIT(arg6_cc));
#endif
// if we are returning from a break then skip this section
@@ -1134,11 +1136,11 @@ run_BCO:
// stop the current thread if either the
// "rts_stop_next_breakpoint" flag is true OR if the
// ignore count for this particular breakpoint is zero
- StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg2_array_index];
+ StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_tick_index];
if (rts_stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
- ((StgInt*)breakPoints->payload)[arg2_array_index] = --ignore_count;
+ ((StgInt*)breakPoints->payload)[arg4_tick_index] = --ignore_count;
}
else if (rts_stop_next_breakpoint == true || ignore_count == 0)
{
@@ -1171,8 +1173,10 @@ run_BCO:
// Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
- // ioAction :: Int# -- the breakpoint index
- // -> Addr# -- the breakpoint module
+ // ioAction :: Addr# -- the breakpoint tick module
+ // -> Int# -- the breakpoint tick index
+ // -> Addr# -- the breakpoint info module
+ // -> Int# -- the breakpoint info index
// -> Bool -- exception?
// -> HValue -- the AP_STACK, or exception
// -> IO ()
@@ -1180,15 +1184,19 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(11);
- SpW(10) = (W_)obj;
- SpW(9) = (W_)&stg_apply_interp_info;
- SpW(8) = (W_)new_aps;
- SpW(7) = (W_)False_closure; // True <=> an exception
- SpW(6) = (W_)&stg_ap_ppv_info;
- SpW(5) = (W_)BCO_LIT(arg3_module_name);
+ Sp_subW(15);
+ SpW(14) = (W_)obj;
+ SpW(13) = (W_)&stg_apply_interp_info;
+ SpW(12) = (W_)new_aps;
+ SpW(11) = (W_)False_closure; // True <=> an exception
+ SpW(10) = (W_)&stg_ap_ppv_info;
+ SpW(9) = (W_)arg5_info_index;
+ SpW(8) = (W_)&stg_ap_n_info;
+ SpW(7) = (W_)BCO_LIT(arg3_info_mod);
+ SpW(6) = (W_)&stg_ap_n_info;
+ SpW(5) = (W_)arg4_tick_index;
SpW(4) = (W_)&stg_ap_n_info;
- SpW(3) = (W_)arg2_array_index;
+ SpW(3) = (W_)BCO_LIT(arg2_tick_mod);
SpW(2) = (W_)&stg_ap_n_info;
SpW(1) = (W_)ioAction;
SpW(0) = (W_)&stg_enter_info;
diff --git a/testsuite/tests/ghci.debugger/scripts/T24712.hs b/testsuite/tests/ghci.debugger/scripts/T24712.hs
new file mode 100644
index 0000000000000000000000000000000000000000..73e0649860ba1c47652408f32cb99827f52371ad
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T24712.hs
@@ -0,0 +1,2 @@
+main = foo 123
+foo n = print n
diff --git a/testsuite/tests/ghci.debugger/scripts/T24712.script b/testsuite/tests/ghci.debugger/scripts/T24712.script
new file mode 100644
index 0000000000000000000000000000000000000000..b520ada9506da4e3a07ef6ac54b3f61ebe1a2f5d
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T24712.script
@@ -0,0 +1,3 @@
+:l T24712.hs
+:b foo
+main
diff --git a/testsuite/tests/ghci.debugger/scripts/T24712.stdout b/testsuite/tests/ghci.debugger/scripts/T24712.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..b7930ac47c4a098c178fe24485d98ea6432750a3
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T24712.stdout
@@ -0,0 +1,4 @@
+Breakpoint 0 activated at T24712.hs:2:9-15
+Stopped in Main.foo, T24712.hs:2:9-15
+_result :: IO () = _
+n :: Integer = 123
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index 010129e1a7cbdfc33552d204aefc68e3d24f1599..87ad8e7823c4779c9c0b12ef95c52c612f6a9a09 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -141,3 +141,4 @@ test('break030',
)
test('T23057', [only_ghci, extra_hc_opts('-fno-break-points')], ghci_script, ['T23057.script'])
test('T24306', normal, ghci_script, ['T24306.script'])
+test('T24712', normal, ghci_script, ['T24712.script'])
diff --git a/testsuite/tests/ghci.debugger/scripts/break021.stdout b/testsuite/tests/ghci.debugger/scripts/break021.stdout
index 199b3cdf05b9cabe5139638eb23fd060bc31af4b..bf64680b1a181bb45d4feecbc93fcf4af00b6439 100644
--- a/testsuite/tests/ghci.debugger/scripts/break021.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break021.stdout
@@ -17,7 +17,7 @@ _result :: IO () = _
^^^^^^^
11 line2 0
Stopped in Main.line1, break020.hs:3:11-19
-_result :: m () = _
+_result :: IO () = _
2
3 line1 _ = return ()
^^^^^^^^^
@@ -29,7 +29,7 @@ _result :: IO () = _
^^^^^^^
12 in_another_decl 0
Stopped in Main.line2, break020.hs:4:11-19
-_result :: m () = _
+_result :: IO () = _
3 line1 _ = return ()
4 line2 _ = return ()
^^^^^^^^^
@@ -41,7 +41,7 @@ _result :: IO () = _
^^^^^^^^^^^^^^^^^
13 in_another_module 0
Stopped in Main.in_another_decl, break020.hs:(6,21)-(7,30)
-_result :: m () = _
+_result :: IO () = _
5
vv
6 in_another_decl _ = do line1 0
@@ -49,25 +49,25 @@ _result :: m () = _
^^
8
Stopped in Main.in_another_decl, break020.hs:6:24-30
-_result :: m () = _
+_result :: IO () = _
5
6 in_another_decl _ = do line1 0
^^^^^^^
7 line2 0
Stopped in Main.line1, break020.hs:3:11-19
-_result :: m () = _
+_result :: IO () = _
2
3 line1 _ = return ()
^^^^^^^^^
4 line2 _ = return ()
Stopped in Main.in_another_decl, break020.hs:7:24-30
-_result :: m () = _
+_result :: IO () = _
6 in_another_decl _ = do line1 0
7 line2 0
^^^^^^^
8
Stopped in Main.line2, break020.hs:4:11-19
-_result :: m () = _
+_result :: IO () = _
3 line1 _ = return ()
4 line2 _ = return ()
^^^^^^^^^
@@ -85,7 +85,7 @@ _result :: IO () = _
^^^^^^^
15 return ()
Stopped in Main.line2, break020.hs:4:11-19
-_result :: m () = _
+_result :: IO () = _
3 line1 _ = return ()
4 line2 _ = return ()
^^^^^^^^^