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

LazDebuggerFp (pure): Ability to set breakpoints while the debuggee is running

Browse Source 
git-svn-id: trunk@44754 -
This commit is contained in:
joost 2014-04-17 21:25:10 +00:00
parent a4c5bcadd1
commit f46dd07c9d
1 changed files with 39 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -44,6 +44,7 @@ type
private
FDbgController: TDbgController;
FFpDebugThread: TFpDebugThread;
FQuickPause: boolean;
procedure FreeDebugThread;
procedure FDbgControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: FpDbgClasses.TDbgBreakpoint);
procedure FDbgControllerCreateProcessEvent(var continue: boolean);
@ -64,6 +65,7 @@ type
procedure OnLog(AString: String);
procedure StartDebugLoop;
procedure DebugLoopFinished;
procedure QuickPause;
property DebugInfo: TDbgInfo read GetDebugInfo;
public
@ -131,6 +133,7 @@ type
FSetBreakFlag: boolean;
FResetBreakFlag: boolean;
FInternalBreakpoint: FpDbgClasses.TDbgBreakpoint;
FIsSet: boolean;
procedure SetBreak;
procedure ResetBreak;
protected
@ -187,6 +190,7 @@ begin
else
Raise Exception.Create('Breakpoints of this kind are not suported.');
end;
FIsSet:=true;
if not assigned(FInternalBreakpoint) then
FValid:=vsInvalid
else
@ -201,6 +205,7 @@ begin
begin
TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.RemoveBreak(FInternalBreakpoint.Location);
FreeAndNil(FInternalBreakpoint);
FIsSet:=false;
end;
end;
@ -212,28 +217,36 @@ end;
procedure TFPBreakpoint.DoStateChange(const AOldState: TDBGState);
begin
if (Debugger.State = dsPause) and (AOldState = dsInit) then
if (Debugger.State = dsPause) then
begin
if Enabled then
if Enabled and not FIsSet then
begin
FSetBreakFlag:=true;
Changed;
end
else if not enabled and FIsSet then
begin
FResetBreakFlag:=true;
Changed;
end;
end;
inherited DoStateChange(AOldState);
end;
procedure TFPBreakpoint.DoEnableChange;
var
ADebugger: TFpDebugDebugger;
begin
if FEnabled then
ADebugger := TFpDebugDebugger(Debugger);
if (ADebugger.State in [dsPause, dsInit]) then
begin
if (TFpDebugDebugger(Debugger).State in [dsPause, dsInit]) then
if FEnabled and not FIsSet then
FSetBreakFlag := True
else
debugln('FixMe: unable to set breakpoint at this moment.');
else if not FEnabled and FIsSet then
FResetBreakFlag := True;
end
else
FResetBreakFlag := True;
else if (ADebugger.State = dsRun) and ((FEnabled and not FIsSet) or (not FEnabled and FIsSet)) then
ADebugger.QuickPause;
inherited;
end;
@ -634,9 +647,18 @@ procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(var continue: boolea
var
ABreakPoint: TDBGBreakPoint;
begin
ABreakPoint := TFPBreakpoints(BreakPoints).Find(Breakpoint);
if assigned(ABreakPoint) then
ABreakPoint.Hit(continue);
if assigned(Breakpoint) then
begin
ABreakPoint := TFPBreakpoints(BreakPoints).Find(Breakpoint);
if assigned(ABreakPoint) then
ABreakPoint.Hit(continue);
end
else if FQuickPause then
begin
SetState(dsPause);
continue:=true;
exit;
end;
SetState(dsPause);
DoCurrent(GetLocation);
end;
@ -744,6 +766,12 @@ begin
end
end;
procedure TFpDebugDebugger.QuickPause;
begin
FQuickPause:=true;
FDbgController.Pause;
end;
constructor TFpDebugDebugger.Create(const AExternalDebugger: String);
begin
inherited Create(AExternalDebugger);