paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-08 09:20:49 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Clean/Remove the duplicate Finished/Handled on TDbgControllerCmd

Browse Source 
git-svn-id: trunk@62342 -
This commit is contained in:
martin 2019-12-08 00:18:13 +00:00
parent 42eb28852f
commit 66a5571620
1 changed files with 21 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
components/fpdebug/fpdbgcontroller.pas
View File

@ -36,12 +36,12 @@ type
procedure Init; virtual; procedure Init; virtual;
function IsAtCallInstruction: Integer; function IsAtCallInstruction: Integer;
function GetAsmInstruction(var AnInstr: TInstruction): Integer; function GetAsmInstruction(var AnInstr: TInstruction): Integer;
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled, Finished: boolean); virtual; abstract; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); virtual; abstract;
public public
constructor Create(AController: TDbgController); virtual; constructor Create(AController: TDbgController); virtual;
procedure DoBeforeLoopStart; procedure DoBeforeLoopStart;
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); virtual; abstract; procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); virtual; abstract;
procedure ResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled, Finished: boolean); virtual; procedure ResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); virtual;
end; end;
{ TDbgControllerContinueCmd } { TDbgControllerContinueCmd }
@ -49,7 +49,7 @@ type
TDbgControllerContinueCmd = class(TDbgControllerCmd) TDbgControllerContinueCmd = class(TDbgControllerCmd)
protected protected
procedure Init; override; procedure Init; override;
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled, Finished: boolean); override; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
public public
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
end; end;
@ -58,7 +58,7 @@ type
TDbgControllerStepIntoInstructionCmd = class(TDbgControllerCmd) TDbgControllerStepIntoInstructionCmd = class(TDbgControllerCmd)
protected protected
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled, Finished: boolean); override; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
public public
procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; procedure DoContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
end; end;
@ -102,9 +102,8 @@ type
TDbgControllerStepOverInstructionCmd = class(TDbgControllerHiddenBreakStepBaseCmd) TDbgControllerStepOverInstructionCmd = class(TDbgControllerHiddenBreakStepBaseCmd)
protected protected
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled, Finished: boolean); override; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
public
end; end;
{ TDbgControllerLineStepBaseCmd } { TDbgControllerLineStepBaseCmd }
@ -125,7 +124,7 @@ type
FStepCount, FNestDepth: Integer; FStepCount, FNestDepth: Integer;
protected protected
procedure Init; override; procedure Init; override;
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled, Finished: boolean); override; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
end; end;
@ -134,7 +133,7 @@ type
TDbgControllerStepOverLineCmd = class(TDbgControllerLineStepBaseCmd) TDbgControllerStepOverLineCmd = class(TDbgControllerLineStepBaseCmd)
protected protected
procedure Init; override; procedure Init; override;
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled, Finished: boolean); override; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
end; end;
@ -148,7 +147,7 @@ type
protected protected
function GetOutsideFrame(var AnOutside: Boolean): Boolean; function GetOutsideFrame(var AnOutside: Boolean): Boolean;
procedure SetReturnAdressBreakpoint(AProcess: TDbgProcess; AnOutsideFrame: Boolean); procedure SetReturnAdressBreakpoint(AProcess: TDbgProcess; AnOutsideFrame: Boolean);
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled, Finished: boolean); override; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
public public
end; end;
@ -160,7 +159,7 @@ type
FLocation: TDBGPtrArray; FLocation: TDBGPtrArray;
protected protected
procedure Init; override; procedure Init; override;
procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled, Finished: boolean); override; procedure DoResolveEvent(var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean); override;
procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override; procedure InternalContinue(AProcess: TDbgProcess; AThread: TDbgThread); override;
public public
constructor Create(AController: TDbgController; ALocation: TDBGPtrArray); constructor Create(AController: TDbgController; ALocation: TDBGPtrArray);
@ -298,11 +297,10 @@ begin
end; end;
procedure TDbgControllerCmd.ResolveEvent(var AnEvent: TFPDEvent; procedure TDbgControllerCmd.ResolveEvent(var AnEvent: TFPDEvent;
AnEventThread: TDbgThread; out Handled, Finished: boolean); AnEventThread: TDbgThread; out Finished: boolean);
var var
dummy: TDbgThread; dummy: TDbgThread;
begin begin
Handled := False;
Finished := False; Finished := False;
if AnEventThread = nil then if AnEventThread = nil then
exit; exit;
@ -316,7 +314,7 @@ begin
if FThread <> AnEventThread then if FThread <> AnEventThread then
exit; exit;
end; end;
DoResolveEvent(AnEvent, AnEventThread, Handled, Finished); DoResolveEvent(AnEvent, AnEventThread, Finished);
end; end;
{ TDbgControllerContinueCmd } { TDbgControllerContinueCmd }
@ -334,9 +332,8 @@ begin
end; end;
procedure TDbgControllerContinueCmd.DoResolveEvent(var AnEvent: TFPDEvent; procedure TDbgControllerContinueCmd.DoResolveEvent(var AnEvent: TFPDEvent;
AnEventThread: TDbgThread; out Handled, Finished: boolean); AnEventThread: TDbgThread; out Finished: boolean);
begin begin
Handled := false;
Finished := (AnEvent<>deInternalContinue); // TODO: always False? will be aborted, if another event terminates the ProcessLoop Finished := (AnEvent<>deInternalContinue); // TODO: always False? will be aborted, if another event terminates the ProcessLoop
end; end;
@ -350,11 +347,9 @@ begin
end; end;
procedure TDbgControllerStepIntoInstructionCmd.DoResolveEvent( procedure TDbgControllerStepIntoInstructionCmd.DoResolveEvent(
var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled, var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean);
Finished: boolean);
begin begin
Finished := (AnEvent<>deInternalContinue); Finished := (AnEvent<>deInternalContinue);
Handled := Finished;
if Finished then if Finished then
AnEvent := deFinishedStep; AnEvent := deFinishedStep;
end; end;
@ -498,14 +493,12 @@ begin
end; end;
procedure TDbgControllerStepOverInstructionCmd.DoResolveEvent( procedure TDbgControllerStepOverInstructionCmd.DoResolveEvent(
var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Handled, var AnEvent: TFPDEvent; AnEventThread: TDbgThread; out Finished: boolean);
Finished: boolean);
begin begin
if FHiddenBreakpoint <> nil then if FHiddenBreakpoint <> nil then
Finished := IsAtOrOutOfHiddenBreakFrame Finished := IsAtOrOutOfHiddenBreakFrame
else else
Finished := not (AnEvent in [deInternalContinue, deLoadLibrary]); Finished := not (AnEvent in [deInternalContinue, deLoadLibrary]);
Handled := Finished;
if Finished then if Finished then
begin begin
AnEvent := deFinishedStep; AnEvent := deFinishedStep;
@ -597,7 +590,7 @@ begin
end; end;
procedure TDbgControllerStepIntoLineCmd.DoResolveEvent(var AnEvent: TFPDEvent; procedure TDbgControllerStepIntoLineCmd.DoResolveEvent(var AnEvent: TFPDEvent;
AnEventThread: TDbgThread; out Handled, Finished: boolean); AnEventThread: TDbgThread; out Finished: boolean);
var var
CompRes: TFPDCompareStepInfo; CompRes: TFPDCompareStepInfo;
begin begin
@ -618,7 +611,6 @@ begin
Finished := CompRes = dcsiNewLine; Finished := CompRes = dcsiNewLine;
end; end;
Handled := Finished;
if Finished then if Finished then
AnEvent := deFinishedStep AnEvent := deFinishedStep
else else
@ -666,7 +658,7 @@ begin
end; end;
procedure TDbgControllerStepOverLineCmd.DoResolveEvent(var AnEvent: TFPDEvent; procedure TDbgControllerStepOverLineCmd.DoResolveEvent(var AnEvent: TFPDEvent;
AnEventThread: TDbgThread; out Handled, Finished: boolean); AnEventThread: TDbgThread; out Finished: boolean);
begin begin
UpdateThreadStepInfoAfterStepOut; UpdateThreadStepInfoAfterStepOut;
if IsAtOrOutOfHiddenBreakFrame then if IsAtOrOutOfHiddenBreakFrame then
@ -677,7 +669,6 @@ begin
else else
Finished := HasSteppedAwayFromOriginLine; Finished := HasSteppedAwayFromOriginLine;
Handled := Finished;
if Finished then if Finished then
AnEvent := deFinishedStep AnEvent := deFinishedStep
else else
@ -767,7 +758,7 @@ begin
end; end;
procedure TDbgControllerStepOutCmd.DoResolveEvent(var AnEvent: TFPDEvent; procedure TDbgControllerStepOutCmd.DoResolveEvent(var AnEvent: TFPDEvent;
AnEventThread: TDbgThread; out Handled, Finished: boolean); AnEventThread: TDbgThread; out Finished: boolean);
begin begin
Finished := False; Finished := False;
@ -790,7 +781,6 @@ begin
Finished := HasSteppedAwayFromOriginLine; Finished := HasSteppedAwayFromOriginLine;
end; end;
Handled := Finished;
if Finished then if Finished then
AnEvent := deFinishedStep AnEvent := deFinishedStep
else else
@ -820,10 +810,9 @@ begin
end; end;
procedure TDbgControllerRunToCmd.DoResolveEvent(var AnEvent: TFPDEvent; procedure TDbgControllerRunToCmd.DoResolveEvent(var AnEvent: TFPDEvent;
AnEventThread: TDbgThread; out Handled, Finished: boolean); AnEventThread: TDbgThread; out Finished: boolean);
begin begin
Finished := (AnEvent<>deInternalContinue); Finished := (AnEvent<>deInternalContinue);
Handled := Finished;
if Finished then begin if Finished then begin
RemoveHiddenBreak; RemoveHiddenBreak;
AnEvent := deFinishedStep; AnEvent := deFinishedStep;
@ -1022,7 +1011,6 @@ var
AProcessIdentifier: THandle; AProcessIdentifier: THandle;
AThreadIdentifier: THandle; AThreadIdentifier: THandle;
AExit: boolean; AExit: boolean;
IsHandled: boolean;
IsFinished, b: boolean; IsFinished, b: boolean;
EventProcess: TDbgProcess; EventProcess: TDbgProcess;
DummyThread: TDbgThread; DummyThread: TDbgThread;
@ -1141,19 +1129,18 @@ begin
if MaybeDetach then if MaybeDetach then
break; break;
IsHandled:=false;
IsFinished:=false; IsFinished:=false;
if FPDEvent=deExitProcess then if FPDEvent=deExitProcess then
FreeAndNil(FCommand) FreeAndNil(FCommand)
else else
if assigned(FCommand) then if assigned(FCommand) then
begin begin
FCommand.ResolveEvent(FPDEvent, FCurrentThread, IsHandled, IsFinished); FCommand.ResolveEvent(FPDEvent, FCurrentThread, IsFinished);
DebugLn(FPDBG_COMMANDS, 'Command %s: IsFinished=%s, IsHandled=%s', [FCommand.ClassName, dbgs(IsFinished), dbgs(IsHandled)]) DebugLn(FPDBG_COMMANDS, 'Command %s: IsFinished=%s', [FCommand.ClassName, dbgs(IsFinished)])
end; end;
AExit:=true; AExit:=true;
if not IsHandled then if not IsFinished then
begin begin
case FPDEvent of case FPDEvent of
deInternalContinue: AExit := False; deInternalContinue: AExit := False;