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

LazDebuggerFPDServer: Added basic watches support

Browse Source 
git-svn-id: trunk@49169 -
This commit is contained in:
joost 2015-05-25 20:00:05 +00:00
parent 0c5739b43a
commit f97dbf0ab7
1 changed files with 91 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
components/lazdebuggers/lazdebuggerfpdserver/fpdserverdebugger.pas
View File

@ -183,6 +183,22 @@ type
property Message: string read FMessage;
end;
{ TFPDSendWatchEvaluateCommand }
TFPDSendWatchEvaluateCommand = class(TFPDSendCommand)
private
FWatchValue: TWatchValue;
procedure DoWatchFreed(Sender: TObject);
protected
procedure ComposeJSon(AJsonObject: TJSONObject); override;
public
constructor create(AWatchValue: TWatchValue);
destructor Destroy; override;
procedure DoOnCommandSuccesfull(ACommandResponse: TJSonObject); override;
procedure DoOnCommandFailed(ACommandResponse: TJSonObject); override;
end;
{ TFPDSocketThread }
TFPDSocketThread = class(TThread)
@ -241,6 +257,7 @@ type
// Overrides of TDebuggerIntf methods.
class function Caption: String; override;
function CreateBreakPoints: TDBGBreakPoints; override;
function CreateWatches: TWatchesSupplier; override;
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
// These methods are called by several TFPDSendCommands after success or failure of a command. (Most common
// because the TFPDSendCommands do not have access to TFPDServerDebugger's protected methods theirself)
@ -286,6 +303,13 @@ type
function FindByUID(AnUID: integer): TFPBreakpoint;
end;
{ TFPWatches }
TFPWatches = class(TWatchesSupplier)
protected
procedure InternalRequestData(AWatchValue: TWatchValue); override;
end;
procedure Register;
begin
RegisterDebugger(TFPDServerDebugger);
@ -295,6 +319,68 @@ end;
var GCommandUID: integer = 0;
{ TFPDSendWatchEvaluateCommand }
procedure TFPDSendWatchEvaluateCommand.DoWatchFreed(Sender: TObject);
begin
FWatchValue:=nil;
end;
procedure TFPDSendWatchEvaluateCommand.ComposeJSon(AJsonObject: TJSONObject);
begin
inherited ComposeJSon(AJsonObject);
AJsonObject.Add('command','evaluate');
AJsonObject.Add('expression',FWatchValue.Expression);
end;
constructor TFPDSendWatchEvaluateCommand.create(AWatchValue: TWatchValue);
begin
inherited create(true);
AWatchValue.AddFreeNotification(@DoWatchFreed);
FWatchValue := AWatchValue;
end;
destructor TFPDSendWatchEvaluateCommand.Destroy;
begin
FWatchValue.RemoveFreeeNotification(@DoWatchFreed);
inherited Destroy;
end;
procedure TFPDSendWatchEvaluateCommand.DoOnCommandSuccesfull(ACommandResponse: TJSonObject);
var
s: string;
i: TDebuggerDataState;
begin
inherited DoOnCommandSuccesfull(ACommandResponse);
if assigned(FWatchValue) then
begin
FWatchValue.Value:=ACommandResponse.Get('message','');
s := ACommandResponse.Get('validity','');
FWatchValue.Validity:=ddsError;
for i := low(TDebuggerDataState) to high(TDebuggerDataState) do
if DebuggerDataStateStr[i]=s then
begin
FWatchValue.Validity:=i;
break;
end;
end;
end;
procedure TFPDSendWatchEvaluateCommand.DoOnCommandFailed(ACommandResponse: TJSonObject);
begin
inherited DoOnCommandFailed(ACommandResponse);
FWatchValue.Validity:=ddsInvalid;
end;
{ TFPWatches }
procedure TFPWatches.InternalRequestData(AWatchValue: TWatchValue);
begin
TFPDServerDebugger(Debugger).QueueCommand(TFPDSendWatchEvaluateCommand.create(AWatchValue));
inherited InternalRequestData(AWatchValue);
end;
{ TFPDSendEvaluateCommand }
procedure TFPDSendEvaluateCommand.ComposeJSon(AJsonObject: TJSONObject);
@ -1005,6 +1091,11 @@ begin
Result := TFPBreakPoints.Create(Self, TFPBreakpoint);
end;
function TFPDServerDebugger.CreateWatches: TWatchesSupplier;
begin
Result := TFPWatches.Create(Self);
end;
function TFPDServerDebugger.RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
var
ASendCommand: TFPDSendEvaluateCommand;