Debugger: Run only current thread for converter function eval. Add option to run all threads.

This commit is contained in:
Martin 2022-09-11 17:11:54 +02:00
parent 069baa2497
commit 3952e9ce2d
5 changed files with 153 additions and 24 deletions

View File

@ -14,48 +14,65 @@ object JsonForDebugSettingsFrame: TJsonForDebugSettingsFrame
TabOrder = 0
DesignLeft = 394
DesignTop = 60
inline ConverterWithFuncCallSettingsFrame1: TConverterWithFuncCallSettingsFrame
Height = 19
Top = 1
Width = 107
ClientHeight = 19
ClientWidth = 107
TabOrder = 3
inherited chkRunAll: TCheckBox
Width = 107
end
end
object Label1: TLabel
Left = 107
Height = 19
Top = 1
Width = 119
end
object lblFuncName: TLabel
Left = 0
Height = 23
Top = 1
Width = 45
Top = 21
Width = 107
Caption = '----'
end
object edFuncName: TEdit
Left = 45
Left = 107
Height = 23
Top = 1
Width = 181
Top = 21
Width = 119
AutoSize = False
TabOrder = 0
end
object lblJsonAddress: TLabel
Left = 0
Height = 23
Top = 25
Width = 45
Top = 45
Width = 107
Caption = '----'
end
object edJsonAddress: TEdit
Left = 45
Left = 107
Height = 23
Top = 25
Width = 181
Top = 45
Width = 119
AutoSize = False
TabOrder = 1
end
object lblJsonTypename: TLabel
Left = 0
Height = 23
Top = 49
Width = 45
Top = 69
Width = 107
Caption = '----'
end
object edJsonTypename: TEdit
Left = 45
Left = 107
Height = 23
Top = 49
Width = 181
Top = 69
Width = 119
AutoSize = False
TabOrder = 2
end

View File

@ -5,7 +5,7 @@ unit FpDebugConvDebugForJson;
interface
uses
Classes, SysUtils, Forms, Controls, ExtCtrls, StdCtrls,
Classes, SysUtils, Forms, Controls, ExtCtrls, StdCtrls, ActnList,
FpDebugStringConstants, FpDebugValueConvertors, FpDebugDebuggerBase,
LazDebuggerValueConverter, LazDebuggerIntfBaseTypes, FpDbgInfo, FpDbgClasses,
FpdMemoryTools, FpDbgCallContextInfo, FpErrorMessages, DbgIntfBaseTypes;
@ -15,9 +15,11 @@ type
{ TJsonForDebugSettingsFrame }
TJsonForDebugSettingsFrame = class(TFrame, TLazDbgValueConverterSettingsFrameIntf)
ConverterWithFuncCallSettingsFrame1: TConverterWithFuncCallSettingsFrame;
edFuncName: TEdit;
edJsonAddress: TEdit;
edJsonTypename: TEdit;
Label1: TLabel;
lblFuncName: TLabel;
lblJsonAddress: TLabel;
lblJsonTypename: TLabel;
@ -33,7 +35,7 @@ type
{ TFpDbgValueConverterJsonForDebug }
TFpDbgValueConverterJsonForDebug = class(TFpDbgValueConverter)
TFpDbgValueConverterJsonForDebug = class(TFpDbgValueConverterWithFuncCall)
private
FFunctionName: String;
FJsonAddressKey: String;
@ -77,6 +79,8 @@ procedure TJsonForDebugSettingsFrame.ReadFrom(
var
c: TFpDbgValueConverterJsonForDebug;
begin
ConverterWithFuncCallSettingsFrame1.ReadFrom(AConvertor);
if not (AConvertor.GetObject is TFpDbgValueConverterJsonForDebug) then
exit;
@ -92,13 +96,15 @@ function TJsonForDebugSettingsFrame.WriteTo(
var
c: TFpDbgValueConverterJsonForDebug;
begin
Result := False;
Result := ConverterWithFuncCallSettingsFrame1.WriteTo(AConvertor);
if not (AConvertor.GetObject is TFpDbgValueConverterJsonForDebug) then
exit;
c := TFpDbgValueConverterJsonForDebug(AConvertor.GetObject);
Result :=
Result or
(c.FFunctionName <> trim(edFuncName.Text)) or
(c.FJsonAddressKey <> trim(edJsonAddress.Text)) or
(c.FJsonTypenameKey <> trim(edJsonTypename.Text));
@ -280,7 +286,7 @@ begin
CallContext.FinalizeParams; // force the string as first param (32bit) // TODO
AnFpDebugger.BeforeWatchEval(CallContext);
AnFpDebugger.DbgController.ProcessLoop;
AnFpDebugger.RunProcessLoop(not FuncCallRunAllThreads);
if not CallContext.IsValid then begin
if (IsError(CallContext.LastError)) then

View File

@ -14,6 +14,7 @@ resourcestring
drsFunctionName = 'Function name';
drsCallSysVarToLStr = 'Call SysVarToLStr';
drsCallJsonForDebug = 'Call JsonForDebug';
drsRunAllThreadsWhileEval = 'Run all threads while evaluating';
implementation

View File

@ -0,0 +1,21 @@
object ConverterWithFuncCallSettingsFrame: TConverterWithFuncCallSettingsFrame
Left = 0
Height = 240
Top = 0
Width = 320
AutoSize = True
ClientHeight = 240
ClientWidth = 320
TabOrder = 0
DesignLeft = 268
DesignTop = 68
object chkRunAll: TCheckBox
Left = 0
Height = 19
Top = 0
Width = 320
Align = alTop
Caption = 'chkRunAll'
TabOrder = 0
end
end

View File

@ -8,8 +8,8 @@ interface
uses
Classes, SysUtils, FpDbgInfo, FpdMemoryTools, FpDbgCallContextInfo,
FpPascalBuilder, FpErrorMessages, FpDbgClasses, FpDbgUtil, DbgIntfBaseTypes,
LazClasses, LCLProc, StrUtils, FpDebugDebuggerBase, FpDebugStringConstants,
LazDebuggerValueConverter, LazDebuggerIntfBaseTypes;
LazClasses, LCLProc, Forms, StdCtrls, Controls, StrUtils, FpDebugDebuggerBase,
FpDebugStringConstants, LazDebuggerValueConverter, LazDebuggerIntfBaseTypes;
type
(* TFpDbgValueConverter and descendants
@ -41,6 +41,29 @@ type
end;
TFpDbgValueConverterClass = class of TFpDbgValueConverter;
{ TConverterWithFuncCallSettingsFrame }
TConverterWithFuncCallSettingsFrame = class(TFrame, TLazDbgValueConverterSettingsFrameIntf)
chkRunAll: TCheckBox;
protected
function GetFrame: TObject;
public
constructor Create(TheOwner: TComponent); override;
procedure ReadFrom(AConvertor: TLazDbgValueConverterIntf);
function WriteTo(AConvertor: TLazDbgValueConverterIntf): Boolean;
end;
{ TFpDbgValueConverterWithFuncCall }
TFpDbgValueConverterWithFuncCall = class(TFpDbgValueConverter)
private
FFuncCallRunAllThreads: Boolean;
public
procedure Assign(ASource: TFpDbgValueConverter); override;
published
property FuncCallRunAllThreads: Boolean read FFuncCallRunAllThreads write FFuncCallRunAllThreads;
end;
{ TFpDbgValueConvertSelectorIntfHelper }
@ -61,9 +84,11 @@ type
{ TFpDbgValueConverterVariantToLStr }
TFpDbgValueConverterVariantToLStr = class(TFpDbgValueConverter)
TFpDbgValueConverterVariantToLStr = class(TFpDbgValueConverterWithFuncCall)
private
function GetProcAddrFromMgr(AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope): TDbgPtr;
protected
function GetSettingsFrame: TLazDbgValueConverterSettingsFrameIntf; override;
public
class function GetName: String; override;
function GetRegistryEntry: TLazDbgValueConvertRegistryEntryClass; override;
@ -82,6 +107,18 @@ type
implementation
{$R *.lfm}
{ TFpDbgValueConverterWithFuncCall }
procedure TFpDbgValueConverterWithFuncCall.Assign(ASource: TFpDbgValueConverter);
begin
inherited Assign(ASource);
if ASource is TFpDbgValueConverterWithFuncCall then begin
FFuncCallRunAllThreads := TFpDbgValueConverterWithFuncCall(ASource).FFuncCallRunAllThreads;
end;
end;
{ TFpDbgValueConverter }
function TFpDbgValueConverter.CreateCopy: TLazDbgValueConverterIntf;
@ -129,6 +166,48 @@ begin
//
end;
{ TConverterWithFuncCallSettingsFrame }
procedure TConverterWithFuncCallSettingsFrame.ReadFrom(
AConvertor: TLazDbgValueConverterIntf);
var
c: TFpDbgValueConverterWithFuncCall;
begin
if not (AConvertor.GetObject is TFpDbgValueConverterWithFuncCall) then
exit;
c := TFpDbgValueConverterWithFuncCall(AConvertor.GetObject);
chkRunAll.Checked := c.FuncCallRunAllThreads;
end;
function TConverterWithFuncCallSettingsFrame.WriteTo(
AConvertor: TLazDbgValueConverterIntf): Boolean;
var
c: TFpDbgValueConverterWithFuncCall;
begin
Result := False;
if not (AConvertor.GetObject is TFpDbgValueConverterWithFuncCall) then
exit;
c := TFpDbgValueConverterWithFuncCall(AConvertor.GetObject);
Result := chkRunAll.Checked <> c.FuncCallRunAllThreads;
c.FuncCallRunAllThreads := chkRunAll.Checked;
end;
function TConverterWithFuncCallSettingsFrame.GetFrame: TObject;
begin
Result := Self;
end;
constructor TConverterWithFuncCallSettingsFrame.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
chkRunAll.Caption := drsRunAllThreadsWhileEval;
end;
{ TFpDbgValueConvertSelectorIntfHelper }
function TFpDbgValueConvertSelectorIntfHelper.CheckMatch(AValue: TFpValue;
@ -311,7 +390,7 @@ begin
CallContext.AddOrdinalParam(nil, MgrAddr);
CallContext.FinalizeParams;
AnFpDebugger.BeforeWatchEval(CallContext);
AnFpDebugger.DbgController.ProcessLoop;
AnFpDebugger.RunProcessLoop(True);
if not CallContext.IsValid then
exit;
@ -329,6 +408,11 @@ begin
end;
end;
function TFpDbgValueConverterVariantToLStr.GetSettingsFrame: TLazDbgValueConverterSettingsFrameIntf;
begin
Result := TConverterWithFuncCallSettingsFrame.Create(nil);
end;
class function TFpDbgValueConverterVariantToLStr.GetName: String;
begin
Result := drsCallSysVarToLStr;
@ -426,7 +510,7 @@ begin
CallContext.FinalizeParams; // force the string as first param (32bit) // TODO
CallContext.AddOrdinalParam(nil, ASourceValue.DataAddress.Address);
AnFpDebugger.BeforeWatchEval(CallContext);
AnFpDebugger.DbgController.ProcessLoop;
AnFpDebugger.RunProcessLoop(not FuncCallRunAllThreads);
if not CallContext.IsValid then begin
if (IsError(CallContext.LastError)) then