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

LazDebuggerFPDServer: Added support for dcEvaluate

Browse Source 
git-svn-id: trunk@49168 -
This commit is contained in:
joost 2015-05-25 17:37:06 +00:00
parent 6f07e65533
commit 0c5739b43a
1 changed files with 86 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -33,15 +33,17 @@ type
protected
FCommandUID: integer;
FServerDebugger: TFPDServerDebugger;
FAutomaticFree: boolean;
function GetAsString: string; virtual;
procedure ComposeJSon(AJsonObject: TJSONObject); virtual;
public
constructor create; virtual;
constructor create(AnAutomaticFree: boolean=true); virtual;
procedure DoOnCommandSuccesfull(ACommandResponse: TJSonObject); virtual;
procedure DoOnCommandReceived(ACommandResponse: TJSonObject); virtual;
procedure DoOnCommandFailed(ACommandResponse: TJSonObject); virtual;
property CommandUID: integer read FCommandUID;
property AsString: string read GetAsString;
property AutomaticFree: boolean read FAutomaticFree;
end;
{ TFPDSendCommandList }
@ -164,6 +166,23 @@ type
procedure DoOnCommandSuccesfull(ACommandResponse: TJSonObject); override;
end;
{ TFPDSendEvaluateCommand }
TFPDSendEvaluateCommand = class(TFPDSendCommand)
private
FExpression: string;
FValidity: TDebuggerDataState;
FMessage: string;
protected
procedure ComposeJSon(AJsonObject: TJSONObject); override;
public
constructor create(AnAutomaticFree: boolean; AnExpression: string);
procedure DoOnCommandSuccesfull(ACommandResponse: TJSonObject); override;
procedure DoOnCommandFailed(ACommandResponse: TJSonObject); override;
property Validity: TDebuggerDataState read FValidity;
property Message: string read FMessage;
end;
{ TFPDSocketThread }
TFPDSocketThread = class(TThread)
@ -276,6 +295,45 @@ end;
var GCommandUID: integer = 0;
{ TFPDSendEvaluateCommand }
procedure TFPDSendEvaluateCommand.ComposeJSon(AJsonObject: TJSONObject);
begin
inherited ComposeJSon(AJsonObject);
AJsonObject.Add('command','evaluate');
AJsonObject.Add('expression',FExpression);
end;
constructor TFPDSendEvaluateCommand.create(AnAutomaticFree: boolean; AnExpression: string);
begin
FExpression:=AnExpression;
FValidity:=ddsRequested;
inherited create(AnAutomaticFree);
end;
procedure TFPDSendEvaluateCommand.DoOnCommandSuccesfull(ACommandResponse: TJSonObject);
var
s: string;
i: TDebuggerDataState;
begin
inherited DoOnCommandSuccesfull(ACommandResponse);
FMessage:=ACommandResponse.Get('message','');
s := ACommandResponse.Get('validity','');
FValidity:=ddsError;
for i := low(TDebuggerDataState) to high(TDebuggerDataState) do
if DebuggerDataStateStr[i]=s then
begin
FValidity:=i;
break;
end;
end;
procedure TFPDSendEvaluateCommand.DoOnCommandFailed(ACommandResponse: TJSonObject);
begin
inherited DoOnCommandFailed(ACommandResponse);
FValidity:=ddsInvalid;
end;
{ TFPDSendQuitDebugServerCommand }
procedure TFPDSendQuitDebugServerCommand.ComposeJSon(AJsonObject: TJSONObject);
@ -319,10 +377,11 @@ begin
AJsonObject.Add('uid', FCommandUID);
end;
constructor TFPDSendCommand.create;
constructor TFPDSendCommand.create(AnAutomaticFree: boolean);
begin
inc(GCommandUID);
FCommandUID := GCommandUID;
FAutomaticFree:=AnAutomaticFree;
end;
procedure TFPDSendCommand.DoOnCommandSuccesfull(ACommandResponse: TJSonObject);
@ -776,7 +835,7 @@ end;
function TFPDServerDebugger.GetSupportedCommands: TDBGCommands;
begin
Result:=[dcRun, dcStepOver, dcStepInto, dcStepOut, dcStepOverInstr, dcStepIntoInstr, dcStop];
Result:=[dcRun, dcStepOver, dcStepInto, dcStepOut, dcStepOverInstr, dcStepIntoInstr, dcStop, dcEvaluate];
end;
procedure TFPDServerDebugger.DoHandleCreateProcessEvent(AnEvent: TJSONObject);
@ -842,12 +901,18 @@ begin
'ExecutedCommand':
begin
SendCommand.DoOnCommandSuccesfull(ANotification);
FCommandList.Remove(SendCommand);
if SendCommand.AutomaticFree then
FCommandList.Remove(SendCommand)
else
FCommandList.Extract(SendCommand);
end;
'FailedCommand' :
begin
SendCommand.DoOnCommandFailed(ANotification);
FCommandList.Remove(SendCommand);
if SendCommand.AutomaticFree then
FCommandList.Remove(SendCommand)
else
FCommandList.Extract(SendCommand);
end;
'ReceivedCommand':
SendCommand.DoOnCommandReceived(ANotification);
@ -941,6 +1006,9 @@ begin
end;
function TFPDServerDebugger.RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
var
ASendCommand: TFPDSendEvaluateCommand;
tc: qword;
begin
result := true;
case ACommand of
@ -994,6 +1062,19 @@ begin
QueueCommand(TFPDSendStopCommand.create);
if state=dsPause then
SetState(dsRun);
end;
dcEvaluate:
begin
ASendCommand := TFPDSendEvaluateCommand.create(False, String(AParams[0].VAnsiString));
QueueCommand(ASendCommand);
tc := GetTickCount64;
repeat
sleep(5);
Application.ProcessMessages;
until (ASendCommand.Validity<>ddsRequested) or ((GetTickCount64-tc)>2000);
String(AParams[1].VPointer^) := ASendCommand.Message;
TDBGType(AParams[2].VPointer^) := nil;
ASendCommand.Free;
end
else
result := false;