From 3952e9ce2d001ea878aee612c40bae00b200697e Mon Sep 17 00:00:00 2001 From: Martin Date: Sun, 11 Sep 2022 17:11:54 +0200 Subject: [PATCH] Debugger: Run only current thread for converter function eval. Add option to run all threads. --- .../lazdebuggerfp/fpdebugconvdebugforjson.lfm | 47 +++++++--- .../lazdebuggerfp/fpdebugconvdebugforjson.pas | 14 ++- .../lazdebuggerfp/fpdebugstringconstants.pas | 1 + .../lazdebuggerfp/fpdebugvalueconvertors.lfm | 21 +++++ .../lazdebuggerfp/fpdebugvalueconvertors.pas | 94 ++++++++++++++++++- 5 files changed, 153 insertions(+), 24 deletions(-) create mode 100644 components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.lfm diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugconvdebugforjson.lfm b/components/lazdebuggers/lazdebuggerfp/fpdebugconvdebugforjson.lfm index 5d9818ccce..576743002a 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugconvdebugforjson.lfm +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugconvdebugforjson.lfm @@ -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 diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugconvdebugforjson.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugconvdebugforjson.pas index b922d56261..92b581da57 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugconvdebugforjson.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugconvdebugforjson.pas @@ -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 diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugstringconstants.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugstringconstants.pas index bcf6f54cf9..4c90263401 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugstringconstants.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugstringconstants.pas @@ -14,6 +14,7 @@ resourcestring drsFunctionName = 'Function name'; drsCallSysVarToLStr = 'Call SysVarToLStr'; drsCallJsonForDebug = 'Call JsonForDebug'; + drsRunAllThreadsWhileEval = 'Run all threads while evaluating'; implementation diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.lfm b/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.lfm new file mode 100644 index 0000000000..2a40b045a5 --- /dev/null +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.lfm @@ -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 diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas index f8ce531c52..085d812f69 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas @@ -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