FpDebugger (pure): On a next, only stop if the current instruction is the first instruction of a line. This is to solve a problem in fpcs debuginfo.

git-svn-id: trunk@46136 -
This commit is contained in:
joost 2014-09-05 20:37:43 +00:00
parent d02d9c6cb1
commit 4b8e6daa2f
2 changed files with 48 additions and 1 deletions

View File

@ -111,6 +111,7 @@ type
private
FEnvironment: TStrings;
FExecutableFilename: string;
FNextOnlyStopOnStartLine: boolean;
FOnCreateProcessEvent: TOnCreateProcessEvent;
FOnDebugInfoLoaded: TNotifyEvent;
FOnExceptionEvent: TOnExceptionEvent;
@ -157,6 +158,13 @@ type
property Params: TStringList read FParams write SetParams;
property Environment: TStrings read FEnvironment write SetEnvironment;
property WorkingDirectory: string read FWorkingDirectory write FWorkingDirectory;
// With this parameter set a 'next' will only stop if the current
// instruction is the first inststruction of a line according to the
// debuginfo.
// Due to a bug in fpc's debug-info, the line info for the first instruction
// of a line, sometimes points the the prior line. This setting hides the
// results of that bug. It seems like it that GDB does something similar.
property NextOnlyStopOnStartLine: boolean read FNextOnlyStopOnStartLine write FNextOnlyStopOnStartLine;
property OnCreateProcessEvent: TOnCreateProcessEvent read FOnCreateProcessEvent write FOnCreateProcessEvent;
property OnHitBreakpointEvent: TOnHitBreakpointEvent read FOnHitBreakpointEvent write FOnHitBreakpointEvent;
@ -360,7 +368,8 @@ begin
inherited ResolveEvent(AnEvent, Handled, Finished);
if (AnEvent=deBreakpoint) and not assigned(FController.CurrentProcess.CurrentBreakpoint) then
begin
if FController.FCurrentThread.CompareStepInfo<>dcsiNewLine then
if (FController.FCurrentThread.CompareStepInfo<>dcsiNewLine) or
(not FController.FCurrentThread.IsAtStartOfLine and FController.NextOnlyStopOnStartLine) then
begin
AnEvent:=deInternalContinue;
FHiddenBreakpoint:=nil;
@ -720,6 +729,7 @@ begin
FParams := TStringList.Create;
FEnvironment := TStringList.Create;
FProcessMap := TMap.Create(itu4, SizeOf(TDbgProcess));
FNextOnlyStopOnStartLine := true;
end;
end.

View File

@ -54,6 +54,18 @@ type
SyncLogLevel: TFPDLogLevel;
end;
{ TFpDebugDebuggerProperties }
TFpDebugDebuggerProperties = class(TDebuggerProperties)
private
FNextOnlyStopOnStartLine: boolean;
public
constructor Create; override;
procedure Assign(Source: TPersistent); override;
published
property NextOnlyStopOnStartLine: boolean read FNextOnlyStopOnStartLine write FNextOnlyStopOnStartLine;
end;
{ TFpDebugDebugger }
TFpDebugDebugger = class(TDebuggerIntf)
@ -142,6 +154,7 @@ type
function GetLocation: TDBGLocationRec; override;
class function Caption: String; override;
class function HasExePath: boolean; override;
class function CreateProperties: TDebuggerProperties; override;
function GetSupportedCommands: TDBGCommands; override;
end;
@ -289,6 +302,22 @@ begin
RegisterDebugger(TFpDebugDebugger);
end;
{ TFpDebugDebuggerProperties }
constructor TFpDebugDebuggerProperties.Create;
begin
inherited Create;
FNextOnlyStopOnStartLine:=true;
end;
procedure TFpDebugDebuggerProperties.Assign(Source: TPersistent);
begin
inherited Assign(Source);
if Source is TFpDebugDebuggerProperties then begin
FNextOnlyStopOnStartLine := TFpDebugDebuggerProperties(Source).NextOnlyStopOnStartLine;
end;
end;
{ TFpWaitForConsoleOutputThread }
procedure TFpWaitForConsoleOutputThread.DoHasConsoleOutput(Data: PtrInt);
@ -1376,6 +1405,8 @@ var
addr: TDBGPtr;
begin
result := False;
if assigned(FDbgController) then
FDbgController.NextOnlyStopOnStartLine := TFpDebugDebuggerProperties(GetProperties).NextOnlyStopOnStartLine;
case ACommand of
dcRun:
begin
@ -1678,6 +1709,7 @@ begin
FDbgController.OnProcessExitEvent:=@FDbgControllerProcessExitEvent;
FDbgController.OnExceptionEvent:=@FDbgControllerExceptionEvent;
FDbgController.OnDebugInfoLoaded := @FDbgControllerDebugInfoLoaded;
FDbgController.NextOnlyStopOnStartLine := TFpDebugDebuggerProperties(GetProperties).NextOnlyStopOnStartLine;
end;
destructor TFpDebugDebugger.Destroy;
@ -1741,6 +1773,11 @@ begin
Result:=False;
end;
class function TFpDebugDebugger.CreateProperties: TDebuggerProperties;
begin
Result := TFpDebugDebuggerProperties.Create;
end;
function TFpDebugDebugger.GetSupportedCommands: TDBGCommands;
begin
Result:=[dcRun, dcStop, dcStepIntoInstr, dcStepOverInstr, dcStepOver,