mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-13 10:19:16 +02:00
Debugger GDBMI: Attempt workaround for step-over issue (step-over performs step-in). See Issue #0034159
git-svn-id: trunk@60274 -
This commit is contained in:
parent
54f21f7efa
commit
586058a0e3
@ -166,6 +166,7 @@ type
|
|||||||
FDisableStartupShell: Boolean;
|
FDisableStartupShell: Boolean;
|
||||||
FEncodeCurrentDirPath: TGDBMIDebuggerFilenameEncoding;
|
FEncodeCurrentDirPath: TGDBMIDebuggerFilenameEncoding;
|
||||||
FEncodeExeFileName: TGDBMIDebuggerFilenameEncoding;
|
FEncodeExeFileName: TGDBMIDebuggerFilenameEncoding;
|
||||||
|
FFixIncorrectStepOver: Boolean;
|
||||||
FFixStackFrameForFpcAssert: Boolean;
|
FFixStackFrameForFpcAssert: Boolean;
|
||||||
FGdbLocalsValueMemLimit: Integer;
|
FGdbLocalsValueMemLimit: Integer;
|
||||||
{$IFDEF UNIX}
|
{$IFDEF UNIX}
|
||||||
@ -228,6 +229,7 @@ type
|
|||||||
write FDisableStartupShell default False;
|
write FDisableStartupShell default False;
|
||||||
property FixStackFrameForFpcAssert: Boolean read FFixStackFrameForFpcAssert
|
property FixStackFrameForFpcAssert: Boolean read FFixStackFrameForFpcAssert
|
||||||
write FFixStackFrameForFpcAssert default True;
|
write FFixStackFrameForFpcAssert default True;
|
||||||
|
property FixIncorrectStepOver: Boolean read FFixIncorrectStepOver write FFixIncorrectStepOver default False;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TGDBMIDebuggerProperties = class(TGDBMIDebuggerPropertiesBase)
|
TGDBMIDebuggerProperties = class(TGDBMIDebuggerPropertiesBase)
|
||||||
@ -256,6 +258,7 @@ type
|
|||||||
property AssemblerStyle;
|
property AssemblerStyle;
|
||||||
property DisableStartupShell;
|
property DisableStartupShell;
|
||||||
property FixStackFrameForFpcAssert;
|
property FixStackFrameForFpcAssert;
|
||||||
|
property FixIncorrectStepOver;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TGDBMIDebugger = class;
|
TGDBMIDebugger = class;
|
||||||
@ -619,6 +622,8 @@ type
|
|||||||
FRunToSrc: String;
|
FRunToSrc: String;
|
||||||
FRunToLine: Integer;
|
FRunToLine: Integer;
|
||||||
FStepBreakPoint: Integer;
|
FStepBreakPoint: Integer;
|
||||||
|
FInitialFP: TDBGPtr;
|
||||||
|
FStepOverFixNeeded: (sofNotNeeded, sofStepAgain, sofStepOut);
|
||||||
protected
|
protected
|
||||||
procedure DoLockQueueExecute; override;
|
procedure DoLockQueueExecute; override;
|
||||||
procedure DoUnLockQueueExecute; override;
|
procedure DoUnLockQueueExecute; override;
|
||||||
@ -5875,6 +5880,41 @@ function TGDBMIDebuggerCommandExecute.ProcessStopped(const AParams: String;
|
|||||||
end;
|
end;
|
||||||
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;
|
procedure ProcessBreakPoint(ABreakId: Integer; const List: TGDBMINameValueList;
|
||||||
AReason: TGDBMIBreakpointReason; AOldVal: String = ''; ANewVal: String = '');
|
AReason: TGDBMIBreakpointReason; AOldVal: String = ''; ANewVal: String = '');
|
||||||
var
|
var
|
||||||
@ -6168,8 +6208,11 @@ begin
|
|||||||
|
|
||||||
if Reason = 'end-stepping-range'
|
if Reason = 'end-stepping-range'
|
||||||
then begin
|
then begin
|
||||||
|
CheckIncorrectStepOver;
|
||||||
|
if not Result then begin
|
||||||
SetDebuggerState(dsPause);
|
SetDebuggerState(dsPause);
|
||||||
ProcessFrame(List.Values['frame'], False);
|
ProcessFrame(List.Values['frame'], False);
|
||||||
|
end;
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -6540,6 +6583,19 @@ var
|
|||||||
Result := FStepBreakPoint > 0;
|
Result := FStepBreakPoint > 0;
|
||||||
if Result then
|
if Result then
|
||||||
exit;
|
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;
|
i := -1;
|
||||||
if FP <> 0 then begin
|
if FP <> 0 then begin
|
||||||
@ -6675,8 +6731,10 @@ begin
|
|||||||
Result := True;
|
Result := True;
|
||||||
FCanKillNow := False;
|
FCanKillNow := False;
|
||||||
FDidKillNow := False;
|
FDidKillNow := False;
|
||||||
|
FStepOverFixNeeded := sofNotNeeded;
|
||||||
FNextExecQueued := False;
|
FNextExecQueued := False;
|
||||||
FP := 0;
|
FP := 0;
|
||||||
|
FInitialFP := FP;
|
||||||
CurThreadId := FTheDebugger.FCurrentThreadId;
|
CurThreadId := FTheDebugger.FCurrentThreadId;
|
||||||
if not FTheDebugger.FCurrentThreadIdValid then CurThreadId := 1; // TODO, but we need something
|
if not FTheDebugger.FCurrentThreadIdValid then CurThreadId := 1; // TODO, but we need something
|
||||||
ContinueStep := False; // A step command was interupted, and is continued on breakpoint
|
ContinueStep := False; // A step command was interupted, and is continued on breakpoint
|
||||||
@ -6704,6 +6762,7 @@ begin
|
|||||||
(FExecType in [ectStepOver, ectStepInto, ectStepOut, ectStepOverInstruction, ectStepIntoInstruction])
|
(FExecType in [ectStepOver, ectStepInto, ectStepOut, ectStepOverInstruction, ectStepIntoInstruction])
|
||||||
then
|
then
|
||||||
FP := GetCurrentFp;
|
FP := GetCurrentFp;
|
||||||
|
FInitialFP := FP;
|
||||||
|
|
||||||
FTheDebugger.FCurrentStackFrameValid := False;
|
FTheDebugger.FCurrentStackFrameValid := False;
|
||||||
FTheDebugger.FCurrentThreadIdValid := False;
|
FTheDebugger.FCurrentThreadIdValid := False;
|
||||||
@ -7475,6 +7534,7 @@ begin
|
|||||||
FAssemblerStyle := gdasDefault;
|
FAssemblerStyle := gdasDefault;
|
||||||
FDisableStartupShell := False;
|
FDisableStartupShell := False;
|
||||||
FFixStackFrameForFpcAssert := True;
|
FFixStackFrameForFpcAssert := True;
|
||||||
|
FFixIncorrectStepOver := False;
|
||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -7505,6 +7565,7 @@ begin
|
|||||||
FAssemblerStyle := TGDBMIDebuggerPropertiesBase(Source).FAssemblerStyle;
|
FAssemblerStyle := TGDBMIDebuggerPropertiesBase(Source).FAssemblerStyle;
|
||||||
FDisableStartupShell := TGDBMIDebuggerPropertiesBase(Source).FDisableStartupShell;
|
FDisableStartupShell := TGDBMIDebuggerPropertiesBase(Source).FDisableStartupShell;
|
||||||
FFixStackFrameForFpcAssert := TGDBMIDebuggerPropertiesBase(Source).FFixStackFrameForFpcAssert;
|
FFixStackFrameForFpcAssert := TGDBMIDebuggerPropertiesBase(Source).FFixStackFrameForFpcAssert;
|
||||||
|
FFixIncorrectStepOver := TGDBMIDebuggerPropertiesBase(Source).FFixIncorrectStepOver;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user