paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-09 19:35:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

Debugger: Fix breakpoint with "HitCount" do not eval stack/watches until hit-count is reached (for FpDebug backend)

Browse Source
This commit is contained in:
Martin 2022-09-14 17:03:45 +02:00
parent 313a112a65
commit 1024191ee5
3 changed files with 28 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
components/debuggerintf/dbgintfdebuggerbase.pp
View File

@ -289,7 +289,7 @@ type
protected
procedure AssignLocationTo(Dest: TPersistent); virtual;
procedure AssignTo(Dest: TPersistent); override;
procedure DoHit(const ACount: Integer; var {%H-}AContinue: Boolean); virtual;
procedure DoHit(const ACount: Integer; var {%H-}AContinue, ANeedInternalPause: Boolean); virtual;
procedure SetHitCount(const AValue: Integer);
procedure SetValid(const AValue: TValidState);
protected
@ -362,6 +362,7 @@ type
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
procedure Hit(var ACanContinue: Boolean);
procedure Hit(var ACanContinue, ANeedInternalPause: Boolean);
property Slave: TBaseBreakPoint read FSlave write SetSlave;
property Kind: TDBGBreakPointKind read GetKind write SetKind; // TODO: remove, used by TIDEBreakPoint.SetKind
@ -3316,7 +3317,8 @@ begin
Changed;
end;
procedure TBaseBreakPoint.DoHit(const ACount: Integer; var AContinue: Boolean );
procedure TBaseBreakPoint.DoHit(const ACount: Integer; var AContinue,
ANeedInternalPause: Boolean);
begin
SetHitCount(ACount);
end;
@ -3457,15 +3459,22 @@ begin
end;
procedure TDBGBreakPoint.Hit(var ACanContinue: Boolean);
var
dummy: Boolean;
begin
Hit(ACanContinue, dummy);
end;
procedure TDBGBreakPoint.Hit(var ACanContinue, ANeedInternalPause: Boolean);
var
cnt: Integer;
begin
cnt := HitCount + 1;
if BreakHitcount > 0
then ACanContinue := cnt < BreakHitcount;
DoHit(cnt, ACanContinue);
DoHit(cnt, ACanContinue, ANeedInternalPause);
if Assigned(FSlave)
then FSlave.DoHit(cnt, ACanContinue);
then FSlave.DoHit(cnt, ACanContinue, ANeedInternalPause);
Debugger.DoBreakpointHit(Self, ACanContinue)
end;

12
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -333,7 +333,7 @@ type
*)
FWorkerThreadId: TThreadID;
FEvalWorkItem: TFpThreadWorkerCmdEval;
FQuickPause, FPauseForEvent, FSendingEvents: boolean;
FQuickPause, FPauseForEvent, FInternalPauseForEvent, FSendingEvents: boolean;
FExceptionStepper: TFpDebugExceptionStepping;
FConsoleOutputThread: TThread;
// Helper vars to run in debug-thread
@ -3543,8 +3543,10 @@ var
Context: TFpDbgSymbolScope;
PasExpr: TFpPascalExpression;
Opts: TFpInt3DebugBreakOptions;
NeedInternalPause: Boolean;
begin
// If a user single steps to an excepiton handler, do not open the dialog (there is no continue possible)
NeedInternalPause := False;
if AnEventType = deBreakpoint then
if FExceptionStepper.BreakpointHit(&continue, Breakpoint) then
exit;
@ -3582,7 +3584,7 @@ begin
EventLogHandler.LogEventBreakPointHit(ABreakpoint, ALocationAddr);
if assigned(ABreakPoint) then
ABreakPoint.Hit(&continue);
ABreakPoint.Hit(&continue, NeedInternalPause);
if (not &continue) and (ABreakPoint.Kind = bpkData) and (OnFeedback <> nil) then begin
// For message use location(Address - 1)
@ -3621,8 +3623,11 @@ begin
if not continue then
FPauseForEvent := True;
if not AMoreHitEventsPending then begin
FInternalPauseForEvent := FInternalPauseForEvent or NeedInternalPause;
if (not AMoreHitEventsPending) and (FPauseForEvent or FInternalPauseForEvent) then begin
FQuickPause := False; // Ok, because we will SetState => RunQuickPauseTasks is not needed
if FPauseForEvent then
&continue := False; // Only continue, if ALL events did say to continue
@ -3944,6 +3949,7 @@ begin
Threads.CurrentThreads.CurrentThreadId := FDbgController.CurrentThreadId;
FPauseForEvent := False;
FInternalPauseForEvent := False;
FSendingEvents := True;
try
FDbgController.SendEvents(Cont); // This may free the TFpDebugDebugger (self)

9
ide/packages/idedebugger/debugger.pp
View File

@ -316,7 +316,7 @@ type
procedure DisableGroups;
procedure DoActionChange; virtual;
procedure DoHit(const ACount: Integer; var AContinue: Boolean); override;
procedure DoHit(const ACount: Integer; var AContinue, ANeedInternalPause: Boolean); override;
procedure EnableGroups;
procedure ClearAllGroupLists;
{$IFDEF DBG_BREAKPOINT}
@ -5634,9 +5634,10 @@ begin
DoUserChanged;
end;
procedure TIDEBreakPoint.DoHit(const ACount: Integer; var AContinue: Boolean);
procedure TIDEBreakPoint.DoHit(const ACount: Integer; var AContinue,
ANeedInternalPause: Boolean);
begin
inherited DoHit(ACount, AContinue);
inherited DoHit(ACount, AContinue, ANeedInternalPause);
AContinue := AContinue or not (bpaStop in Actions);
if bpaLogMessage in Actions
then Master.DoLogMessage(FLogMessage);
@ -5645,6 +5646,8 @@ begin
if bpaLogCallStack in Actions
then Master.DoLogCallStack(FLogCallStackLimit);
// SnapShot is taken in TDebugManager.DebuggerChangeState
if bpaTakeSnapshot in Actions then
ANeedInternalPause := True;
if bpaEnableGroup in Actions
then EnableGroups;
if bpaDisableGroup in Actions