From 586058a0e3a5ed3c5b1940426a681dcca9889d8e Mon Sep 17 00:00:00 2001
From: martin <laz.git@mfriebe.de>
Date: Fri, 1 Feb 2019 22:54:41 +0000
Subject: [PATCH] Debugger GDBMI: Attempt workaround for step-over issue
 (step-over performs step-in). See Issue #0034159

git-svn-id: trunk@60274 -
---
 components/lazdebuggergdbmi/gdbmidebugger.pp | 61 ++++++++++++++++++++
 1 file changed, 61 insertions(+)

diff --git a/components/lazdebuggergdbmi/gdbmidebugger.pp b/components/lazdebuggergdbmi/gdbmidebugger.pp
index 380e0c58c8..e3c43085f6 100644
--- a/components/lazdebuggergdbmi/gdbmidebugger.pp
+++ b/components/lazdebuggergdbmi/gdbmidebugger.pp
@@ -166,6 +166,7 @@ type
     FDisableStartupShell: Boolean;
     FEncodeCurrentDirPath: TGDBMIDebuggerFilenameEncoding;
     FEncodeExeFileName: TGDBMIDebuggerFilenameEncoding;
+    FFixIncorrectStepOver: Boolean;
     FFixStackFrameForFpcAssert: Boolean;
     FGdbLocalsValueMemLimit: Integer;
     {$IFDEF UNIX}
@@ -228,6 +229,7 @@ type
              write FDisableStartupShell default False;
     property FixStackFrameForFpcAssert: Boolean read FFixStackFrameForFpcAssert
              write FFixStackFrameForFpcAssert default True;
+    property FixIncorrectStepOver: Boolean read FFixIncorrectStepOver write FFixIncorrectStepOver default False;
   end;
 
   TGDBMIDebuggerProperties = class(TGDBMIDebuggerPropertiesBase)
@@ -256,6 +258,7 @@ type
     property AssemblerStyle;
     property DisableStartupShell;
     property FixStackFrameForFpcAssert;
+    property FixIncorrectStepOver;
   end;
 
   TGDBMIDebugger = class;
@@ -619,6 +622,8 @@ type
     FRunToSrc: String;
     FRunToLine: Integer;
     FStepBreakPoint: Integer;
+    FInitialFP: TDBGPtr;
+    FStepOverFixNeeded: (sofNotNeeded, sofStepAgain, sofStepOut);
   protected
     procedure DoLockQueueExecute; override;
     procedure DoUnLockQueueExecute; override;
@@ -5875,6 +5880,41 @@ function TGDBMIDebuggerCommandExecute.ProcessStopped(const AParams: String;
     end;
   end;
 
+  procedure CheckIncorrectStepOver;
+    function GetCurrentFp: TDBGPtr; // TODO: this is a copy and paste from Run command
+    var
+      OldCtx: TGDBMICommandContext;
+    begin
+      OldCtx := FContext;
+      FContext.ThreadContext := ccUseLocal;
+      FContext.StackContext := ccUseLocal;
+      FContext.StackFrame := 0;
+      FContext.ThreadId := FTheDebugger.FCurrentThreadId;
+      Result := GetPtrValue('$fp', []);
+      FContext := OldCtx;
+    end;
+
+  begin
+    if not TGDBMIDebuggerPropertiesBase(FTheDebugger.GetProperties).FixIncorrectStepOver then
+      exit;
+    if not (FExecType = ectStepOver) then
+      exit;
+
+    if FStepOverFixNeeded = sofStepAgain then begin
+      FStepOverFixNeeded := sofStepOut;
+      Result := True;
+      exit;
+    end;
+
+    if (FInitialFP = 0) or (GetCurrentFp >= FInitialFP) then
+      exit;
+
+    DebugLn(DBG_VERBOSE, '*** FIXING gdb step over did step in');
+    Result := True; // outer funciton result
+
+    FStepOverFixNeeded := sofStepAgain;
+  end;
+
   procedure ProcessBreakPoint(ABreakId: Integer; const List: TGDBMINameValueList;
     AReason: TGDBMIBreakpointReason; AOldVal: String = ''; ANewVal: String = '');
   var
@@ -6168,8 +6208,11 @@ begin
 
     if Reason = 'end-stepping-range'
     then begin
+      CheckIncorrectStepOver;
+      if not Result then begin
         SetDebuggerState(dsPause);
         ProcessFrame(List.Values['frame'], False);
+      end;
       Exit;
     end;
 
@@ -6540,6 +6583,19 @@ var
           Result := FStepBreakPoint > 0;
           if Result then
             exit;
+          case FStepOverFixNeeded of
+            sofStepAgain: begin
+              FCurrentExecCmd := ectStepOver;
+              Result := True;
+              exit;
+            end;
+            sofStepOut: begin
+              FCurrentExecCmd := ectStepOut;
+              FStepOverFixNeeded := sofNotNeeded;
+              Result := True;
+              exit;
+            end;
+          end;
 
           i := -1;
           if FP <> 0 then begin
@@ -6675,8 +6731,10 @@ begin
   Result := True;
   FCanKillNow := False;
   FDidKillNow := False;
+  FStepOverFixNeeded := sofNotNeeded;
   FNextExecQueued := False;
   FP := 0;
+  FInitialFP := FP;
   CurThreadId := FTheDebugger.FCurrentThreadId;
   if not FTheDebugger.FCurrentThreadIdValid then CurThreadId := 1; // TODO, but we need something
   ContinueStep := False; // A step command was interupted, and is continued on breakpoint
@@ -6704,6 +6762,7 @@ begin
            (FExecType in [ectStepOver, ectStepInto, ectStepOut, ectStepOverInstruction, ectStepIntoInstruction])
         then
           FP := GetCurrentFp;
+          FInitialFP := FP;
 
         FTheDebugger.FCurrentStackFrameValid := False;
         FTheDebugger.FCurrentThreadIdValid   := False;
@@ -7475,6 +7534,7 @@ begin
   FAssemblerStyle := gdasDefault;
   FDisableStartupShell := False;
   FFixStackFrameForFpcAssert := True;
+  FFixIncorrectStepOver := False;
   inherited;
 end;
 
@@ -7505,6 +7565,7 @@ begin
   FAssemblerStyle := TGDBMIDebuggerPropertiesBase(Source).FAssemblerStyle;
   FDisableStartupShell := TGDBMIDebuggerPropertiesBase(Source).FDisableStartupShell;
   FFixStackFrameForFpcAssert := TGDBMIDebuggerPropertiesBase(Source).FFixStackFrameForFpcAssert;
+  FFixIncorrectStepOver := TGDBMIDebuggerPropertiesBase(Source).FFixIncorrectStepOver;
 end;