paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-23 18:41:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazDebuggerFp (pure):

Browse Source 
* When a breakpoint is hit, pass the correct breakpoint to the TFpDebugDebugger.
 * Solve an AV when the IDE exits

git-svn-id: trunk@44743 -
This commit is contained in:
joost 2014-04-16 09:15:10 +00:00
parent ad9ca5afa5
commit 86f9de7b2a
3 changed files with 40 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/fpdebug/fpdbgclasses.pp
View File

@ -259,6 +259,7 @@ type
property ProcessID: integer read FProcessID; property ProcessID: integer read FProcessID;
property ThreadID: integer read FThreadID; property ThreadID: integer read FThreadID;
property ExitCode: DWord read FExitCode; property ExitCode: DWord read FExitCode;
property CurrentBreakpoint: TDbgBreakpoint read FCurrentBreakpoint;
property LastEventProcessIdentifier: THandle read GetLastEventProcessIdentifier; property LastEventProcessIdentifier: THandle read GetLastEventProcessIdentifier;
property OnLog: TOnLog read FOnLog write FOnLog; property OnLog: TOnLog read FOnLog write FOnLog;
property MainThread: TDbgThread read FMainThread; property MainThread: TDbgThread read FMainThread;

4
components/fpdebug/fpdbgcontroller.pas
View File

@ -15,7 +15,7 @@ uses
type type
TOnCreateProcessEvent = procedure(var continue: boolean) of object; TOnCreateProcessEvent = procedure(var continue: boolean) of object;
TOnHitBreakpointEvent = procedure(var continue: boolean) of object; TOnHitBreakpointEvent = procedure(var continue: boolean; const Breakpoint: TDbgBreakpoint) of object;
TOnExceptionEvent = procedure(var continue: boolean) of object; TOnExceptionEvent = procedure(var continue: boolean) of object;
TOnProcessExitEvent = procedure(ExitCode: DWord) of object; TOnProcessExitEvent = procedure(ExitCode: DWord) of object;
@ -246,7 +246,7 @@ begin
debugln('Breakpoint'); debugln('Breakpoint');
continue:=false; continue:=false;
if assigned(OnHitBreakpointEvent) then if assigned(OnHitBreakpointEvent) then
OnHitBreakpointEvent(continue); OnHitBreakpointEvent(continue, FCurrentProcess.CurrentBreakpoint);
end; end;
deExitProcess: deExitProcess:
begin begin

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

@ -45,7 +45,7 @@ type
FDbgController: TDbgController; FDbgController: TDbgController;
FFpDebugThread: TFpDebugThread; FFpDebugThread: TFpDebugThread;
procedure FreeDebugThread; procedure FreeDebugThread;
procedure FDbgControllerHitBreakpointEvent(var continue: boolean); procedure FDbgControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: FpDbgClasses.TDbgBreakpoint);
procedure FDbgControllerCreateProcessEvent(var continue: boolean); procedure FDbgControllerCreateProcessEvent(var continue: boolean);
procedure FDbgControllerProcessExitEvent(AExitCode: DWord); procedure FDbgControllerProcessExitEvent(AExitCode: DWord);
procedure FDbgControllerExceptionEvent(var continue: boolean); procedure FDbgControllerExceptionEvent(var continue: boolean);
@ -141,6 +141,13 @@ type
public public
end; end;
{ TFPBreakpoints }
TFPBreakpoints = class(TDBGBreakPoints)
public
function Find(AIntBReakpoint: FpDbgClasses.TDbgBreakpoint): TDBGBreakPoint;
end;
procedure Register; procedure Register;
implementation implementation
@ -154,6 +161,21 @@ begin
RegisterDebugger(TFpDebugDebugger); RegisterDebugger(TFpDebugDebugger);
end; end;
{ TFPBreakpoints }
function TFPBreakpoints.Find(AIntBReakpoint: FpDbgClasses.TDbgBreakpoint): TDBGBreakPoint;
var
i: integer;
begin
for i := 0 to count-1 do
if TFPBreakpoint(Items[i]).FInternalBreakpoint=AIntBReakpoint then
begin
result := TFPBreakpoint(Items[i]);
Exit;
end;
result := nil;
end;
{ TFPBreakpoint } { TFPBreakpoint }
procedure TFPBreakpoint.SetBreak; procedure TFPBreakpoint.SetBreak;
@ -173,8 +195,13 @@ end;
procedure TFPBreakpoint.ResetBreak; procedure TFPBreakpoint.ResetBreak;
begin begin
TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.RemoveBreak(FInternalBreakpoint.Location); // If Debugger is not assigned, the Controller's currentprocess is already
FreeAndNil(FInternalBreakpoint); // freed. And so are the corresponding InternalBreakpoint's.
if assigned(Debugger) and assigned(FInternalBreakpoint) then
begin
TFpDebugDebugger(Debugger).FDbgController.CurrentProcess.RemoveBreak(FInternalBreakpoint.Location);
FreeAndNil(FInternalBreakpoint);
end;
end; end;
destructor TFPBreakpoint.Destroy; destructor TFPBreakpoint.Destroy;
@ -582,7 +609,7 @@ end;
function TFpDebugDebugger.CreateBreakPoints: TDBGBreakPoints; function TFpDebugDebugger.CreateBreakPoints: TDBGBreakPoints;
begin begin
Result := TDBGBreakPoints.Create(Self, TFPBreakpoint); Result := TFPBreakPoints.Create(Self, TFPBreakpoint);
end; end;
procedure TFpDebugDebugger.FDbgControllerDebugInfoLoaded(Sender: TObject); procedure TFpDebugDebugger.FDbgControllerDebugInfoLoaded(Sender: TObject);
@ -603,9 +630,13 @@ begin
FFpDebugThread := nil; FFpDebugThread := nil;
end; end;
procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(var continue: boolean); procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: FpDbgClasses.TDbgBreakpoint);
var
ABreakPoint: TDBGBreakPoint;
begin begin
BreakPoints[0].Hit(continue); ABreakPoint := TFPBreakpoints(BreakPoints).Find(Breakpoint);
if assigned(ABreakPoint) then
ABreakPoint.Hit(continue);
SetState(dsPause); SetState(dsPause);
DoCurrent(GetLocation); DoCurrent(GetLocation);
end; end;