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 -

components/fpdebug/fpdbgcontroller.pas

@@ -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.

components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas

@@ -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,